hylo

hylo.hs

data State
  = Init
  | Header Int
           Int
  | Meta

data Tree a
  = Node Int (V.Vector (Tree a))
  | Leaf a
  deriving (Show)

makeBaseFunctor ''Tree

algSum :: TreeF Int Int -> Int
algSum (NodeF x y) = sum y
algSum (LeafF x)   = x

coalg :: ([State], V.Vector Int) -> TreeF Int ([State], V.Vector Int)
coalg ([Init], v) =
  let (h@(Header x _), t) = header v
   in NodeF x $ V.singleton ([h], t)
coalg ([Header 0 0], v) = NodeF 0 V.empty
coalg (Header 0 0:xs, v) = NodeF 0 $ V.singleton (xs, v)
coalg (Header 0 y:xs, v) =
  NodeF 0 $ V.cons ([Meta], v) $ V.singleton (Header 0 (y - 1):xs, V.tail v)
coalg (Header x y:xs, v) =
  let (h, t) = header v
   in NodeF x $ V.singleton (h:Header (x - 1) y:xs, t)
coalg ([Meta], v) = LeafF $ V.head v

header :: V.Vector Int -> (State, V.Vector Int)
header v = (Header (v V.! 0) (v V.! 1), V.drop 2 v)