Pull instead of push

byg/src/DependencyRunner.hs

@@ -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 }
+data ValueExistence = Evaluated Value
-  deriving (Functor, Applicative, Monad, MonadIO, MonadState (Map Int 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) =
-  input <- getTokenValue a
+  if actionTouchesFilesystem action
-  result <- runAction action input
+  then void m
-  putTokenValue b result
+  else putTokenValue b $ NotEvaluated m
-  liftIO $ do
+  where m :: DepRunM Value
-    putStrLn ("input: " ++ show input)
+        m = do
-    putStrLn ("action: " ++ show action)
+          input <- getTokenValue a
-    putStrLn ("output: " ++ show result)
+          result <- runAction action input
-    putStrLn "----------"
+          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 :: UToken -> ValueExistence -> DepRunM ()
-putTokenValue t v = case t of
+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
       _ ->