Pull instead of push
This commit is contained in:
parent
ed37ba9a09
commit
a6ef299691
|
@ -11,10 +11,14 @@ import Evaluation.FunctionIO
|
|||
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.State (MonadState, MonadIO, StateT, evalStateT, get, modify, liftIO)
|
||||
|
||||
newtype DepRunM a = DepRunM { unDepRunM :: StateT (Map Int Value) IO a }
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadState (Map Int Value))
|
||||
data ValueExistence = Evaluated Value
|
||||
| NotEvaluated (DepRunM Value)
|
||||
|
||||
newtype DepRunM a = DepRunM { unDepRunM :: StateT (Map Int ValueExistence) IO a }
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadState (Map Int ValueExistence))
|
||||
|
||||
runDeps :: [Dependency] -> DepRunM ()
|
||||
runDeps = mapM_ runDep
|
||||
|
@ -22,22 +26,33 @@ runDeps = mapM_ runDep
|
|||
runDepRunMIO :: DepRunM a -> IO a
|
||||
runDepRunMIO m = evalStateT (unDepRunM m) M.empty
|
||||
|
||||
evaluate :: ValueExistence -> DepRunM Value
|
||||
evaluate = \case
|
||||
Evaluated v -> pure v
|
||||
NotEvaluated m -> m
|
||||
|
||||
runDep :: Dependency -> DepRunM ()
|
||||
runDep (Dependency a action b) = do
|
||||
runDep (Dependency a action b) =
|
||||
if actionTouchesFilesystem action
|
||||
then void m
|
||||
else putTokenValue b $ NotEvaluated m
|
||||
where m :: DepRunM Value
|
||||
m = do
|
||||
input <- getTokenValue a
|
||||
result <- runAction action input
|
||||
putTokenValue b result
|
||||
putTokenValue b $ Evaluated result
|
||||
liftIO $ do
|
||||
putStrLn ("input: " ++ show input)
|
||||
putStrLn ("action: " ++ show action)
|
||||
putStrLn ("output: " ++ show result)
|
||||
putStrLn "----------"
|
||||
pure result
|
||||
|
||||
getTokenValue :: UToken -> DepRunM Value
|
||||
getTokenValue = \case
|
||||
UToken i -> do
|
||||
m <- get
|
||||
pure (m M.! i)
|
||||
evaluate (m M.! i)
|
||||
UTupleToken a b -> do
|
||||
va <- getTokenValue a
|
||||
vb <- getTokenValue b
|
||||
|
@ -56,10 +71,10 @@ getTokenValue = \case
|
|||
UNoToken ->
|
||||
pure Empty
|
||||
|
||||
putTokenValue :: UToken -> Value -> DepRunM ()
|
||||
putTokenValue t v = case t of
|
||||
putTokenValue :: UToken -> ValueExistence -> DepRunM ()
|
||||
putTokenValue t e = case t of
|
||||
UToken i ->
|
||||
modify $ M.insert i v
|
||||
modify $ M.insert i e
|
||||
UNoToken ->
|
||||
pure ()
|
||||
_ ->
|
||||
|
@ -107,7 +122,7 @@ runAction action input = case action of
|
|||
case input of
|
||||
List vs ->
|
||||
(List <$>) $ flip mapM vs $ \v -> do
|
||||
putTokenValue innerInput v
|
||||
putTokenValue innerInput $ Evaluated v
|
||||
runDeps subDeps
|
||||
getTokenValue innerOutput
|
||||
_ ->
|
||||
|
|
Loading…
Reference in New Issue