module Data.NibbleString (
Nibble,
NibbleString(..),
empty,
singleton,
null,
length,
pack,
unpack,
byte2Nibbles,
isPrefixOf,
head,
tail,
drop,
append
) where
import Prelude hiding (head, tail, length, drop, null)
import qualified Prelude
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BC
import Data.String
import Data.Word
import Numeric
type Nibble = Word8
data NibbleString = EvenNibbleString B.ByteString | OddNibbleString Nibble B.ByteString deriving (Show, Eq, Ord)
instance IsString NibbleString where
fromString "" = EvenNibbleString B.empty
fromString s | even $ Prelude.length s = case B16.decode $ BC.pack s of
(x, unparsable) | B.null unparsable -> EvenNibbleString x
_ -> error ("fromString conversion to NibbleString failed. The string was of the wrong format: " ++ show s)
fromString (c:rest) = case B16.decode $ BC.pack rest of
(x, unparsable) | B.null unparsable ->
case readHex [c] of
[(w, "")] -> OddNibbleString w x
_ -> error ("fromString conversion to NibbleString failed. The string was of the wrong format: " ++ show (c:rest))
_ -> error ("fromString conversion to NibbleString failed. The string was of the wrong format: " ++ show (c:rest))
length::NibbleString->Int
length (EvenNibbleString s) = B.length s `shiftL` 1
length (OddNibbleString _ s) = 1 + B.length s `shiftL` 1
singleton::Nibble->NibbleString
singleton c | c > 0xF = error "singleton: Nibble overflow"
singleton c = OddNibbleString c B.empty
null::NibbleString->Bool
null (EvenNibbleString s) = B.null s
null (OddNibbleString _ _) = False
empty::NibbleString
empty = EvenNibbleString B.empty
append::NibbleString->NibbleString->NibbleString
append (EvenNibbleString s1) (EvenNibbleString s2) = EvenNibbleString (s1 `B.append` s2)
append (OddNibbleString c1 s1) (EvenNibbleString s2) = OddNibbleString c1 (s1 `B.append` s2)
append (OddNibbleString c1 s1) (OddNibbleString c2 s2) | B.null s1 = EvenNibbleString (B.cons (c1 `shiftL` 4 + c2) $ s1 `B.append` s2)
append x y = pack (unpack x ++ unpack y)
head::NibbleString->Nibble
head (EvenNibbleString s) | B.null s = error "Empty NibbleString"
head (OddNibbleString c _) = c
head (EvenNibbleString s) = B.head s `shiftR` 4
tail::NibbleString->NibbleString
tail (EvenNibbleString s) | B.null s = error "Empty NibbleString"
tail (OddNibbleString _ s) = EvenNibbleString s
tail (EvenNibbleString s) = OddNibbleString (B.head s .&. 0xF) $ B.tail s
pack::[Nibble]->NibbleString
pack (c:_) | c > 0xf = error "pack: Nibble overflow"
pack (c:rest) | even $ Prelude.length rest = c `prependNibble` pack rest
where
prependNibble c2 (EvenNibbleString x) = OddNibbleString c2 x
prependNibble _ (OddNibbleString _ _) = undefined
pack x = EvenNibbleString $ B.pack (nibbles2Bytes x)
where
nibbles2Bytes::[Nibble]->[Word8]
nibbles2Bytes [] = []
nibbles2Bytes [_] = error "Error in N.pack, nibbles2Bytes: an odd length string was passed into nibbles2Bytes"
nibbles2Bytes (x1:x2:_) | x1 > 0xF || x2 > 0xF = error "pack: Nibble overflow"
nibbles2Bytes (x1:x2:rest) = x1 `shiftL` 4 + x2:nibbles2Bytes rest
unpack::NibbleString->[Nibble]
unpack (OddNibbleString c rest) = c:unpack (EvenNibbleString rest)
unpack (EvenNibbleString x) = byte2Nibbles =<< B.unpack x
byte2Nibbles::Word8->[Nibble]
byte2Nibbles x = [x `shiftR` 4, x .&. 0xF]
isPrefixOf::NibbleString->NibbleString->Bool
isPrefixOf (EvenNibbleString s1) _ | B.null s1 = True
isPrefixOf (EvenNibbleString s1) (EvenNibbleString s2) = s1 `B.isPrefixOf` s2
isPrefixOf (OddNibbleString c1 s1) n2 =
case length n2 of
0 -> False
_ -> c1 == head n2 && EvenNibbleString s1 `isPrefixOf` tail n2
isPrefixOf n1 n2 | head n1 == head n2 = tail n1 `isPrefixOf` tail n2
isPrefixOf (EvenNibbleString s1) (OddNibbleString c2 s2) = c1 == c2 && OddNibbleString c1 (B.tail s1) `isPrefixOf` EvenNibbleString s2
where
c1 = B.head s1 `shiftR` 4
drop::Int->NibbleString->NibbleString
drop 0 s = s
drop n s | n > length s = empty
drop n (EvenNibbleString s) | even n = EvenNibbleString (B.drop (n `shiftR` 1) s)
drop 1 s = tail s
drop n (EvenNibbleString s) = drop 1 $ EvenNibbleString (B.drop ((n 1) `shiftR` 1) s)
drop n (OddNibbleString _ s) | even n = drop (n1) $ EvenNibbleString s
drop n (OddNibbleString _ s) = drop (n 1) $ EvenNibbleString s