{-# LANGUAGE CPP #-}{-# LANGUAGE RankNTypes #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE UndecidableInstances #-}#ifndef MIN_VERSION_mtl
#define MIN_VERSION_mtl(x,y,z) 0
#endif
------------------------------------------------------------------------------- |-- Module : Data.Machine.Plan-- Copyright : (C) 2012 Edward Kmett, Rúnar Bjarnason-- License : BSD-style (see the file LICENSE)---- Maintainer : Edward Kmett <ekmett@gmail.com>-- Stability : provisional-- Portability : Rank-N Types, MPTCs------------------------------------------------------------------------------moduleData.Machine.Plan(-- * PlansPlan ,runPlan ,PlanT (..),yield ,maybeYield ,await ,stop ,awaits ,exhaust )whereimportControl.ApplicativeimportControl.CategoryimportControl.Monad(MonadPlus(..))importControl.Monad.Trans.ClassimportControl.Monad.IO.ClassimportControl.Monad.State.ClassimportControl.Monad.Reader.ClassimportControl.Monad.Error.ClassimportqualifiedControl.Monad.FailasFailimportControl.Monad.Writer.ClassimportData.Functor.IdentityimportPreludehiding((.),id)--------------------------------------------------------------------------------- Plans--------------------------------------------------------------------------------- | You can 'construct' a 'Plan' (or 'PlanT'), turning it into a-- 'Data.Machine.Type.Machine' (or 'Data.Machine.Type.MachineT').--newtypePlanT k o m a =PlanT {runPlanT ::forallr .(a ->m r )->-- Done a(o ->m r ->m r )->-- Yield o (Plan k o a)(forallz .(z ->m r )->k z ->m r ->m r )->-- forall z. Await (z -> Plan k o a) (k z) (Plan k o a)m r ->-- Failm r }-- | A @'Plan' k o a@ is a specification for a pure 'Machine', that reads inputs selected by @k@-- with types based on @i@, writes values of type @o@, and has intermediate results of type @a@.---- A @'Plan' k o a@ can be used as a @'PlanT' k o m a@ for any @'Monad' m@.---- It is perhaps easier to think of 'Plan' in its un-cps'ed form, which would-- look like:---- @-- data 'Plan' k o a-- = Done a-- | Yield o (Plan k o a)-- | forall z. Await (z -> Plan k o a) (k z) (Plan k o a)-- | Fail-- @typePlan k o a =forallm .PlanT k o m a -- | Deconstruct a 'Plan' without reference to a 'Monad'.runPlan::PlanT k o Identitya ->(a ->r )->(o ->r ->r )->(forallz .(z ->r )->k z ->r ->r )->r ->r runPlan m kp ke kr kf =runIdentity$runPlanTm (Identity.kp )(\o (Identityr )->Identity(ke o r ))(\f k (Identityr )->Identity(kr (runIdentity.f )k r ))(Identitykf ){-# INLINErunPlan#-}instanceFunctor(PlanT k o m )wherefmap f (PlanT m )=PlanT $\k ->m (k .f ){-# INLINEfmap#-}instanceApplicative(PlanT k o m )wherepure a =PlanT (\kp ___->kp a ){-# INLINEpure#-}m <*> n =PlanT $\kp ke kr kf ->runPlanTm (\f ->runPlanTn (\a ->kp (f a ))ke kr kf )ke kr kf {-# INLINE(<*>)#-}m *> n =PlanT $\kp ke kr kf ->runPlanTm (\_->runPlanTn kp ke kr kf )ke kr kf {-# INLINE(*>)#-}m <* n =PlanT $\kp ke kr kf ->runPlanTm (\a ->runPlanTn (\_->kp a )ke kr kf )ke kr kf {-# INLINE(<*)#-}instanceAlternative(PlanT k o m )whereempty =PlanT $\___kf ->kf {-# INLINEempty#-}PlanT m <|> PlanT n =PlanT $\kp ke kr kf ->m kp ke kr (n kp ke kr kf ){-# INLINE(<|>)#-}instanceMonad(PlanT k o m )wherereturn =pure{-# INLINEreturn#-}PlanT m >>= f =PlanT (\kp ke kr kf ->m (\a ->runPlanT(f a )kp ke kr kf )ke kr kf ){-# INLINE(>>=)#-}(>> )=(*>){-# INLINE(>>)#-}#if !(MIN_VERSION_base(4,13,0))
fail =Fail.fail#endif
instanceFail.MonadFail(PlanT k o m )wherefail _=PlanT (\___kf ->kf )instanceMonadPlus(PlanT k o m )wheremzero =empty{-# INLINEmzero#-}mplus =(<|>){-# INLINEmplus#-}instanceMonadTrans(PlanT k o )wherelift m =PlanT (\kp ___->m >>=kp ){-# INLINElift#-}instanceMonadIOm =>MonadIO(PlanT k o m )whereliftIO m =PlanT (\kp ___->liftIOm >>=kp ){-# INLINEliftIO#-}instanceMonadStates m =>MonadStates (PlanT k o m )whereget =liftget{-# INLINEget#-}put =lift.put{-# INLINEput#-}#if MIN_VERSION_mtl(2,1,0)
state f =PlanT $\kp ___->statef >>=kp {-# INLINEstate#-}#endif
instanceMonadReadere m =>MonadReadere (PlanT k o m )whereask =liftask#if MIN_VERSION_mtl(2,1,0)
reader =lift.reader#endif
local f m =PlanT $\kp ke kr kf ->localf (runPlanTm kp ke kr kf )instanceMonadWriterw m =>MonadWriterw (PlanT k o m )where#if MIN_VERSION_mtl(2,1,0)
writer =lift.writer#endif
tell =lift.telllisten m =PlanT $\kp ke kr kf ->runPlanTm ((kp =<<).listen.return)ke kr kf pass m =PlanT $\kp ke kr kf ->runPlanTm ((kp =<<).pass.return)ke kr kf instanceMonadErrore m =>MonadErrore (PlanT k o m )wherethrowError =lift.throwErrorcatchError m k =PlanT $\kp ke kr kf ->runPlanTm kp ke kr kf `catchError`\e ->runPlanT(k e )kp ke kr kf -- | Output a result.yield::o ->Plan k o ()yield o =PlanT (\kp ke __->ke o (kp ()))-- | Like yield, except stops if there is no value to yield.maybeYield::Maybeo ->Plan k o ()maybeYield =maybestop yield -- | Wait for input.---- @'await' = 'awaits' 'id'@await::Categoryk =>Plan (k i )o i await =PlanT (\kp _kr kf ->kr kp idkf )-- | Wait for a particular input.---- @-- awaits 'L' :: 'Plan' ('T' a b) o a-- awaits 'R' :: 'Plan' ('T' a b) o b-- awaits 'id' :: 'Plan' ('Data.Machine.Is.Is' i) o i-- @awaits::k i ->Plan k o i awaits h =PlanT $\kp _kr ->kr kp h -- | @'stop' = 'empty'@stop::Plan k o a stop =empty-- | Run a monadic action repeatedly yielding its results, until it returns Nothing.exhaust::Monadm =>m (Maybea )->PlanT k a m ()exhaust f =do(liftf >>=maybeYield );exhaust f