{-# LANGUAGE TypeSynonymInstances #-}
module Data.Hex(Hex(..)) where
import Control.Monad
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
class Hex t where
hex :: t -> t
unhex :: Monad m => t -> m t
instance Hex String where
hex :: String -> String
hex = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Prelude.concatMap Char -> String
forall a. Enum a => a -> String
w
where w :: a -> String
w ch :: a
ch = let s :: String
s = "0123456789ABCDEF"
x :: Int
x = a -> Int
forall a. Enum a => a -> Int
fromEnum a
ch
in [String
s String -> Int -> Char
forall a. [a] -> Int -> a
!! Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
x 16,String
s String -> Int -> Char
forall a. [a] -> Int -> a
!! Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
x 16]
unhex :: String -> m String
unhex [] = String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return []
unhex (a :: Char
a:b :: Char
b:r :: String
r) = do Int
x <- Char -> m Int
forall (m :: * -> *). Monad m => Char -> m Int
c Char
a
Int
y <- Char -> m Int
forall (m :: * -> *). Monad m => Char -> m Int
c Char
b
(String -> String) -> m String -> m String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Char
forall a. Enum a => Int -> a
toEnum ((Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Char -> String -> String
forall a. a -> [a] -> [a]
:) (m String -> m String) -> m String -> m String
forall a b. (a -> b) -> a -> b
$ String -> m String
forall t (m :: * -> *). (Hex t, Monad m) => t -> m t
unhex String
r
unhex [_] = String -> m String
forall a. HasCallStack => String -> a
error "Non-even length"
c :: Monad m => Char -> m Int
c :: Char -> m Int
c '0' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 0
c '1' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 1
c '2' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 2
c '3' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 3
c '4' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 4
c '5' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 5
c '6' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 6
c '7' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 7
c '8' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 8
c '9' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 9
c 'A' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 10
c 'B' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 11
c 'C' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 12
c 'D' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 13
c 'E' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 14
c 'F' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 15
c 'a' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 10
c 'b' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 11
c 'c' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 12
c 'd' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 13
c 'e' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 14
c 'f' = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return 15
c _ = String -> m Int
forall a. HasCallStack => String -> a
error "Invalid hex digit!"
instance Hex B.ByteString where
hex :: ByteString -> ByteString
hex = String -> ByteString
B.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall t. Hex t => t -> t
hex (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack
unhex :: ByteString -> m ByteString
unhex x :: ByteString
x = (String -> ByteString) -> m String -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> ByteString
B.pack (m String -> m ByteString) -> m String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> m String
forall t (m :: * -> *). (Hex t, Monad m) => t -> m t
unhex (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B.unpack ByteString
x
instance Hex L.ByteString where
hex :: ByteString -> ByteString
hex = String -> ByteString
L.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall t. Hex t => t -> t
hex (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
L.unpack
unhex :: ByteString -> m ByteString
unhex x :: ByteString
x = (String -> ByteString) -> m String -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> ByteString
L.pack (m String -> m ByteString) -> m String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> m String
forall t (m :: * -> *). (Hex t, Monad m) => t -> m t
unhex (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
L.unpack ByteString
x