1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
{-# 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 = either fail return . unhex
instance Hex String where
hex = Prelude.concatMap w
where w ch = let s = "0123456789ABCDEF"
x = fromEnum ch
in [s !! div x 16,s !! mod x 16]
unhex [] = return []
unhex (a:b:r) = do x <- c a
y <- c b
liftM (toEnum ((x * 16) + y) :) $ unhex r
unhex [_] = Left "Non-even length"
c :: Char -> Either String Int
c '0' = return 0
c '1' = return 1
c '2' = return 2
c '3' = return 3
c '4' = return 4
c '5' = return 5
c '6' = return 6
c '7' = return 7
c '8' = return 8
c '9' = return 9
c 'A' = return 10
c 'B' = return 11
c 'C' = return 12
c 'D' = return 13
c 'E' = return 14
c 'F' = return 15
c 'a' = return 10
c 'b' = return 11
c 'c' = return 12
c 'd' = return 13
c 'e' = return 14
c 'f' = return 15
c _ = Left "Invalid hex digit!"
instance Hex B.ByteString where
hex = B.pack . hex . B.unpack
unhex x = liftM B.pack $ unhex $ B.unpack x
instance Hex L.ByteString where
hex = L.pack . hex . L.unpack
unhex x = liftM L.pack $ unhex $ L.unpack x
|
