{-# LANGUAGE OverloadedStrings #-}
module Test.Tasty.KAT.FileLoader
( katLoader
, katLoaderSimple
, mapTestUnitValues
, mapTestUnits
, mapTestUnitValuesBase64
, mapTestUnitValuesBase16
, valueUnbase16
, valueUnbase64
, valueInteger
, valueHexInteger
, 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 ()
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]
katLoaderSimple :: [String] -> TestResource (String, String)
katLoaderSimple :: [[Char]] -> TestResource ([Char], [Char])
katLoaderSimple = Char -> [Char] -> [[Char]] -> TestResource ([Char], [Char])
katLoader Char
'=' [Char]
"#"
katLoader :: Char
-> String
-> [String]
-> 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 (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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null))
([([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]
"")
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 (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 (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
valueUnbase64 :: String -> ByteString
valueUnbase64 :: [Char] -> ByteString
valueUnbase64 [Char]
s
| ([Char] -> 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
Int
szRemove <- [Char] -> Ptr Word8 -> IO Int
forall {a}. Num a => [Char] -> Ptr Word8 -> IO a
loop [Char]
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 = ([Char] -> 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 (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:[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
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"
valueUnbase16 :: String -> ByteString
valueUnbase16 :: [Char] -> ByteString
valueUnbase16 [Char]
s
| Int -> Bool
forall a. Integral a => a -> Bool
odd ([Char] -> 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 (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 (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)