Применение семантики к свободным монадам
Я пытаюсь абстрагировать шаблон применения определенной семантики к свободной монаде над некоторым функтором. Пример, который я использую, чтобы мотивировать это, - применение обновлений к сущности в игре. Поэтому я импортирую несколько библиотек и определяю несколько типов примеров и класс сущностей для целей этого примера (я использую бесплатную реализацию монады в control-monad-free):
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.Free
import Control.Monad.Identity
import Control.Monad.Writer
-- Things which can happen to an entity
data Order = Order deriving Show
data Damage = Damage deriving Show
class Entity a where
evolve :: Double -> a -> a
order :: Order -> a -> a
damage :: Damage -> a -> a
-- Make a trivial entity for testing purposes
data Example = Example deriving Show
instance Entity Example where
evolve _ a = a
order _ a = a
damage _ a = a
-- A type to hold all the possible update types
data EntityUpdate =
UpdateTime Double
| UpdateOrder Order
| UpdateDamage Damage
deriving (Show)
-- Wrap UpdateMessage to create a Functor for constructing the free monad
data UpdateFunctor cont =
UpdateFunctor {updateMessage :: EntityUpdate, continue :: cont} deriving (Show, Functor)
-- Type synonym for the free monad
type Update = Free UpdateEntity
Теперь я поднимаю некоторые основные обновления в монаде:
liftF = wrap . fmap Pure
updateTime :: Double -> Update ()
updateTime t = liftUpdate $ UpdateTime t
updateOrder :: Order -> Update ()
updateOrder o = liftUpdate $ UpdateOrder o
updateDamage :: Damage -> Update ()
updateDamage d = liftUpdate $ UpdateDamage d
test :: Update ()
test = do
updateTime 8.0
updateOrder Order
updateDamage Damage
updateTime 4.0
updateDamage Damage
updateTime 6.0
updateOrder Order
updateTime 8.0
Теперь у нас есть свободная монада, нам нужно предоставить возможность различных реализаций или семантических интерпретаций экземпляра монады, таких как test выше. Лучший шаблон, который я могу придумать для этого, дается следующей функцией:
interpret :: (Monad m, Functor f, fm ~ Free f c) => (f fm -> fm) -> (f fm -> a -> m a) -> fm -> a -> m a
interpret _ _ (Pure _ ) entity = return entity
interpret c f (Impure u) entity = f u entity >>= interpret c f (c u)
Затем с некоторыми базовыми семантическими функциями мы можем дать две следующие возможные интерпретации, одну как базовую оценку, а другую как ведение журналирования, определяющего монаду писателя:
update (UpdateTime t) = evolve t
update (UpdateOrder o) = order o
update (UpdateDamage d) = damage d
eval :: Entity a => Update () -> a -> a
eval updates entity = runIdentity $ interpret continue update' updates entity where
update' u entity = return $ update (updateMessage u) entity
logMessage (UpdateTime t) = "Simulating time for " ++ show t ++ " seconds.\n"
logMessage (UpdateOrder o) = "Giving an order.\n"
logMessage (UpdateDamage d) = "Applying damage.\n"
evalLog :: Entity a => Update () -> a -> Writer String a
evalLog = interpret continue $ \u entity -> do
let m = updateMessage u
tell $ logMessage m
return $ update m entity
Тестирование это в GHCI:
> eval test Example
Example
> putStr . execWriter $ evalLog test Example
Simulating time for 8.0 seconds.
Giving an order.
Applying damage.
Simulating time for 4.0 seconds.
Applying damage.
Simulating time for 6.0 seconds.
Giving an order.
Simulating time for 8.0 seconds.
Все это прекрасно работает, но у меня немного неприятное ощущение, что оно может быть более общим или лучше организованным. На первый взгляд необходимость предоставления функции для продолжения была неочевидна, и я не уверен, что это лучший подход. Я предпринял несколько попыток переопределить interpret с точки зрения функций в модуле Control.Monad.Free, таких как foldFree а также induce, Но все они, кажется, не совсем работают.
Я нахожусь на правильном пути с этим, или я ошибаюсь? Большинство статей о свободных монадах, которые я обнаружил, сосредоточены на их эффективности или различных способах их реализации, а не на шаблонах для их фактического использования.
Также кажется желательным заключить это в некоторый вид Semantic класс, так что я мог бы просто сделать разные экземпляры монады из моей свободной монады, обернув функтор в новый тип и сделав его экземпляром этого класса. Однако я не мог понять, как это сделать.
ОБНОВИТЬ --
Я хотел бы принять оба ответа, так как они оба чрезвычайно информативны и вдумчиво написаны. В конце концов, изменение принятого ответа содержит функцию, за которой я был:
interpret :: (Functor m, Monad m) => (forall x. f x -> m x) -> Free f a -> m a
interpret evalF = retract . hoistFree evalF
(retract а также hoistFree находятся в бесплатной упаковке Эдварда Кеммета в Control.Monad.Free).
Все три pipes, operational и бесплатный пакет sacundim очень актуален и выглядит так, как будто он будет очень полезен для меня в будущем. Спасибо вам всем.
2 ответа
Я не совсем понимаю ваш пример, но я думаю, что вы в основном реконструируете operational пакет здесь. Ваш EntityUpdate Тип очень похож на набор инструкций в смысле operational, и ваш UpdateFunctor это что-то вроде свободного функтора над набором инструкций - именно эта конструкция operational и бесплатные монады. (См. "Действительно ли операционная изоморфна свободной монаде?" И это обсуждение Reddit).
Но в любом случае, operational пакет имеет функцию, которую вы хотите, interpretWithMonad:
interpretWithMonad :: forall instr m b.
Monad m =>
(forall a. instr a -> m a)
-> Program instr b
-> m b
Это позволяет вам предоставлять функцию, которая интерпретирует каждую из инструкций в вашей программе (каждая EntityUpdate ценность) как монадическое действие, а обо всем остальном заботится.
Если мне позволят немного саморекламы, я совсем недавно писал свою собственную версию operational используя бесплатные монады, потому что я хотел иметь Applicative версия operational "s Program тип. Поскольку ваш пример показался мне чисто аппликативным, я прошел через упражнение evalLog с точки зрения моей библиотеки, и я мог бы также вставить сюда. (Я не мог понять твои eval функция.) Здесь идет:
{-# LANGUAGE GADTs, ScopedTypeVariables, RankNTypes #-}
import Control.Applicative
import Control.Applicative.Operational
import Control.Monad.Writer
data Order = Order deriving Show
data Damage = Damage deriving Show
-- UpdateI is short for "UpdateInstruction"
data UpdateI a where
UpdateTime :: Double -> UpdateI ()
UpdateOrder :: Order -> UpdateI ()
UpdateDamage :: Damage -> UpdateI ()
type Update = ProgramA UpdateI
updateTime :: Double -> Update ()
updateTime = singleton . UpdateTime
updateOrder :: Order -> Update ()
updateOrder = singleton . UpdateOrder
updateDamage :: Damage -> Update ()
updateDamage = singleton . UpdateDamage
test :: Update ()
test = updateTime 8.0
*> updateOrder Order
*> updateDamage Damage
*> updateTime 4.0
*> updateDamage Damage
*> updateTime 6.0
*> updateOrder Order
*> updateTime 8.0
evalLog :: forall a. Update a -> Writer String a
evalLog = interpretA evalI
where evalI :: forall x. UpdateI x -> Writer String x
evalI (UpdateTime t) =
tell $ "Simulating time for " ++ show t ++ " seconds.\n"
evalI (UpdateOrder Order) = tell $ "Giving an order.\n"
evalI (UpdateDamage Damage) = tell $ "Applying damage.\n"
Выход:
*Main> putStr $ execWriter (evalLog test)
Simulating time for 8.0 seconds.
Giving an order.
Applying damage.
Simulating time for 4.0 seconds.
Applying damage.
Simulating time for 6.0 seconds.
Giving an order.
Simulating time for 8.0 seconds.
Хитрость здесь такая же, как в interpretWithMonad функция из оригинальной упаковки, но адаптированная под аппликативные:
interpretA :: forall instr f a. Applicative f =>
(forall x. instr x -> f x)
-> ProgramA instr a -> f a
Если вам действительно нужна монадическая интерпретация, это просто вопрос импорта Control.Monad.Operational (либо оригинал, либо мой) вместо Control.Applicative.Operational и используя Program вместо ProgramA, ProgramA однако дает вам больше возможностей для статического изучения программы:
-- Sum the total time requested by updateTime instructions in an
-- applicative UpdateI program. You can't do this with monads.
sumTime :: ProgramA UpdateI () -> Double
sumTime = sumTime' . viewA
where sumTime' :: forall x. ProgramViewA UpdateI x -> Double
sumTime' (UpdateTime t :<**> k) = t + sumTime' k
sumTime' (_ :<**> k) = sumTime' k
sumTime' (Pure _) = 0
Пример использования sumTime:
*Main> sumTime test
26.0
РЕДАКТИРОВАТЬ: Оглядываясь назад, я должен был предоставить этот более короткий ответ. Это предполагает, что вы используете Control.Monad.Free из пакета Эдварда Кметта:
interpret :: (Functor m, Monad m) =>
(forall x. f x -> m x)
-> Free f a -> m a
interpret evalF = retract . hoistFree evalF
Вы можете использовать мой pipes библиотека, предоставляющая высокоуровневые абстракции для работы со свободными монадами.
pipes использует свободные монады для уточнения каждой части вычисления:
Producerданных (т.е. ваше обновление) является бесплатной монадойConsumerданных (т. е. ваш переводчик) - это бесплатная монадаPipeданных (т. е. ваш логгер) - это бесплатная монада
На самом деле, они не являются тремя отдельными свободными монадами: это все та же свободная замаскированная монада. Как только вы определите все три из них, вы соедините их, используя композицию труб (>->), чтобы начать потоковую передачу данных.
Я начну с немного модифицированной версии вашего примера, которая пропускает класс типов, который вы написали:
{-# LANGUAGE RankNTypes #-}
import Control.Lens
import Control.Proxy
import Control.Proxy.Trans.State
import Control.Monad.Trans.Writer
data Order = Order deriving (Show)
data Damage = Damage deriving (Show)
data EntityUpdate
= UpdateTime Double
| UpdateOrder Order
| UpdateDamage Damage
deriving (Show)
Теперь то, что мы делаем, это определить Update быть Producer из EntityUpdates:
type Update r = forall m p . (Monad m, Proxy p) => Producer p EntityUpdate m r
Затем мы определяем фактические команды. Каждая команда выдает соответствующее обновление, используя respond Примитив канала, который отправляет данные далее для обработки.
updateTime :: Double -> Update ()
updateTime t = respond (UpdateTime t)
updateOrder :: Order -> Update ()
updateOrder o = respond (UpdateOrder o)
updateDamage :: Damage -> Update ()
updateDamage d = respond (UpdateDamage d)
Так как Producer это бесплатная монада, мы можем собрать ее используя do обозначения так же, как вы сделали для вашего test функция:
test :: () -> Update ()
-- i.e. () -> Producer p EntityUpdate m ()
test () = runIdentityP $ do
updateTime 8.0
updateOrder Order
updateDamage Damage
updateTime 4.0
updateDamage Damage
updateTime 6.0
updateOrder Order
updateTime 8.0
Тем не менее, мы можем утвердить интерпретатор как Consumer данных тоже. Это хорошо, потому что мы можем напрямую накладывать на состояние интерпретатор вместо использования Entity класс вы определили.
Я буду использовать простое состояние:
data MyState = MyState { _numOrders :: Int, _time :: Double, _health :: Int }
deriving (Show)
begin :: MyState
begin= MyState 0 0 100
... и определите несколько удобных линз для ясности:
numOrders :: Lens' MyState Int
numOrders = lens _numOrders (\s x -> s { _numOrders = x})
time :: Lens' MyState Double
time = lens _time (\s x -> s { _time = x })
health :: Lens' MyState Int
health = lens _health (\s x -> s { _health = x })
... и теперь я могу определить интерпретатор с сохранением состояния:
eval :: (Proxy p) => () -> Consumer (StateP MyState p) EntityUpdate IO r
eval () = forever $ do
entityUpdate <- request ()
case entityUpdate of
UpdateTime tDiff -> modify (time +~ tDiff)
UpdateOrder _ -> modify (numOrders +~ 1 )
UpdateDamage _ -> modify (health -~ 1 )
s <- get
lift $ putStrLn $ "Current state is: " ++ show s
Это делает намного более ясным, что делает переводчик. Мы можем сразу увидеть, как он обрабатывает входящие значения с учетом состояния.
Чтобы подключить наш Producer а также Consumer мы используем (>->) оператор композиции, затем runProxy, который преобразует наш конвейер обратно в базовую монаду:
main1 = runProxy $ evalStateK begin $ test >-> eval
... который дает следующий результат:
>>> main1
Current state is: MyState {_numOrders = 0, _time = 8.0, _health = 100}
Current state is: MyState {_numOrders = 1, _time = 8.0, _health = 100}
Current state is: MyState {_numOrders = 1, _time = 8.0, _health = 99}
Current state is: MyState {_numOrders = 1, _time = 12.0, _health = 99}
Current state is: MyState {_numOrders = 1, _time = 12.0, _health = 98}
Current state is: MyState {_numOrders = 1, _time = 18.0, _health = 98}
Current state is: MyState {_numOrders = 2, _time = 18.0, _health = 98}
Current state is: MyState {_numOrders = 2, _time = 26.0, _health = 98}
Вы можете удивиться, почему мы должны сделать это в два этапа. Почему бы просто не избавиться от runProxy часть?
Причина в том, что мы можем составить более двух вещей. Например, мы можем очень легко вставить этап регистрации между test а также eval, Я называю эти промежуточные этапы Pipes:
logger
:: (Monad m, Proxy p)
=> () -> Pipe p EntityUpdate EntityUpdate (WriterT String m) r
logger () = runIdentityP $ forever $ do
entityUpdate <- request ()
lift $ tell $ case entityUpdate of
UpdateTime t -> "Simulating time for " ++ show t ++ " seconds.\n"
UpdateOrder o -> "Giving an order.\n"
UpdateDamage d -> "Applying damage.\n"
respond entityUpdate
Опять же, мы можем очень четко увидеть, что logger Является ли requestценность sa, tellSA представление значения, а затем передает значение дальше вниз по течению, используя respond,
Мы можем вставить это между test а также logger, Единственное, о чем мы должны знать, это то, что все этапы должны иметь одинаковую базовую монаду, поэтому мы используем raiseK вставить WriterT слой для eval так что это соответствует базовой монаде logger:
main2 = execWriterT $ runProxy $ evalStateK begin $
test >-> logger >-> raiseK eval
... который дает следующий результат:
>>> main2
Current state is: MyState {_numOrders = 0, _time = 8.0, _health = 100}
Current state is: MyState {_numOrders = 1, _time = 8.0, _health = 100}
Current state is: MyState {_numOrders = 1, _time = 8.0, _health = 99}
Current state is: MyState {_numOrders = 1, _time = 12.0, _health = 99}
Current state is: MyState {_numOrders = 1, _time = 12.0, _health = 98}
Current state is: MyState {_numOrders = 1, _time = 18.0, _health = 98}
Current state is: MyState {_numOrders = 2, _time = 18.0, _health = 98}
Current state is: MyState {_numOrders = 2, _time = 26.0, _health = 98}
"Simulating time for 8.0 seconds.\nGiving an order.\nApplying damage.\nSimulating time for 4.0 seconds.\nApplying damage.\nSimulating time for 6.0 seconds.\nGiving an order.\nSimulating time for 8.0 seconds.\n"
pipes был разработан, чтобы решить именно ту проблему, которую вы описываете. В большинстве случаев мы хотим использовать не только DSL, который генерирует данные, но также интерпретаторы и промежуточные этапы обработки. pipes обрабатывает все эти концепции одинаково и моделирует их как подключаемые потоковые DSL. Это позволяет очень легко переключать различные варианты поведения без необходимости определять собственную структуру интерпретатора.
Если вы новичок в трубах, то вы можете проверить учебник.