I'm attempting to structure an AST using the Free monad based on some helpful literature that I've read online.

I have some questions about working with these kinds of ASTs in practice, which I've boiled down to the following example.

Suppose my language allows for the following commands:

{-# LANGUAGE DeriveFunctor #-} data Command next = DisplayChar Char next | DisplayString String next | Repeat Int (Free Command ()) next | Done deriving (Eq, Show, Functor)

and I define the Free monad boilerplate manually:

displayChar :: Char -> Free Command () displayChar ch = liftF (DisplayChar ch ()) displayString :: String -> Free Command () displayString str = liftF (DisplayString str ()) repeat :: Int -> Free Command () -> Free Command () repeat times block = liftF (Repeat times block ()) done :: Free Command r done = liftF Done

which allows me to specify programs like the following:

prog :: Free Command r prog = do displayChar 'A' displayString "abc" repeat 5 $ displayChar 'Z' displayChar '

' done

Now, I'd like to execute my program, which seems simple enough.

execute :: Free Command r -> IO () execute (Free (DisplayChar ch next)) = putChar ch >> execute next execute (Free (DisplayString str next)) = putStr str >> execute next execute (Free (Repeat n block next)) = forM_ [1 .. n] (\_ -> execute block) >> execute next execute (Free Done) = return () execute (Pure r) = return ()

and

λ> execute prog AabcZZZZZ

Okay. That's all nice, but now I want to learn things about my AST, and execute transformations on it. Think like optimizations in a compiler.

Here's a simple one: If a Repeat block only contains DisplayChar commands, then I'd like to replace the whole thing with an appropriate DisplayString . In other words, I'd like to transform repeat 2 (displayChar 'A' >> displayChar 'B') with displayString "ABAB" .

Here's my attempt:

optimize c@(Free (Repeat n block next)) = if all isJust charsToDisplay then let chars = catMaybes charsToDisplay in displayString (concat $ replicate n chars) >> optimize next else c >> optimize next where charsToDisplay = project getDisplayChar block optimize (Free (DisplayChar ch next)) = displayChar ch >> optimize next optimize (Free (DisplayString str next)) = displayString str >> optimize next optimize (Free Done) = done optimize c@(Pure r) = c getDisplayChar (Free (DisplayChar ch _)) = Just ch getDisplayChar _ = Nothing project :: (Free Command a -> Maybe u) -> Free Command a -> [Maybe u] project f = maybes where maybes (Pure a) = [] maybes c@(Free cmd) = let build next = f c : maybes next in case cmd of DisplayChar _ next -> build next DisplayString _ next -> build next Repeat _ _ next -> build next Done -> []

Observing the AST in GHCI shows that this work correctly, and indeed

λ> optimize $ repeat 3 (displayChar 'A' >> displayChar 'B') Free (DisplayString "ABABAB" (Pure ())) λ> execute . optimize $ prog AabcZZZZZ λ> execute prog AabcZZZZZ

But I'm not happy. In my opinion, this code is repetitive. I have to define how to traverse through my AST every time I want to examine it, or define functions like my project that give me a view into it. I have to do this same thing when I want to modify the tree.

So, my question: is this approach my only option? Can I pattern-match on my AST without dealing with tonnes of nesting? Can I traverse the tree in a consistent and generic way (maybe Zippers, or Traversable, or something else)? What approaches are commonly taken here?

The whole file is below: