Stampa la monade gratuita

Question

Si può tradurre una monade libera in qualsiasi altra monade, ma dato un valore di tipo Free f x, voglio stampare l'intero albero, non mappare ogni nodo dell'AST generato ad un altro nodo in un'altra monade.

Gabriel Gonzales uses il valore direttamente

showProgram :: (Show a, Show r) => Free (Toy a) r -> String 
showProgram (Free (Output a x)) = 
    "output " ++ show a ++ "\n" ++ showProgram x 
showProgram (Free (Bell x)) = 
    "bell\n" ++ showProgram x 
showProgram (Free Done) = 
    "done\n" 
showProgram (Pure r) = 
    "return " ++ show r ++ "\n" 

che può essere estratta via come

showF :: (x -> b) -> ((Free f x -> b) -> f (Free f x) -> b) -> Free f x -> b 
showF backLiftValue backLiftF = fix (showFU backLiftValue backLiftF) 
    where 
     showFU :: (x -> b) -> ((Free f x -> b) -> f (Free f x) -> b) -> (Free f x -> b) -> Free f x -> b 
     showFU backLiftValue backLiftF next = go . runIdentity . runFreeT where 
      go (FreeF c) = backLiftF next c 
      go (Pure x) = backLiftValue x 

che è facile da chiamare se abbiamo una funzione polimorfica come (usando Choice x = Choice x x come functor)

showChoice :: forall x. (x -> String) -> Choice x -> String 
showChoice show (Choice a b) = "Choice (" ++ show a ++ "," ++ show b ++ ")" 

Ma sembra abbastanza complicato per una semplice operazione ... Quali altri approcci ci sono per andare da f x -> b a Free f x -> b?

Answer 1

Usa iter e fmap:

{-# LANGUAGE DeriveFunctor #-} 

import Control.Monad.Free 

data Choice x = Choice x x deriving (Functor) 

-- iter :: Functor f => (f a -> a) -> Free f a -> a 
-- iter _ (Pure a) = a 
-- iter phi (Free m) = phi (iter phi <$> m) 

showFreeChoice :: Show a => Free Choice a -> String 
showFreeChoice = 
     iter (\(Choice l r) -> "(Choice " ++ l ++ " " ++ r ++ ")") 
    . fmap (\a -> "(Pure " ++ show a ++ ")") 

fmap converte Free f a-Free f b, e iter fa il resto. Potresti tenerne conto, e forse ottenere prestazioni migliori:

iter' :: Functor f => (f b -> b) -> (a -> b) -> Free f a -> b 
iter' f g = go where 
    go (Pure a) = g a 
    go (Free fa) = f (go <$> fa)