    {-# LANGUAGE OverloadedStrings #-}
    -- |
    -- Module      : Test.Tasty.KAT.FileLoader
    -- License     : MIT
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : Good
    --
    -- extra loaders helpers
    --
    module Test.Tasty.KAT.FileLoader
        ( katLoader
        , katLoaderSimple
        -- * generic helpers on TestResource
        , mapTestUnitValues
        , mapTestUnits
        -- * common helpers on TestResource
        , mapTestUnitValuesBase64
        , mapTestUnitValuesBase16
        -- * common value decoding helpers
        , valueUnbase16
        , valueUnbase64
        , valueInteger
        , valueHexInteger
        -- * associated hierarchy of KAT types
        , TestResource
        , TestGroup
        , TestUnit
        ) where

    import Control.Arrow (second)
    import Data.Bits
    import qualified Data.ByteString.Internal as B
    import qualified Data.ByteString.Unsafe as B
    import Data.ByteString (ByteString)
    import Data.ByteString.Char8 () -- for Bytestring OverloadedString instance on old ghc
    import Data.List
    import Data.Word
    import Foreign.Storable
    import Foreign.Ptr

    import Test.Tasty.KAT.Internal

    type TestResource a = [(String, TestGroup a)]
    type TestGroup a = [TestUnit a]
    type TestUnit a = [a]

    -- | From a simple KAT file, extract
    --
    -- * lines starting by #, are assumed to be comment
    --
    -- format should be the following:
    --
    -- > skipped ..
    -- > skipped ..
    -- > [group1]
    -- >
    -- > f1= v1
    -- > f2= v2
    -- > ...
    -- >
    -- > f1= v3
    -- > f2= v4
    -- > ...
    -- >
    -- > [group2]
    -- > ...
    katLoaderSimple :: [String] -> TestResource (String, String)
    katLoaderSimple :: [[Char]] -> TestResource ([Char], [Char])
    katLoaderSimple = Char -> [Char] -> [[Char]] -> TestResource ([Char], [Char])
    katLoader Char
    '=' [Char]
    "#"

    katLoader :: Char     -- ^ key value separator, e.g. '='
              -> String   -- ^ line comment, e.g. "--" "#"
              -> [String] -- ^ input lines
              -> TestResource (String, String)
    katLoader :: Char -> [Char] -> [[Char]] -> TestResource ([Char], [Char])
    katLoader Char
    kvSep [Char]
    lineComment =
          (([Char], [[[Char]]]) -> ([Char], TestGroup ([Char], [Char])))
    -> [([Char], [[[Char]]])] -> TestResource ([Char], [Char])
    forall a b. (a -> b) -> [a] -> [b]
    map (([[[Char]]] -> TestGroup ([Char], [Char]))
    -> ([Char], [[[Char]]]) -> ([Char], TestGroup ([Char], [Char]))
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (([[Char]] -> [([Char], [Char])])
    -> [[[Char]]] -> TestGroup ([Char], [Char])
    forall a b. (a -> b) -> [a] -> [b]
    map (([Char] -> ([Char], [Char])) -> [[Char]] -> [([Char], [Char])]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> ([Char], [Char])
    kv)))
        ([([Char], [[[Char]]])] -> TestResource ([Char], [Char]))
    -> ([[Char]] -> [([Char], [[[Char]]])])
    -> [[Char]]
    -> TestResource ([Char], [Char])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [([Char], [[[Char]]])] -> [([Char], [[[Char]]])]
    forall {a}. [(a, [[[Char]]])] -> [(a, [[[Char]]])]
    removeEmpty
        ([([Char], [[[Char]]])] -> [([Char], [[[Char]]])])
    -> ([[Char]] -> [([Char], [[[Char]]])])
    -> [[Char]]
    -> [([Char], [[[Char]]])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Char], [[Char]]) -> ([Char], [[[Char]]]))
    -> [([Char], [[Char]])] -> [([Char], [[[Char]]])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([[Char]] -> [[[Char]]])
    -> ([Char], [[Char]]) -> ([Char], [[[Char]]])
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (([Char] -> Bool) -> [[Char]] -> [[[Char]]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    splitWhen [Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null)) -- split a group of lines into a group of tests
        ([([Char], [[Char]])] -> [([Char], [[[Char]]])])
    -> ([[Char]] -> [([Char], [[Char]])])
    -> [[Char]]
    -> [([Char], [[[Char]]])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [[Char]] -> [[Char]] -> [([Char], [[Char]])]
    groupify [Char]
    "" []
        ([[Char]] -> [([Char], [[Char]])])
    -> ([[Char]] -> [[Char]]) -> [[Char]] -> [([Char], [[Char]])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    noTrailing
        ([[Char]] -> [[Char]])
    -> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Bool
    isComment)
      where isComment :: [Char] -> Bool
    isComment = [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf [Char]
    lineComment

            removeEmpty :: [(a, [[[Char]]])] -> [(a, [[[Char]]])]
    removeEmpty = ((a, [[[Char]]]) -> Bool) -> [(a, [[[Char]]])] -> [(a, [[[Char]]])]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (([[[Char]]] -> [[[Char]]] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []) ([[[Char]]] -> Bool)
    -> ((a, [[[Char]]]) -> [[[Char]]]) -> (a, [[[Char]]]) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, [[[Char]]]) -> [[[Char]]]
    forall a b. (a, b) -> b
    snd)

            groupify :: String -> [String] -> [String] -> [(String, [String])]
            groupify :: [Char] -> [[Char]] -> [[Char]] -> [([Char], [[Char]])]
    groupify [Char]
    gname [[Char]]
    acc []     = [([Char]
    gname, [[Char]] -> [[Char]]
    forall a. [a] -> [a]
    reverse [[Char]]
    acc)]
            groupify [Char]
    gname [[Char]]
    acc ([Char]
    x:[[Char]]
    xs) =
                case [Char] -> Maybe [Char]
    getGroupHeader [Char]
    x of
                    Just [Char]
    hdr -> ([Char]
    gname, [[Char]] -> [[Char]]
    forall a. [a] -> [a]
    reverse [[Char]]
    acc) ([Char], [[Char]]) -> [([Char], [[Char]])] -> [([Char], [[Char]])]
    forall a. a -> [a] -> [a]
    : [Char] -> [[Char]] -> [[Char]] -> [([Char], [[Char]])]
    groupify [Char]
    hdr [] [[Char]]
    xs
                    Maybe [Char]
    Nothing  -> [Char] -> [[Char]] -> [[Char]] -> [([Char], [[Char]])]
    groupify [Char]
    gname ([Char]
    x[Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :[[Char]]
    acc) [[Char]]
    xs

            kv :: String -> (String, String)
            kv :: [Char] -> ([Char], [Char])
    kv [Char]
    s = case (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    kvSep) [Char]
    s of
                        ([Char]
    k, Char
    c:[Char]
    v)
                            | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    kvSep -> ([Char] -> [Char]
    stripSpaces [Char]
    k, [Char] -> [Char]
    stripSpaces [Char]
    v)
                            | Bool
    otherwise  -> ([Char] -> [Char]
    stripSpaces [Char]
    k, [Char] -> [Char]
    stripSpaces [Char]
    v)
                        ([Char]
    _, [Char]
    _)     -> ([Char]
    s, [Char]
    "") -- no error handling ..

            getGroupHeader :: String -> Maybe String
            getGroupHeader :: [Char] -> Maybe [Char]
    getGroupHeader [Char]
    s
                | [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf [Char]
    "[" [Char]
    s Bool -> Bool -> Bool
    && [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isSuffixOf [Char]
    "]" [Char]
    s = [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char])
    -> ([Char] -> [Char]) -> [Char] -> Maybe [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    forall a. [a] -> [a]
    reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    forall a. [a] -> [a]
    reverse ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    s
                | Bool
    otherwise                            = Maybe [Char]
    forall a. Maybe a
    Nothing

            noTrailing :: [Char] -> [Char]
    noTrailing = [Char] -> [Char]
    forall a. [a] -> [a]
    reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    forall a. [a] -> [a]
    reverse

            splitWhen :: (a -> Bool) -> [a] -> [[a]]
            splitWhen :: forall a. (a -> Bool) -> [a] -> [[a]]
    splitWhen a -> Bool
    p [a]
    s = case (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile a -> Bool
    p [a]
    s of
                                 [] -> []
                                 [a]
    s' -> [a]
    w [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : (a -> Bool) -> [a] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    splitWhen a -> Bool
    p [a]
    s''
                                       where ([a]
    w, [a]
    s'') = (a -> Bool) -> [a] -> ([a], [a])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break a -> Bool
    p [a]
    s'
            stripSpaces :: [Char] -> [Char]
    stripSpaces = (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    forall a. [a] -> [a]
    reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    forall a. [a] -> [a]
    reverse

    mapTestUnitValues :: (String -> a) -> TestResource (String, String) -> TestResource (String,a)
    mapTestUnitValues :: forall a.
    ([Char] -> a)
    -> TestResource ([Char], [Char]) -> TestResource ([Char], a)
    mapTestUnitValues [Char] -> a
    f = (([Char], TestGroup ([Char], [Char]))
     -> ([Char], TestGroup ([Char], a)))
    -> TestResource ([Char], [Char])
    -> [([Char], TestGroup ([Char], a))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((TestGroup ([Char], [Char]) -> TestGroup ([Char], a))
    -> ([Char], TestGroup ([Char], [Char]))
    -> ([Char], TestGroup ([Char], a))
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (([([Char], [Char])] -> [([Char], a)])
    -> TestGroup ([Char], [Char]) -> TestGroup ([Char], a)
    forall a b. (a -> b) -> [a] -> [b]
    map ((([Char], [Char]) -> ([Char], a))
    -> [([Char], [Char])] -> [([Char], a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\([Char]
    k,[Char]
    v) -> ([Char]
    k, [Char] -> a
    f [Char]
    v)))))

    mapTestUnits :: (TestUnit (String,a) -> TestUnit b)
                 -> TestResource (String,a)
                 -> TestResource b
    mapTestUnits :: forall a b.
    (TestUnit ([Char], a) -> TestUnit b)
    -> TestResource ([Char], a) -> TestResource b
    mapTestUnits TestUnit ([Char], a) -> TestUnit b
    f = (([Char], TestGroup ([Char], a)) -> ([Char], TestGroup b))
    -> [([Char], TestGroup ([Char], a))] -> [([Char], TestGroup b)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((TestGroup ([Char], a) -> TestGroup b)
    -> ([Char], TestGroup ([Char], a)) -> ([Char], TestGroup b)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((TestUnit ([Char], a) -> TestUnit b)
    -> TestGroup ([Char], a) -> TestGroup b
    forall a b. (a -> b) -> [a] -> [b]
    map TestUnit ([Char], a) -> TestUnit b
    f))

    mapTestUnitValuesBase64 :: TestResource (String, String) -> TestResource (String, ByteString)
    mapTestUnitValuesBase64 :: TestResource ([Char], [Char]) -> TestResource ([Char], ByteString)
    mapTestUnitValuesBase64 =  ([Char] -> ByteString)
    -> TestResource ([Char], [Char])
    -> TestResource ([Char], ByteString)
    forall a.
    ([Char] -> a)
    -> TestResource ([Char], [Char]) -> TestResource ([Char], a)
    mapTestUnitValues [Char] -> ByteString
    valueUnbase64

    mapTestUnitValuesBase16 :: TestResource (String, String) -> TestResource (String, ByteString)
    mapTestUnitValuesBase16 :: TestResource ([Char], [Char]) -> TestResource ([Char], ByteString)
    mapTestUnitValuesBase16 = ([Char] -> ByteString)
    -> TestResource ([Char], [Char])
    -> TestResource ([Char], ByteString)
    forall a.
    ([Char] -> a)
    -> TestResource ([Char], [Char]) -> TestResource ([Char], a)
    mapTestUnitValues [Char] -> ByteString
    valueUnbase16

    -- expect an ascii string.
    valueUnbase64 :: String -> ByteString
    valueUnbase64 :: [Char] -> ByteString
    valueUnbase64 [Char]
    s
        | ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    s Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    4) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 = [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "decodiong base64 not proper length: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s)
        | Bool
    otherwise               = Int -> (Ptr Word8 -> IO Int) -> ByteString
    unsafeCreateUptoN Int
    maxSz ((Ptr Word8 -> IO Int) -> ByteString)
    -> (Ptr Word8 -> IO Int) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> do
                                        szRemove <- [Char] -> Ptr Word8 -> IO Int
    forall {a}. Num a => [Char] -> Ptr Word8 -> IO a
    loop [Char]
    s Ptr Word8
    ptr
                                        return (maxSz - szRemove)
      where maxSz :: Int
    maxSz = ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    s Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    4) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3
            loop :: [Char] -> Ptr Word8 -> IO a
    loop []               Ptr Word8
    _   = a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    0
            loop (Char
    w:Char
    x:Char
    '=':Char
    '=':[]) Ptr Word8
    ptr = do
                let w' :: Word8
    w' = Char -> Word8
    rset Char
    w
                    x' :: Word8
    x' = Char -> Word8
    rset Char
    x
                Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Word8
    ptr ((Word8
    w' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    2) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. (Word8
    x' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    4))
                a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    2
            loop (Char
    w:Char
    x:Char
    y:Char
    '=':[])   Ptr Word8
    ptr = do
                let w' :: Word8
    w' = Char -> Word8
    rset Char
    w
                    x' :: Word8
    x' = Char -> Word8
    rset Char
    x
                    y' :: Word8
    y' = Char -> Word8
    rset Char
    y
                Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Word8
    ptr               ((Word8
    w' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    2) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. (Word8
    x' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    4))
                Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    1) ((Word8
    x' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    4) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. (Word8
    y' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    2))
                a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    1
            loop (Char
    w:Char
    x:Char
    y:Char
    z:[Char]
    r)      Ptr Word8
    ptr = do
                let w' :: Word8
    w' = Char -> Word8
    rset Char
    w
                    x' :: Word8
    x' = Char -> Word8
    rset Char
    x
                    y' :: Word8
    y' = Char -> Word8
    rset Char
    y
                    z' :: Word8
    z' = Char -> Word8
    rset Char
    z
                Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Word8
    ptr               ((Word8
    w' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    2) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. (Word8
    x' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    4))
                Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    1) ((Word8
    x' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    4) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. (Word8
    y' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    2))
                Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    2) ((Word8
    y' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    6) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    z')
                [Char] -> Ptr Word8 -> IO a
    loop [Char]
    r (Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    3)
            loop [Char]
    _                Ptr Word8
    _   = [Char] -> IO a
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "internal error in base64 decoding")

            rset :: Char -> Word8
            rset :: Char -> Word8
    rset Char
    c
                | Int
    cval Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0xff = ByteString -> Int -> Word8
    B.unsafeIndex ByteString
    rsetTable Int
    cval
                | Bool
    otherwise    = Word8
    0xff
              where cval :: Int
    cval = Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c
            -- dict = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
            rsetTable :: ByteString
    rsetTable = ByteString
    "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\xff\x3f\
                        \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\xff\xff\xff\
                        \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\
                        \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\xff\
                        \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\
                        \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
                        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"

    -- expect an ascii string.
    valueUnbase16 :: String -> ByteString
    valueUnbase16 :: [Char] -> ByteString
    valueUnbase16 [Char]
    s
        | Int -> Bool
    forall a. Integral a => a -> Bool
    odd ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    s) = [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "decoding base16 not proper length: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s)
        | Bool
    otherwise = Int -> (Ptr Word8 -> IO ()) -> ByteString
    B.unsafeCreate ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Char]
    s Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2) ([Char] -> Ptr Word8 -> IO ()
    loop [Char]
    s)
      where loop :: [Char] -> Ptr Word8 -> IO ()
    loop []         Ptr Word8
    _   = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            loop (Char
    x1:Char
    x2:[Char]
    xs) Ptr Word8
    ptr = do
                Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Word8
    ptr ((Char -> Word8
    unhex Char
    x1 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    4) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Char -> Word8
    unhex Char
    x2)
                [Char] -> Ptr Word8 -> IO ()
    loop [Char]
    xs (Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    2)
            loop [Char]
    _          Ptr Word8
    _   = [Char] -> IO ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "internal error in base16 decoding"
            unhex :: Char -> Word8
            unhex :: Char -> Word8
    unhex Char
    c
                | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '9' = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    '0')
                | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'a' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'f' = Word8
    10 Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    'a')
                | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'A' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'F' = Word8
    10 Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    'A')
                | Bool
    otherwise            = [Char] -> Word8
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "invalid base16 character " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char -> [Char]
    forall a. Show a => a -> [Char]
    show Char
    c [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " in " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    s)

    valueInteger :: String -> Integer
    valueInteger :: [Char] -> Integer
    valueInteger [Char]
    s = [Char] -> Integer
    forall a. Read a => [Char] -> a
    read [Char]
    s

    valueHexInteger :: String -> Integer
    valueHexInteger :: [Char] -> Integer
    valueHexInteger [Char]
    s = [Char] -> Integer
    forall a. Read a => [Char] -> a
    read ([Char]
    "0x" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s)