diff --git a/byg/byg.cabal b/byg/byg.cabal index d7da384..7f8fa93 100644 --- a/byg/byg.cabal +++ b/byg/byg.cabal @@ -27,10 +27,12 @@ library DependencyGenerator Evaluation.Function Evaluation.FunctionIO + DependencyRunner SiteGenerator build-depends: base , mtl + , containers , bytestring , text , template-haskell diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs new file mode 100644 index 0000000..6b759f3 --- /dev/null +++ b/byg/src/DependencyRunner.hs @@ -0,0 +1,98 @@ +module DependencyRunner + ( runDeps + ) where + +import Types (Value(..), Valuable(..)) +import Types.Dependency +import Evaluation.Function +import Evaluation.FunctionIO + +import Data.Map (Map) +import qualified Data.Map as M +import Control.Monad.State (MonadState, MonadIO, StateT, runState, put, get, modify, liftIO) + +newtype DepRunM a = DepRunM { unDepRunM :: StateT (Map Int Value) IO a } + deriving (Functor, Applicative, Monad, MonadIO, MonadState (Map Int Value)) + +runDeps :: [Dependency] -> DepRunM () +runDeps = mapM_ runDep + +runDep :: Dependency -> DepRunM () +runDep (Dependency a action b) = do + input <- getTokenValue a + result <- runAction action input + putTokenValue b result + +getTokenValue :: UToken -> DepRunM Value +getTokenValue = \case + UToken i -> do + m <- get + pure (m M.! i) + UTupleToken (a, b) -> do + va <- getTokenValue a + vb <- getTokenValue b + pure $ Tuple (va, vb) + UZipToken (a, b) -> do + va <- getTokenValue a + vb <- getTokenValue b + case (va, vb) of + (List as, List bs) -> + pure $ List $ zipWith (curry Tuple) as bs + _ -> + error "unexpected" + UNoToken -> + pure Empty + +putTokenValue :: UToken -> Value -> DepRunM () +putTokenValue t v = case t of + UToken i -> + modify $ M.insert i v + UNoToken -> + pure () + _ -> + error "unexpected" + +runAction :: Action -> Value -> DepRunM Value +runAction action input = case action of + Function f -> + pure $ evalFunction f input + FunctionIO f -> + liftIO $ evalFunctionIO f input + Inject v -> + pure v + FilterComp -> + case input of + Tuple (List vs, List mask) -> + pure $ List $ map fst $ filter (fromValue . snd) $ zip vs mask + _ -> + error "unexpected" + GetListElem -> + undefined + SetListElem -> + undefined + UntupleFst -> + case input of + Tuple (v, _) -> + pure v + _ -> + error "unexpected" + UntupleSnd -> + case input of + Tuple (_, v) -> + pure v + _ -> + error "unexpected" + UnzipFst -> + case input of + List vs -> + List <$> mapM (runAction UntupleFst) vs + _ -> + error "unexpected" + UnzipSnd -> + case input of + List vs -> + List <$> mapM (runAction UntupleSnd) vs + _ -> + error "unexpected" + MapComp subDeps -> + undefined diff --git a/byg/src/Types/Value.hs b/byg/src/Types/Value.hs index 8b71b43..40efe7a 100644 --- a/byg/src/Types/Value.hs +++ b/byg/src/Types/Value.hs @@ -20,12 +20,28 @@ data Value = String String class Valuable a where toValue :: a -> Value + fromValue :: Value -> a instance Valuable String where toValue = String + fromValue = \case + String a -> a + _ -> error "unexpected" instance Valuable Text where toValue = Text + fromValue = \case + Text a -> a + _ -> error "unexpected" + +instance Valuable Bool where + toValue = Bool + fromValue = \case + Bool a -> a + _ -> error "unexpected" instance Valuable ImageConversionSettings where toValue = ImageConversionSettings + fromValue = \case + ImageConversionSettings a -> a + _ -> error "unexpected"