Start implementing DependencyRunner
This commit is contained in:
parent
b60336cf9f
commit
c53f804074
|
@ -27,10 +27,12 @@ library
|
||||||
DependencyGenerator
|
DependencyGenerator
|
||||||
Evaluation.Function
|
Evaluation.Function
|
||||||
Evaluation.FunctionIO
|
Evaluation.FunctionIO
|
||||||
|
DependencyRunner
|
||||||
SiteGenerator
|
SiteGenerator
|
||||||
build-depends:
|
build-depends:
|
||||||
base
|
base
|
||||||
, mtl
|
, mtl
|
||||||
|
, containers
|
||||||
, bytestring
|
, bytestring
|
||||||
, text
|
, text
|
||||||
, template-haskell
|
, template-haskell
|
||||||
|
|
|
@ -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
|
|
@ -20,12 +20,28 @@ data Value = String String
|
||||||
|
|
||||||
class Valuable a where
|
class Valuable a where
|
||||||
toValue :: a -> Value
|
toValue :: a -> Value
|
||||||
|
fromValue :: Value -> a
|
||||||
|
|
||||||
instance Valuable String where
|
instance Valuable String where
|
||||||
toValue = String
|
toValue = String
|
||||||
|
fromValue = \case
|
||||||
|
String a -> a
|
||||||
|
_ -> error "unexpected"
|
||||||
|
|
||||||
instance Valuable Text where
|
instance Valuable Text where
|
||||||
toValue = Text
|
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
|
instance Valuable ImageConversionSettings where
|
||||||
toValue = ImageConversionSettings
|
toValue = ImageConversionSettings
|
||||||
|
fromValue = \case
|
||||||
|
ImageConversionSettings a -> a
|
||||||
|
_ -> error "unexpected"
|
||||||
|
|
Loading…
Reference in New Issue