Drucken der freien Monade

Question

Man kann eine freie Monade in jede andere Monade übersetzen, aber bei einem Wert vom Typ Free f x möchte ich den gesamten Baum drucken, nicht jeden Knoten des erzeugten AST auf einen anderen Knoten in einer anderen Monade abbilden.

Gabriel Gonzales uses den Wert direkt

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" 

die als

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 

abstrahiert werden kann, die leicht zu nennen, wenn wir eine polymorphe Funktion wie (unter Verwendung von Choice x = Choice x x als Funktor) haben

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

Aber das scheint ziemlich kompliziert ated für eine einfache Operation ... Welche anderen Ansätze gibt es, von f x -> b zu Free f x -> b zu gehen?

Answer 1

Verwenden iter und 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 Konvertiten aus Free f a zu Free f b und iter erledigt den Rest. Sie könnten dies ausrechnen, und vielleicht ein bisschen bessere Leistung bekommen:

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)