diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs index 39d1ca7..8cd5fb1 100644 --- a/byg/src/DependencyRunner.hs +++ b/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 } - 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 - input <- getTokenValue a - result <- runAction action input - putTokenValue b result - liftIO $ do - putStrLn ("input: " ++ show input) - putStrLn ("action: " ++ show action) - putStrLn ("output: " ++ show result) - putStrLn "----------" +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 $ 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 _ ->