{-# LANGUAGE Arrows, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, ExistentialQuantification, Rank2Types #-}moduleRSAGL.FRP.FactoryArrow(FactoryArrow(..))whereimportPreludehiding((.),id)importControl.ArrowimportControl.MonadimportControl.Monad.FiximportControl.Category-- | An 'Arrow' that constructs an associated monadic computation.newtypeFactoryArrowmnio=FactoryArrow{runFactory::m(Kleislinio)}instance(Monadm,Monadn)=>Category(FactoryArrowmn)where(FactoryArrowa).(FactoryArrowb)=FactoryArrow$dob'<-ba'<-areturn$a'.b'id=FactoryArrow$returnidinstance(Monadm,Monadn)=>Arrow(FactoryArrowmn)wherearr=FactoryArrow.return.arrfirst=FactoryArrow.liftMfirst.runFactorysecond=FactoryArrow.liftMsecond.runFactoryinstance(Monadm,MonadFixn)=>ArrowLoop(FactoryArrowmn)whereloop=FactoryArrow.liftMloop.runFactory-- | Careful! To implement ArrowApply, the factory action must run imbedded in the constructed action.instance(Monadm)=>ArrowApply(FactoryArrowmm)whereapp=factoryAppid-- | Implements ArrowApply for any FactoryArrow capable of it,-- but this requires a way to lift operations in m into n.factoryApp::(Monadm,Monadn)=>(foralla.ma->na)->FactoryArrowmn(FactoryArrowmnio,i)ofactoryAppliftM2N=FactoryArrow$return$Kleisli$\(FactoryArrowm,i)->do(Kleislin)<-liftM2Nmni-- | A choice is constructed at factory time whether or not the constructed action is ever evaluated.instance(Monadm,Monadn)=>ArrowChoice(FactoryArrowmn)whereleft=FactoryArrow.liftMleft.runFactoryright=FactoryArrow.liftMright.runFactoryinstance(Monadm,MonadPlusn)=>ArrowZero(FactoryArrowmn)wherezeroArrow=FactoryArrow$returnzeroArrow-- | As with ArrowChoice, both branches are constructed at factory time whether or not the constructed actions are ever evaluated.instance(Monadm,MonadPlusn)=>ArrowPlus(FactoryArrowmn)wherea<+>b=FactoryArrow$liftM2(<+>)(runFactorya)(runFactoryb)