Get rid of the final traversable cruft

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

View File

@ -16,26 +16,24 @@ data TypedRun a b where
FIO :: IsFIO f a b => f -> TypedRun a b
TInject :: b -> TypedRun () b
GetListElem :: TypedRun () b
InList :: ComputationM TokenNotTraversable b -> TypedRun [a] [b]
InList :: ComputationM b -> TypedRun [a] [b]
instance Show (ComputationM t a) where
instance Show (ComputationM a) where
show _ = "<computation>"
deriving instance (Show a, Show b) => Show (TypedRun a b)
data Token t a where
Token :: Int -> Token t a
NoToken :: Token t ()
data Token a where
Token :: Int -> Token a
NoToken :: Token ()
deriving instance Show (Token t a)
deriving instance Show (Token a)
data TokenNotTraversable
data Dependency ta a tb b = Dependency (Token ta a) (TypedRun a b) (Token tb b)
data Dependency a b = Dependency (Token a) (TypedRun a b) (Token b)
deriving (Show)
data DependencyUntyped where
DependencyUntyped :: Dependency ta a tb b -> String -> DependencyUntyped
DependencyUntyped :: Dependency a b -> String -> DependencyUntyped
instance Show DependencyUntyped where
show (DependencyUntyped _ s) = s
@ -43,11 +41,11 @@ instance Show DependencyUntyped where
newtype ComputationM' a = ComputationM { unComputationM :: WriterT [DependencyUntyped] (State Int) a }
deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [DependencyUntyped])
type ComputationM ta a = ComputationM' (Token ta a)
type ComputationM a = ComputationM' (Token a)
evalComputationM m = evalState (execWriterT (unComputationM m)) 0
genDependency :: (Show u, Show a) => (Token ta a -> Dependency tu u ta a) -> ComputationM ta a
genDependency :: (Show u, Show a) => (Token a -> Dependency u a) -> ComputationM a
genDependency g = do
top <- get
let top' = top + 1
@ -57,19 +55,19 @@ genDependency g = do
tell [DependencyUntyped result (show result)]
pure target
inject :: Show a => a -> ComputationM ta a
inject :: Show a => a -> ComputationM a
inject x = genDependency (Dependency NoToken (TInject x))
getListElem :: Show a => ComputationM ta a
getListElem :: Show a => ComputationM a
getListElem = genDependency (Dependency NoToken GetListElem)
run :: (Show a, Show b, IsF f a b) => f -> Token t a -> ComputationM TokenNotTraversable b
run :: (Show a, Show b, IsF f a b) => f -> Token a -> ComputationM b
run f input = genDependency (Dependency input (F f))
isImageFilename = run IsImageFilename
convertedImageFilename = run ConvertedImageFilename
runIO :: (Show a, Show b, IsFIO f a b) => f -> Token t a -> ComputationM TokenNotTraversable b
runIO :: (Show a, Show b, IsFIO f a b) => f -> Token a -> ComputationM b
runIO f input = genDependency (Dependency input (FIO f))
listDirectory = runIO ListDirectory
@ -78,5 +76,5 @@ convertImage = runIO ConvertImage
saveFile = runIO SaveFile
runPandoc = runIO RunPandoc
mapListTaken :: (Show a, Show b) => ComputationM TokenNotTraversable b -> Token TokenNotTraversable [a] -> ComputationM TokenNotTraversable [b]
mapListTaken :: (Show a, Show b) => ComputationM b -> Token [a] -> ComputationM [b]
mapListTaken f input = genDependency (Dependency input (InList f))

View File

@ -3,12 +3,12 @@ module Main where
import Types
import ComputationM
testSub :: ComputationM TokenNotTraversable Image
testSub :: ComputationM Image
testSub = do
inp <- getListElem
openImage inp
test :: ComputationM TokenNotTraversable ()
test :: ComputationM ()
test = do
dir <- inject "retter"
dirContents <- listDirectory dir