In monad miễn phí

Question

Có thể dịch đơn miễn phí sang bất kỳ đơn nguyên nào khác, nhưng với giá trị loại Free f x, tôi muốn in toàn bộ cây, không ánh xạ mọi nút của AST được tạo ra cho một nút khác trong một đơn nguyên khác.

Gabriel Gonzales uses giá trị trực tiếp

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" 

có thể được tóm tắt xôi như

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 

đó là dễ dàng để gọi nếu chúng ta có chức năng đa hình tương tự (sử dụng Choice x = Choice x x như một functor)

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

Nhưng điều đó có vẻ khá phức tạp ated cho một hoạt động đơn giản ... Còn cách nào khác để đi từ f x -> b đến Free f x -> b?

Answer 1

Sử dụng iter và 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 chuyển đổi Free f a-Free f b, và iter hiện phần còn lại. Bạn có thể đánh giá điều này và có thể có hiệu suất tốt hơn một chút:

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)