    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE TypeSynonymInstances #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Hex
    -- Copyright   :  (c) Taru Karttunen 2009
    -- License     :  BSD-style
    -- Maintainer  :  taruti@taruti.net
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- Convert strings into hexadecimal and back.
    --
    -----------------------------------------------------------------------------
    module Data.Hex(Hex(..)) where

    import Control.Monad (liftM)
    import qualified Data.ByteString.Char8 as B
    import qualified Data.ByteString.Lazy.Char8 as L

    -- | Convert strings into hexadecimal and back.
    class Hex t where
        -- | Convert string into hexadecimal.
        hex   :: t -> t
        -- | Convert from hexadecimal and fail on invalid input.
        unhex :: t -> Either String t
        -- | Convert from hexadecimal and fail on invalud input.
        unhexM :: MonadFail m => t -> m t
        unhexM = (String -> m t) -> (t -> m t) -> Either String t -> m t
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> m t
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail t -> m t
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String t -> m t) -> (t -> Either String t) -> t -> m t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . t -> Either String t
    forall t. Hex t => t -> Either String t
    unhex

    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 {p}. Enum p => p -> String
    w
            where w :: p -> String
    w p
    ch = let s :: String
    s = String
    "0123456789ABCDEF"
                             x :: Int
    x = p -> Int
    forall a. Enum a => a -> Int
    fromEnum p
    ch
                         in [String
    s String -> Int -> Char
    forall a. HasCallStack => [a] -> Int -> a
    !! Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div Int
    x Int
    16,String
    s String -> Int -> Char
    forall a. HasCallStack => [a] -> Int -> a
    !! Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    mod Int
    x Int
    16]
        unhex :: String -> Either String String
    unhex []      = String -> Either String String
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        unhex (Char
    a:Char
    b:String
    r) = do x <- Char -> Either String Int
    c Char
    a
                           y <- c b
                           liftM (toEnum ((x * 16) + y) :) $ unhex r
        unhex [Char
    _]      = String -> Either String String
    forall a b. a -> Either a b
    Left String
    "Non-even length"

    c :: Char -> Either String Int
    c :: Char -> Either String Int
    c Char
    '0' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    0
    c Char
    '1' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    1
    c Char
    '2' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    2
    c Char
    '3' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    3
    c Char
    '4' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    4
    c Char
    '5' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    5
    c Char
    '6' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    6
    c Char
    '7' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    7
    c Char
    '8' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    8
    c Char
    '9' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    9
    c Char
    'A' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    10
    c Char
    'B' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    11
    c Char
    'C' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    12
    c Char
    'D' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    13
    c Char
    'E' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    14
    c Char
    'F' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    15
    c Char
    'a' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    10
    c Char
    'b' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    11
    c Char
    'c' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    12
    c Char
    'd' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    13
    c Char
    'e' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    14
    c Char
    'f' = Int -> Either String Int
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    15
    c Char
    _   = String -> Either String Int
    forall a b. a -> Either a b
    Left String
    "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 -> Either String ByteString
    unhex ByteString
    x = (String -> ByteString)
    -> Either String String -> Either String ByteString
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM String -> ByteString
    B.pack (Either String String -> Either String ByteString)
    -> Either String String -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall t. Hex t => t -> Either String t
    unhex (String -> Either String String) -> String -> Either String 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 -> Either String ByteString
    unhex ByteString
    x = (String -> ByteString)
    -> Either String String -> Either String ByteString
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM String -> ByteString
    L.pack (Either String String -> Either String ByteString)
    -> Either String String -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall t. Hex t => t -> Either String t
    unhex (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $ ByteString -> String
    L.unpack ByteString
    x