Use InList properly

This commit is contained in:
Niels G. W. Serup 2024-09-21 19:09:43 +02:00
parent af2b9202ef
commit d0c2b47df0
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 14 additions and 10 deletions

View File

@ -1,4 +1,3 @@
{-# LANGUAGE GADTs #-}
module ComputationM where module ComputationM where
import Types import Types
@ -16,7 +15,8 @@ data TypedRun a b where
FIO :: IsFIO f a b => f -> TypedRun a b FIO :: IsFIO f a b => f -> TypedRun a b
TInject :: b -> TypedRun () b TInject :: b -> TypedRun () b
GetListElem :: TypedRun () b GetListElem :: TypedRun () b
InList :: ComputationM b -> TypedRun [a] [b] SetListElem :: TypedRun a ()
InList :: [DependencyUntyped] -> TypedRun [a] [b]
instance Show (ComputationM a) where instance Show (ComputationM a) where
show _ = "<computation>" show _ = "<computation>"
@ -43,6 +43,7 @@ newtype ComputationM' a = ComputationM { unComputationM :: WriterT [DependencyUn
type ComputationM a = ComputationM' (Token a) type ComputationM a = ComputationM' (Token a)
evalComputationM :: ComputationM () -> [DependencyUntyped]
evalComputationM m = evalState (execWriterT (unComputationM m)) 0 evalComputationM m = evalState (execWriterT (unComputationM m)) 0
genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a
@ -61,6 +62,9 @@ inject x = genDependency (Dependency NoToken (TInject x))
getListElem :: Show a => ComputationM a getListElem :: Show a => ComputationM a
getListElem = genDependency (Dependency NoToken GetListElem) getListElem = genDependency (Dependency NoToken GetListElem)
setListElem :: Show a => Token a -> ComputationM ()
setListElem a = genDependency (Dependency a SetListElem)
run :: (Show a, Show b, IsF f a b) => f -> Token a -> ComputationM b run :: (Show a, Show b, IsF f a b) => f -> Token a -> ComputationM b
run f input = genDependency (Dependency input (F f)) run f input = genDependency (Dependency input (F f))
@ -76,5 +80,10 @@ convertImage = runIO ConvertImage
saveFile = runIO SaveFile saveFile = runIO SaveFile
runPandoc = runIO RunPandoc runPandoc = runIO RunPandoc
mapListTaken :: (Show a, Show b) => ComputationM b -> Token [a] -> ComputationM [b] mapListTaken :: (Show a, Show b) => (Token a -> ComputationM b) -> Token [a] -> ComputationM [b]
mapListTaken f input = genDependency (Dependency input (InList f)) mapListTaken f input = genDependency (Dependency input (InList (evalComputationM m)))
where m :: ComputationM ()
m = do
inp <- getListElem
outp <- f inp
setListElem outp

View File

@ -3,16 +3,11 @@ module Main where
import Types import Types
import ComputationM import ComputationM
testSub :: ComputationM Image
testSub = do
inp <- getListElem
openImage inp
test :: ComputationM () test :: ComputationM ()
test = do test = do
dir <- inject "retter" dir <- inject "retter"
dirContents <- listDirectory dir dirContents <- listDirectory dir
u <- mapListTaken testSub dirContents u <- mapListTaken openImage dirContents
pure $ NoToken pure $ NoToken
main :: IO () main :: IO ()