{-# LANGUAGE ScopedTypeVariables #-}
{- |
Runs computations depending on some values coming from a conduit. The computations are defined in applicative fashion.

> test :: IO [Int]
> test = inp =$ cnd $$ CL.consume
>     where
>         inp = sourceDirectory "/etc"
>         cnd :: ConduitT String Int IO ()
>         cnd = withRequirement (map Once comps) id (fmap length . readFile)
>         comps :: [Require String Int Int]
>         comps = [ (+) <$> require "/etc/passwd" <*> require "/etc/passwd"
>                 , (-) <$> require "/etc/resolv.conf" <*> require "/etc/nonexistent"
>                 , require "/etc/hosts"
>                 ]
-}

module Data.Conduit.Require (withRequirement, RunMode(..)) where

import Data.Conduit
import Control.Dependency
import Control.Monad
import Control.Monad.Trans

-- | This allows the user to parameter what happends once a requirement is
-- fulfilled.
data RunMode
   = Reset -- ^ The requirement will be reset, and can be run multiple times
   | Once -- ^ The requirement can only run once, first answer is kept on alts
   | OnceCorrect -- ^ The requirement can only run once, best answer is kept on alts
   deriving Int -> RunMode -> ShowS
[RunMode] -> ShowS
RunMode -> String
(Int -> RunMode -> ShowS)
-> (RunMode -> String) -> ([RunMode] -> ShowS) -> Show RunMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunMode -> ShowS
showsPrec :: Int -> RunMode -> ShowS
$cshow :: RunMode -> String
show :: RunMode -> String
$cshowList :: [RunMode] -> ShowS
showList :: [RunMode] -> ShowS
Show

-- | Given a stream of values, from which an identifier and a content can
-- be extracted, runs a list of computation that depend on these.
--
-- Each computation's output is `yield`ed downstream.
--
-- When all computations have been run, the conduit finishes processing.
withRequirement :: (Ord identifier, Eq identifier, Monad m, Functor m)
                => [(RunMode, Require identifier content x)] -- ^ The list of dependent computations
                -> (a -> identifier)              -- ^ Extracting the identifier
                -> (a -> m content)               -- ^ Extracting the content, possibly with effects
                -> ConduitT a x m ()
withRequirement :: forall identifier (m :: * -> *) content x a.
(Ord identifier, Eq identifier, Monad m, Functor m) =>
[(RunMode, Require identifier content x)]
-> (a -> identifier) -> (a -> m content) -> ConduitT a x m ()
withRequirement [(RunMode, Require identifier content x)]
computations a -> identifier
getIdentifier a -> m content
getContent = (a -> identifier)
-> (a -> m content)
-> [(RunMode, Require identifier content x,
     [(identifier, content)])]
-> ConduitT a x m ()
forall identifier (m :: * -> *) a content x.
(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 a -> identifier
getIdentifier a -> m content
getContent [(RunMode, Require identifier content x, [(identifier, content)])]
forall {a}. [(RunMode, Require identifier content x, [a])]
compmap
    where
        compmap :: [(RunMode, Require identifier content x, [a])]
compmap = [ (RunMode
rm, Require identifier content x
req, []) | (RunMode
rm, Require identifier content x
req) <- [(RunMode, Require identifier content x)]
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 :: forall identifier (m :: * -> *) a content x.
(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 a -> identifier
getIdentifier a -> m content
getContent [(RunMode, Require identifier content x, [(identifier, content)])]
computationList = do
    Maybe a
mi <- ConduitT a x m (Maybe a)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe a
mi of
        Maybe a
Nothing ->
          let lastPass :: (RunMode, Require identifier content o, [(identifier, content)])
-> ConduitT i o m ()
lastPass (RunMode
runmode, Require identifier content o
req, [(identifier, content)]
contents) =
                case RunMode
runmode of
                  RunMode
OnceCorrect ->
                    case [(identifier, content)] -> Require identifier content o -> Maybe o
forall identifier content (f :: * -> *) a.
(Ord identifier, Eq identifier, Monad f, Alternative f) =>
[(identifier, content)] -> Require identifier content a -> f a
computeRequire [(identifier, content)]
contents Require identifier content o
req of
                      Just o
rs -> o -> ConduitT i o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield o
rs
                      Maybe o
Nothing -> () -> ConduitT i o m ()
forall a. a -> ConduitT i o m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  RunMode
_ -> () -> ConduitT i o m ()
forall a. a -> ConduitT i o m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          in  ((RunMode, Require identifier content x, [(identifier, content)])
 -> ConduitT a x m ())
-> [(RunMode, Require identifier content x,
     [(identifier, content)])]
-> ConduitT a x m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RunMode, Require identifier content x, [(identifier, content)])
-> ConduitT a x m ()
forall {identifier} {m :: * -> *} {content} {o} {i}.
(Ord identifier, Monad m) =>
(RunMode, Require identifier content o, [(identifier, content)])
-> ConduitT i o m ()
lastPass [(RunMode, Require identifier content x, [(identifier, content)])]
computationList

        Just a
streamElement -> do
            let ident :: identifier
ident = a -> identifier
getIdentifier a
streamElement
                tryComputeReq :: content
-> (RunMode, Require identifier content a, [(identifier, content)])
-> ([(RunMode, Require identifier content a,
      [(identifier, content)])],
    [a])
tryComputeReq content
nc (RunMode
runmode, Require identifier content a
req, [(identifier, content)]
contents) =
                    let previouscomputation :: [(RunMode, Require identifier content a, [(identifier, content)])]
previouscomputation = [(RunMode
runmode, Require identifier content a
req, [(identifier, content)]
ncontents)]
                        droppedcontent :: [(RunMode, Require identifier content a, [a])]
droppedcontent = [(RunMode
runmode, Require identifier content a
req, [])]
                        ncontents :: [(identifier, content)]
ncontents = (identifier
ident, content
nc) (identifier, content)
-> [(identifier, content)] -> [(identifier, content)]
forall a. a -> [a] -> [a]
: [(identifier, content)]
contents
                    in  case RunMode
runmode of
                          RunMode
Once ->
                            case [(identifier, content)] -> Require identifier content a -> Maybe a
forall identifier content (f :: * -> *) a.
(Ord identifier, Eq identifier, Monad f, Alternative f) =>
[(identifier, content)] -> Require identifier content a -> f a
computeRequire [(identifier, content)]
ncontents Require identifier content a
req of
                              Just a
rs -> ([], [a
rs])
                              Maybe a
Nothing -> ([(RunMode, Require identifier content a, [(identifier, content)])]
previouscomputation, [])
                          RunMode
Reset ->
                            case [(identifier, content)] -> Require identifier content a -> Maybe a
forall identifier content (f :: * -> *) a.
(Ord identifier, Eq identifier, Monad f, Alternative f) =>
[(identifier, content)] -> Require identifier content a -> f a
computeRequire [(identifier, content)]
ncontents Require identifier content a
req of
                              Just a
rs -> ([(RunMode, Require identifier content a, [(identifier, content)])]
forall {a}. [(RunMode, Require identifier content a, [a])]
droppedcontent, [a
rs])
                              Maybe a
Nothing -> ([(RunMode, Require identifier content a, [(identifier, content)])]
previouscomputation, [])
                          RunMode
OnceCorrect ->
                            case [(identifier, content)] -> Require identifier content a -> Maybe a
forall identifier content (f :: * -> *) a.
(Ord identifier, Eq identifier, Monad f, Alternative f) =>
[(identifier, content)] -> Require identifier content a -> f a
computeRequireIntermediate [(identifier, content)]
ncontents Require identifier content a
req of
                              Just a
rs -> ([], [a
rs])
                              Maybe a
Nothing -> ([(RunMode, Require identifier content a, [(identifier, content)])]
previouscomputation, [])
                checkComputation :: ([(RunMode, Require identifier content a,
   [(identifier, content)])],
 [a], Maybe content)
-> (RunMode, Require identifier content a, [(identifier, content)])
-> m ([(RunMode, Require identifier content a,
        [(identifier, content)])],
      [a], Maybe content)
checkComputation ([(RunMode, Require identifier content a, [(identifier, content)])]
curCompList, [a]
curResults, Maybe content
curContent) requirement :: (RunMode, Require identifier content a, [(identifier, content)])
requirement@(RunMode
_,Require identifier content a
req,[(identifier, content)]
_) =
                    if identifier -> Require identifier content a -> Bool
forall identifier content a.
identifier -> Require identifier content a -> Bool
triggersAnalyzer identifier
ident Require identifier content a
req
                        then do
                            content
nc <- case Maybe content
curContent of
                                      Just content
x -> content -> m content
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return content
x
                                      Maybe content
_ -> a -> m content
getContent a
streamElement
                            let ([(RunMode, Require identifier content a, [(identifier, content)])]
resultingCompList, [a]
rcomp) = content
-> (RunMode, Require identifier content a, [(identifier, content)])
-> ([(RunMode, Require identifier content a,
      [(identifier, content)])],
    [a])
forall {content} {a}.
content
-> (RunMode, Require identifier content a, [(identifier, content)])
-> ([(RunMode, Require identifier content a,
      [(identifier, content)])],
    [a])
tryComputeReq content
nc (RunMode, Require identifier content a, [(identifier, content)])
requirement
                            ([(RunMode, Require identifier content a,
   [(identifier, content)])],
 [a], Maybe content)
-> m ([(RunMode, Require identifier content a,
        [(identifier, content)])],
      [a], Maybe content)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(RunMode, Require identifier content a, [(identifier, content)])]
resultingCompList [(RunMode, Require identifier content a, [(identifier, content)])]
-> [(RunMode, Require identifier content a,
     [(identifier, content)])]
-> [(RunMode, Require identifier content a,
     [(identifier, content)])]
forall a. [a] -> [a] -> [a]
++ [(RunMode, Require identifier content a, [(identifier, content)])]
curCompList, [a]
rcomp [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
curResults, content -> Maybe content
forall a. a -> Maybe a
Just content
nc)
                        else ([(RunMode, Require identifier content a,
   [(identifier, content)])],
 [a], Maybe content)
-> m ([(RunMode, Require identifier content a,
        [(identifier, content)])],
      [a], Maybe content)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((RunMode, Require identifier content a, [(identifier, content)])
requirement (RunMode, Require identifier content a, [(identifier, content)])
-> [(RunMode, Require identifier content a,
     [(identifier, content)])]
-> [(RunMode, Require identifier content a,
     [(identifier, content)])]
forall a. a -> [a] -> [a]
: [(RunMode, Require identifier content a, [(identifier, content)])]
curCompList, [a]
curResults, Maybe content
curContent)
            ([(RunMode, Require identifier content x, [(identifier, content)])]
newcomputationList, [x]
results, Maybe content
_) <- m ([(RunMode, Require identifier content x,
     [(identifier, content)])],
   [x], Maybe content)
-> ConduitT
     a
     x
     m
     ([(RunMode, Require identifier content x,
        [(identifier, content)])],
      [x], Maybe content)
forall (m :: * -> *) a. Monad m => m a -> ConduitT a x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((([(RunMode, Require identifier content x,
    [(identifier, content)])],
  [x], Maybe content)
 -> (RunMode, Require identifier content x, [(identifier, content)])
 -> m ([(RunMode, Require identifier content x,
         [(identifier, content)])],
       [x], Maybe content))
-> ([(RunMode, Require identifier content x,
      [(identifier, content)])],
    [x], Maybe content)
-> [(RunMode, Require identifier content x,
     [(identifier, content)])]
-> m ([(RunMode, Require identifier content x,
        [(identifier, content)])],
      [x], Maybe content)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([(RunMode, Require identifier content x,
   [(identifier, content)])],
 [x], Maybe content)
-> (RunMode, Require identifier content x, [(identifier, content)])
-> m ([(RunMode, Require identifier content x,
        [(identifier, content)])],
      [x], Maybe content)
forall {a}.
([(RunMode, Require identifier content a,
   [(identifier, content)])],
 [a], Maybe content)
-> (RunMode, Require identifier content a, [(identifier, content)])
-> m ([(RunMode, Require identifier content a,
        [(identifier, content)])],
      [a], Maybe content)
checkComputation ([], [], Maybe content
forall a. Maybe a
Nothing) [(RunMode, Require identifier content x, [(identifier, content)])]
computationList)
            (x -> ConduitT a x m ()) -> [x] -> ConduitT a x m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ x -> ConduitT a x m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [x]
results
            Bool -> ConduitT a x m () -> ConduitT a x m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(RunMode, Require identifier content x, [(identifier, content)])]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RunMode, Require identifier content x, [(identifier, content)])]
newcomputationList) ((a -> identifier)
-> (a -> m content)
-> [(RunMode, Require identifier content x,
     [(identifier, content)])]
-> ConduitT a x m ()
forall identifier (m :: * -> *) a content x.
(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 a -> identifier
getIdentifier a -> m content
getContent [(RunMode, Require identifier content x, [(identifier, content)])]
newcomputationList)