An idea of reversible parser

reversible.hs

-- An idea of reversible parser
-- todo: String8 Structure

{-# OPTIONS -XViewPatterns #-}
                                              
import Data.Bits
import Test.HUnit

main = runTestTT $ test [
        "bitOf" ~: testBitOf,
        "u8" ~: testU8,
        "char" ~: testChar,
        "string0" ~: testString]

-- write 8 bit number to the stream

data Bit = H | L deriving (Show, Eq)

-- Return ith bit of n
bitOf :: Int -> Int -> Bit
bitOf n i = if testBit n i then H else L

-- Return a number where ith bit is H/L.
bitOf_ :: Int -> Bit -> Int
bitOf_ n H = 0 `setBit` n
bitOf_ n L = 0

testBitOf = test [
              "bitOf"  ~: bitOf  8 3 ~=? H,
              "bitOf_" ~: bitOf_ 3 H ~=? 8]

-- write 8 bit int: u8 170 [] => [H,L,H,L,H,L,H,L]

u8 :: Int -> [Bit] -> [Bit]
u8 i bs = let b0 = bitOf i 0
              b1 = bitOf i 1
              b2 = bitOf i 2
              b3 = bitOf i 3
              b4 = bitOf i 4
              b5 = bitOf i 5
              b6 = bitOf i 6
              b7 = bitOf i 7
          in b7 : b6 : b5 : b4 : b3 : b2 : b1 : b0 : bs

-- read 8 bit int: u8_ [H,L,H,L,H,L,H,L] => (170, [])

u8_ :: [Bit] -> (Int, [Bit])
u8_ (b7 : b6 : b5 : b4 : b3 : b2 : b1 : b0 : bs) = ((bitOf_ 0 b0) +
                                                    (bitOf_ 1 b1) +
                                                    (bitOf_ 2 b2) +
                                                    (bitOf_ 3 b3) +
                                                    (bitOf_ 4 b4) +
                                                    (bitOf_ 5 b5) +
                                                    (bitOf_ 6 b6) +
                                                    (bitOf_ 7 b7), bs)

testU8 = test [
          "u8"  ~: u8 170 [] ~=? [H,L,H,L,H,L,H,L],
          "u8_" ~: u8_ [H,L,H,L,H,L,H,L] ~=? (170, [])]

-- write Char
char :: Char -> [Bit] -> [Bit]
char c bs = u8 (fromEnum c) bs

-- read Char
char_ :: [Bit] -> (Char, [Bit])
char_ (u8_ -> (toEnum -> n, bs)) = (n, bs)

testChar = test [
            "char"  ~: char 'A' [] ~=? [L,H,L,L,L,L,L,H],
            "char_" ~: char_ [L,H,L,L,L,L,L,H] ~=? ('A',[])]

-- todo: repeat writer n times

many :: (t -> [Bit] -> [Bit]) -> Int -> [t] -> [Bit] -> [Bit]
many f n (c:cs) bs = f c $ many f (n - 1) cs bs
many f 0 [] bs     = bs

-- Write a string and the length.
string :: (String, [Bit]) -> ([Bit])
string  (cs, bs)   = string' (chars (cs, bs))
string' (size, bs) = char size bs

-- Write a string with constant size to the stream.
chars :: (String, [Bit]) -> (Char, [Bit])
chars ("", bs)     = ('\000', bs)
chars (charsHead -> (c, (chars -> (n, bs)))) = (succ n, char c bs)

-- Take a head character from the string.
charsHead :: (String, [Bit]) -> (Char, (String, [Bit]))
charsHead (c:cs, bs) = (c, (cs, bs))

-- Read a string and the length.
string_ :: ([Bit]) -> (String, [Bit])
string_ (string'_ -> (chars_ -> (cs, bs))) = (cs, bs)
string'_ (char_ -> (size, bs)) = (size, bs)

-- Read a string.
chars_ :: (Char, [Bit]) -> (String, [Bit])
chars_ ('\000', bs) = ("", bs)
chars_ (pred -> n, char_ -> (c, bs)) = charsHead_ (c, chars_ (n, bs))
charsHead_ (c, (cs, bs)) = (c:cs, bs)

testString = test [
             "chars" ~: chars ("Hello", []) ~=? ('\005',[L,H,L,L,H,L,L,L,L,H,H,L,L,H,L,H,L,H,H,L,H,H,L,L,L,H,H,L,H,H,L,L,L,H,H,L,H,H,H,H]),
             "chars_" ~: chars_ ('\005', [L,H,L,L,H,L,L,L,L,H,H,L,L,H,L,H,L,H,H,L,H,H,L,L,L,H,H,L,H,H,L,L,L,H,H,L,H,H,H,H]) ~=? ("Hello",[]),

             "string" ~: string ("ABC", []) ~=? [L,L,L,L,L,L,H,H,L,H,L,L,L,L,L,H,L,H,L,L,L,L,H,L,L,H,L,L,L,L,H,H],
             "string_" ~: string_ ([L,L,L,L,L,L,H,H,L,H,L,L,L,L,L,H,L,H,L,L,L,L,H,L,L,H,L,L,L,L,H,H]) ~=? ("ABC", []),
             "makeString8"  ~: makeString8 ("Hello") ~=? (String8 '\005' "Hello"),
             "makeString8_" ~: makeString8_ (String8 '\005' "Hello") ~=? ("Hello")]

---------- todo:

data String8 = String8 Char String deriving (Show, Eq)

makeString8 :: (String) -> (String8)
makeString8 (stringSize -> (n, xs)) = String8 n xs

makeString8_ :: (String8) -> (String)
makeString8_ (String8 n xs) = (stringSize_ (n, xs))

stringSize :: (String) -> (Char, String)
stringSize ("") = ('\000', "")
stringSize (x : (stringSize -> (n, xs))) = (succ n, x:xs)

stringSize_ :: (Char, String) -> (String)
stringSize_ ('\000', "") = ("")
stringSize_ (pred -> n, x:xs) = (x : (stringSize_ (n, xs)))

-- string8 :: (String8, [Bit]) -> ([Bit])
-- string8 (String8 n xs, bs) = string8' (n, (chars (xs, bs)))

-- string8' :: (Char, (Char, [Bit])) -> ([Bit])
-- string8' (_, (_, bs)) = bs

-- string_ n xs = let (c, xs') = char_ xs
--                    (cs, xs'') = string_ (n - 1) xs'
--                in ((c:cs), xs'')

-- string_ (pred -> n) (char_ -> (c, xs')) = let (cs, xs'') = string_ n xs'
--                                    in ((c:cs), xs'')

-- string_ (pred -> n) (char_ -> (c, string_ n -> (cs, bs))) = (c:cs, bs)

-- bstring_info "hello" []
bstring_info :: String -> [Bit] -> [Bit]
bstring_info (list_length -> (n, cs)) bs = u8 n $ (many char) n cs bs