Get rid of the final traversable cruft
This commit is contained in:
parent
9410a39527
commit
af2b9202ef
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue