{-# 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 :: [String] -> TestResource (String, String)
katLoaderSimple = Char -> String -> [String] -> TestResource (String, String)
katLoader Char
'=' String
"#"

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

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

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

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

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

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

        splitWhen :: (a -> Bool) -> [a] -> [[a]]
        splitWhen :: (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 :: String -> String
stripSpaces = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

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

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

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

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

-- expect an ascii string.
valueUnbase64 :: String -> ByteString
valueUnbase64 :: String -> ByteString
valueUnbase64 String
s
    | (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
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 = String -> ByteString
forall a. HasCallStack => String -> a
error (String
"decodiong base64 not proper length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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
                                    Int
szRemove <- String -> Ptr Word8 -> IO Int
forall a. Num a => String -> Ptr Word8 -> IO a
loop String
s Ptr Word8
ptr
                                    Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
maxSz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
szRemove)
  where maxSz :: Int
maxSz = (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
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 :: String -> Ptr Word8 -> IO a
loop []               Ptr Word8
_   = 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 (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 (m :: * -> *) a. Monad m => a -> m a
return a
1
        loop (Char
w:Char
x:Char
y:Char
z:String
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')
            String -> Ptr Word8 -> IO a
loop String
r (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3)
        loop String
_                Ptr Word8
_   = String -> IO a
forall a. HasCallStack => String -> a
error (String
"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 :: String -> ByteString
valueUnbase16 String
s
    | Int -> Bool
forall a. Integral a => a -> Bool
odd (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) = String -> ByteString
forall a. HasCallStack => String -> a
error (String
"decoding base16 not proper length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
    | Bool
otherwise = Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (String -> Ptr Word8 -> IO ()
loop String
s)
  where loop :: String -> Ptr Word8 -> IO ()
loop []         Ptr Word8
_   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        loop (Char
x1:Char
x2:String
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)
            String -> Ptr Word8 -> IO ()
loop String
xs (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
        loop String
_          Ptr Word8
_   = String -> IO ()
forall a. HasCallStack => String -> a
error String
"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            = String -> Word8
forall a. HasCallStack => String -> a
error (String
"invalid base16 character " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s)

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

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