Reconstructing a Huffman tree from a (preorder) bit string in Haskell

Question

I have the following type of Haskell polymorphic data:

data Tree a = Leaf Int a | Node Int (Tree a) (Tree a)

The tree will be compressed in the bit string 0s and 1s. A '0' means Node, followed by the encoding of the left subtree, and then the encoding of the right subtree. "1" means a sheet followed by 7 bits of information (for example, it could be a char). Each node / sheet should also contain the frequency of the information stored, but this is not important for this problem (therefore, we can put something there).

For example, starting with this encoded tree

[0,0,0,1,1,1,0,1,0,1,1,1,1,1,1,0,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
 1,0,0,1,1,1,1,1,1,1,0,0,1,0,0,1,1,1,1,0,1,1,1,1,1,1,0,0,0,0,1]

supposed to return something like this

Node 0 (Node 0 (Node 0 (Leaf 0 'k') (Leaf 0 't')) 
       (Node 0 (Node 0 (Leaf 0 'q') (Leaf 0 'g')) (Leaf 0 'r'))) 
(Node 0 (Leaf 0 'w') (Leaf 0 'a'))

(the interval is not important, but it does not fit on one line).

, . , ( - , /), .

!

Answer 1

, (ad-hoc, ) .

parse :

parse  :: [Int] -> Tree Char

, , , . . , , ( , , , ).

, : , 0, . () . . . , parse' ( , ):

parse' :: [Int] -> (Tree Char, [Int])

, 0 , .
1 7 - char ( toChar), Leaf, .

parse' (0:xs) = let (l, xs')    = parse' xs
                    (r, xs'')   = parse' xs' in (Node 0 l r, xs'') --xs'' should be []
parse' (1:xs) = let w = toChar (take 7 xs) in (Leaf 0 w , drop 7 xs)

, .

parse xs = fst $ parse' xs

Answer 2

, . , , : , .

"string" "bit-string",

newtype Parser a = Parser (StateT [Bool] [] a)
    deriving (Functor, Applicative, Monad, Alternative)

runParser :: Parser a -> [Bool] -> [(a, [Bool])]
runParser (Parser m) = runStateT m

, , a s. GHC GeneralizedNewtypeDeriving Monad .

, Parser (Tree SevenBits) - , . ( 7 Word8 Functor Tree fmap.) Tree, - , , .

data Tree a = Leaf a | Node (Tree a) (Tree a) deriving Show

type SevenBits = (Bool, Bool, Bool, Bool, Bool, Bool, Bool)

, , :

one :: Parser Bool
one = Parser $ do
    stream <- get
    case stream of
        [] -> empty
        (x:xs) -> put xs *> return x

, , :

bit :: Bool -> Parser ()
bit b = do
    i <- one
    guard (i == b)

, replicateM . Leaf.

sevenBits :: Parser SevenBits
sevenBits = pack7 <$> replicateM 7 one
    where pack7 [a,b,c,d,e,f,g] = (a, b, c, d, e, f, g)

, , , . Node Leaf, <|>.

tree :: Parser (Tree SevenBits)
tree = node <|> leaf
    where node = bit False *> liftA2 Node tree tree
          leaf = bit True *> fmap Leaf sevenBits

Node , , , liftA2. , Node , , <|> Node Leaf.

, Tree Tree. . , one , case , , . -, , .

@behzad.nouri foldr. , , - - , , liftA2 <|>, , .

, , Leaf, (-) 0 1. , .

ghci> runParser tree $ map (>0) [0, 1, 0,0,0,0,0,0,0, 1, 0,0,0,0,0,0,1]
[(Node (Leaf (False, False, False, False, False, False, False)) (Leaf (False, False, False, False, False, False, True)),[])]

Answer 3

make the correct fold:

import Data.Char (chr)

data Tree a = Leaf a | Node (Tree a) (Tree a)
  deriving Show

build :: [Int] -> [Tree Char]
build xs = foldr go (\_ _ -> []) xs 0 0
  where
  nil = Leaf '?'
  go 0 run 0 0 = case run 0 0 of
    []     -> Node nil nil:[]
    x:[]   -> Node x   nil:[]
    x:y:zs -> Node x   y  :zs

  go 1 run 0 0 = run 0 1
  go _ _   _ 0 = error "this should not happen!"
  go x run v 7 = (Leaf $ chr (v * 2 + x)): run 0 0
  go x run v k = run (v * 2 + x) (k + 1)

then

\> head $ build [0,0,0,1,1,1,0, ...] -- the list of 01s as in the question
Node (Node (Node (Leaf 'k') (Leaf 't'))
      (Node (Node (Leaf 'q') (Leaf 'g')) (Leaf 'r')))
 (Node (Leaf 'w') (Leaf 'a'))