Use InList properly
This commit is contained in:
parent
af2b9202ef
commit
d0c2b47df0
|
@ -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
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
Loading…
Reference in New Issue