{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Data.Conduit.Require (withRequirement, RunMode(..)) where
import Data.Conduit
import Control.Dependency
import Control.Monad
import Control.Monad.Trans
data RunMode = Reset
| Once
deriving Show
withRequirement :: (Ord identifier, Eq identifier, Monad m, Functor m)
=> [(RunMode, Require identifier content x)]
-> (a -> identifier)
-> (a -> m content)
-> ConduitT a x m ()
withRequirement computations getIdentifier getContent = run getIdentifier getContent compmap
where
compmap = [ (rm, req, []) | (rm, req) <- computations ]
run :: (Ord identifier, Eq identifier, Monad m, Functor m)
=> (a -> identifier)
-> (a -> m content)
-> [(RunMode, Require identifier content x, [(identifier, content)])]
-> ConduitT a x m ()
run getIdentifier getContent computationList = do
mi <- await
case mi of
Nothing -> return ()
Just streamElement -> do
let ident = getIdentifier streamElement
tryComputeReq nc (runmode, req, contents) =
let previouscomputation = [(runmode, req, ncontents)]
droppedcontent = [(runmode, req, [])]
ncontents = (ident, nc) : contents
in case (computeRequire ncontents req, runmode) of
(Just rs, Once) -> ([], [rs])
(Just rs, Reset) -> (droppedcontent, [rs])
(Nothing, _) -> (previouscomputation, [])
checkComputation (curCompList, curResults, curContent) requirement@(_,req,_) =
if triggersAnalyzer ident req
then do
nc <- case curContent of
Just x -> return x
_ -> getContent streamElement
let (resultingCompList, rcomp) = tryComputeReq nc requirement
return (resultingCompList ++ curCompList, rcomp ++ curResults, Just nc)
else return (requirement : curCompList, curResults, curContent)
(newcomputationList, results, _) <- lift (foldM checkComputation ([], [], Nothing) computationList)
mapM_ yield results
unless (null newcomputationList) (run getIdentifier getContent newcomputationList)