{-# LANGUAGE CPP #-}{-# LANGUAGE GADTs, ScopedTypeVariables #-}moduleDevelopment.Shake.Internal.Core.Monad(RAW ,Capture ,runRAW ,getRO ,getRW ,putRW ,modifyRW ,catchRAW ,tryRAW ,throwRAW ,finallyRAW ,captureRAW ,)whereimportControl.Exception.ExtraimportControl.Monad.IO.ClassimportData.IORef.ExtraimportControl.ApplicativeimportControl.MonadimportData.SemigroupimportPrelude#if __GLASGOW_HASKELL__ >= 800
importControl.Monad.Fail#endif
dataRAW ro rw a whereFmap ::(a ->b )->RAW ro rw a ->RAW ro rw b Pure ::a ->RAW ro rw a Ap ::RAW ro rw (a ->b )->RAW ro rw a ->RAW ro rw b Next ::RAW ro rw a ->RAW ro rw b ->RAW ro rw b Bind ::RAW ro rw a ->(a ->RAW ro rw b )->RAW ro rw b LiftIO ::IOa ->RAW ro rw a GetRO ::RAW ro rw ro GetRW ::RAW ro rw rw PutRW ::!rw ->RAW ro rw ()ModifyRW ::(rw ->rw )->RAW ro rw ()CaptureRAW ::Capture (EitherSomeExceptiona )->RAW ro rw a CatchRAW ::RAW ro rw a ->(SomeException->RAW ro rw a )->RAW ro rw a instanceFunctor(RAW ro rw )wherefmap =Fmap instanceApplicative(RAW ro rw )wherepure =Pure (*> )=Next (<*> )=Ap instanceMonad(RAW ro rw )wherereturn =pure(>> )=(*>)(>>= )=Bind instanceMonadIO(RAW ro rw )whereliftIO =LiftIO #if __GLASGOW_HASKELL__ >= 800
instanceMonadFail(RAW ro rw )wherefail =liftIO.Control.Monad.Fail.fail#endif
instanceSemigroupa =>Semigroup(RAW ro rw a )where(<> )a b =(<>)<$>a <*>b instance(Semigroupa ,Monoida )=>Monoid(RAW ro rw a )wheremempty =purememptymappend =(<>)typeCapture a =(a ->IO())->IO()-- | Run and then call a continuation.runRAW::ro ->rw ->RAW ro rw a ->Capture (EitherSomeExceptiona )runRAW ro rw m k =dorw <-newIORefrw handler <-newIORefundefinedwriteIORefhandler $\e ->do-- make sure we never call the error continuation twicewriteIORefhandler throwIOk $Lefte goRAW handler ro rw m (k .Right)`catch_`\e ->($e )=<<readIORefhandler goRAW::forallro rw a .IORef(SomeException->IO())->ro ->IORefrw ->RAW ro rw a ->Capture a goRAW handler ro rw =go wherego::RAW ro rw b ->Capture b go x k =casex ofFmap f a ->go a $\v ->k $f v Pure a ->k a Ap f x ->go f $\f ->go x $\v ->k $f v Bind a b ->go a $\a ->go (b a )k Next a b ->go a $\_->go b k LiftIO x ->k =<<x GetRO ->k ro GetRW ->k =<<readIORefrw PutRW x ->writeIORefrw x >>k ()ModifyRW f ->modifyIORef'rw f >>k ()CatchRAW m hdl ->doold <-readIORefhandler writeIORefhandler $\e ->dowriteIORefhandler old go (hdl e )k `catch_`\e ->($e )=<<readIORefhandler go m $\x ->writeIORefhandler old >>k x CaptureRAW f ->doold <-readIORefhandler writeIORefhandler throwIOf $\x ->casex ofLefte ->old e Rightv ->dowriteIORefhandler old k v `catch_`\e ->($e )=<<readIORefhandler ----------------------------------------------------------------------- STANDARDgetRO::RAW ro rw ro getRO =GetRO getRW::RAW ro rw rw getRW =GetRW -- | Strict versionputRW::rw ->RAW ro rw ()putRW =PutRW modifyRW::(rw ->rw )->RAW ro rw ()modifyRW =ModifyRW ----------------------------------------------------------------------- EXCEPTIONScatchRAW::RAW ro rw a ->(SomeException->RAW ro rw a )->RAW ro rw a catchRAW =CatchRAW tryRAW::RAW ro rw a ->RAW ro rw (EitherSomeExceptiona )tryRAW m =catchRAW (fmapRightm )(return.Left)throwRAW::Exceptione =>e ->RAW ro rw a -- Note that while we could directly pass this to the handler-- that would avoid triggering the catch, which would mean they built up on the stackthrowRAW =liftIO.throwIOfinallyRAW::RAW ro rw a ->RAW ro rw b ->RAW ro rw a finallyRAW a undo =dor <-catchRAW a (\e ->undo >>throwRAW e )undo returnr ----------------------------------------------------------------------- CONTINUATIONS-- | Capture a continuation. The continuation should be called at most once.-- Calling the same continuation, multiple times, in parallel, results in incorrect behaviour.captureRAW::Capture (EitherSomeExceptiona )->RAW ro rw a captureRAW =CaptureRAW