Refactor TupleToken building

This commit is contained in:
Niels G. W. Serup 2024-10-05 19:56:53 +02:00
parent 938cc99db0
commit 7504c083a1
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
1 changed files with 23 additions and 48 deletions

View File

@ -98,6 +98,18 @@ runFunctionIO f input = genDependency (makeDependency input (FunctionIO f))
runFunctionIO' :: FunctionIO -> Token a -> DepGenM () runFunctionIO' :: FunctionIO -> Token a -> DepGenM ()
runFunctionIO' f input = tellDep $ makeDependency input (FunctionIO f) NoToken runFunctionIO' f input = tellDep $ makeDependency input (FunctionIO f) NoToken
class TokenableTo t s | s -> t where
toToken :: s -> DepGenM' t
instance TokenableTo a (Token a) where
toToken = pure
instance TokenableTo a (DepGenM' a) where
toToken = id
toTupleToken :: (TokenableTo ta a, TokenableTo tb b) => a -> b -> DepGenM' (ta, tb)
toTupleToken a b = TupleToken <$> toToken a <*> toToken b
mapDepGenM :: TokenableTo [a] v => (Token a -> DepGenM' b) -> v -> DepGenM' [b] mapDepGenM :: TokenableTo [a] v => (Token a -> DepGenM' b) -> v -> DepGenM' [b]
mapDepGenM f input = do mapDepGenM f input = do
input' <- toToken input input' <- toToken input
@ -117,9 +129,8 @@ mapDepGenM_ f input = do
filterDepGenM :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM' [a] filterDepGenM :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM' [a]
filterDepGenM mask input = do filterDepGenM mask input = do
mask' <- toToken mask tup <- toTupleToken mask input
input' <- toToken input genDependency (makeDependency tup FilterComp)
genDependency (makeDependency (TupleToken input' mask') FilterComp)
zipDepGenM :: (TokenableTo [a] v, TokenableTo [b] u) => v -> u -> DepGenM' [(a, b)] zipDepGenM :: (TokenableTo [a] v, TokenableTo [b] u) => v -> u -> DepGenM' [(a, b)]
zipDepGenM a b = do zipDepGenM a b = do
@ -169,38 +180,20 @@ unzipDepGenM t = do
b <- unzipSndDepGenM t' b <- unzipSndDepGenM t'
pure (a, b) pure (a, b)
class TokenableTo t s | s -> t where
toToken :: s -> DepGenM' t
instance TokenableTo a (Token a) where
toToken = pure
instance TokenableTo a (DepGenM' a) where
toToken = id
appendStrings :: (TokenableTo String a, TokenableTo String b) => a -> b -> DepGenM' String appendStrings :: (TokenableTo String a, TokenableTo String b) => a -> b -> DepGenM' String
appendStrings a b = do appendStrings a b = runFunction AppendStrings =<< TupleToken <$> toToken a <*> toToken b
a' <- toToken a
b' <- toToken b
runFunction AppendStrings $ TupleToken a' b'
concatStrings :: TokenableTo [String] a => a -> DepGenM' String concatStrings :: TokenableTo [String] a => a -> DepGenM' String
concatStrings a = runFunction ConcatStrings =<< toToken a concatStrings a = runFunction ConcatStrings =<< toToken a
appendTexts :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Text appendTexts :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Text
appendTexts a b = do appendTexts a b = runFunction AppendTexts =<< toTupleToken a b
a' <- toToken a
b' <- toToken b
runFunction AppendTexts $ TupleToken a' b'
concatTexts :: TokenableTo [Text] a => a -> DepGenM' Text concatTexts :: TokenableTo [Text] a => a -> DepGenM' Text
concatTexts a = runFunction ConcatTexts =<< toToken a concatTexts a = runFunction ConcatTexts =<< toToken a
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM' FilePath joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM' FilePath
joinPaths a b = do joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b
a' <- toToken a
b' <- toToken b
runFunction JoinPaths $ TupleToken a' b'
fileComponents :: TokenableTo FilePath a => a -> DepGenM' (String, String) fileComponents :: TokenableTo FilePath a => a -> DepGenM' (String, String)
fileComponents a = runFunction FileComponents =<< toToken a fileComponents a = runFunction FileComponents =<< toToken a
@ -209,22 +202,13 @@ lowerString :: TokenableTo String a => a -> DepGenM' String
lowerString a = runFunction LowerString =<< toToken a lowerString a = runFunction LowerString =<< toToken a
elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM' Bool elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM' Bool
elemOf a b = do elemOf a b = runFunction ElemOf =<< toTupleToken a b
a' <- toToken a
b' <- toToken b
runFunction ElemOf $ TupleToken a' b'
makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Template makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Template
makeTemplate a b = do makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b
a' <- toToken a
b' <- toToken b
runFunction MakeTemplate $ TupleToken a' b'
applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM' Text applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM' Text
applyTemplate a b = do applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b
a' <- toToken a
b' <- toToken b
runFunction ApplyTemplate $ TupleToken a' b'
toText :: TokenableTo String a => a -> DepGenM' Text toText :: TokenableTo String a => a -> DepGenM' Text
toText a = runFunction ToText =<< toToken a toText a = runFunction ToText =<< toToken a
@ -239,22 +223,13 @@ readTextFile :: TokenableTo FilePath a => a -> DepGenM' Text
readTextFile a = runFunctionIO ReadTextFile =<< toToken a readTextFile a = runFunctionIO ReadTextFile =<< toToken a
convertImage :: (TokenableTo (FilePath, FilePath) a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM () convertImage :: (TokenableTo (FilePath, FilePath) a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM ()
convertImage a b = do convertImage a b = runFunctionIO' ConvertImage =<< toTupleToken a b
a' <- toToken a
b' <- toToken b
runFunctionIO' ConvertImage $ TupleToken a' b'
saveFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM () saveFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
saveFile a b = do saveFile a b = runFunctionIO' SaveFile =<< toTupleToken a b
a' <- toToken a
b' <- toToken b
runFunctionIO' SaveFile $ TupleToken a' b'
copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM () copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
copyFile a b = do copyFile a b = runFunctionIO' CopyFile =<< toTupleToken a b
a' <- toToken a
b' <- toToken b
runFunctionIO' CopyFile $ TupleToken a' b'
copyFile' :: Token (FilePath, FilePath) -> DepGenM () copyFile' :: Token (FilePath, FilePath) -> DepGenM ()
copyFile' = runFunctionIO' CopyFile copyFile' = runFunctionIO' CopyFile