Final Tagless Tree

Final Tagless Tree.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTSyntax        #-}


-- * (G)ADT

data DTree where
  Empty :: DTree
  Node  :: String -> DTree -> DTree -> DTree
  deriving (Show)

-- $> Node "bar" Empty $ Node "foo" Empty Empty


-- * Final Tagless

class FTTree tree where
  empty :: tree
  node :: String -> tree -> tree -> tree

ctree :: FTTree tree => tree
ctree = node "bar" empty $ node "foo" empty empty


-- * Interpratation as ADT

instance FTTree DTree where
  empty = Empty
  node = Node

-- $> ctree @DTree


-- * Interpratation as String

instance FTTree String where
  empty = "empty"
  node value left right = unwords ["(node", show value, left, right, ")"]

-- $> ctree @String


-- * Interpratation as IO

instance FTTree (IO ()) where
  empty = putStr "empty"
  node value left right = do
    putStr "(node "
    putStr $ show value
    putStr " "
    left
    putStr " "
    right
    putStr ")"

-- $> ctree @(IO ()) >> putStrLn ""