Start implementing DependencyRunner

This commit is contained in:
Niels G. W. Serup 2024-09-27 20:39:27 +02:00
parent b60336cf9f
commit c53f804074
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
3 changed files with 116 additions and 0 deletions

View File

@ -27,10 +27,12 @@ library
DependencyGenerator
Evaluation.Function
Evaluation.FunctionIO
DependencyRunner
SiteGenerator
build-depends:
base
, mtl
, containers
, bytestring
, text
, template-haskell

View File

@ -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

View File

@ -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"