Serbest monad'i yazdırma

Question

Bir serbest monad'i başka bir monoya çevirebilir, ancak Free f x türünde bir değer verildiğinde, tüm ağacı yazdırmak istiyorum, AST'nin her düğümünü oluşturulmuş başka bir düğümde başka bir düğümde eşlemek istemiyorum.

Gabriel Gonzales değeri uses le doğrudan doğruya

(a functor olarak Choice x = Choice x x kullanarak) gibi bir polimorfik fonksiyonu varsa aramak kolaydır

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 

olarak abstracted edilebilir

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" 

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

Ancak bu oldukça karmaşık görünüyor f x -> b'dan Free f x -> b'a gitmek için başka hangi yaklaşımlar vardır?

Answer 1

Kullanım iter ve 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 ++ ")") 

fmapFree f a den Free f b dönüşür ve iter kalan kısmını yapar. Bunu hesaba katabilirsiniz ve belki biraz daha iyi performans gösterebilirsiniz:

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)