Introduce ListToken and start using it for concat instead of append

This commit is contained in:
Niels G. W. Serup 2024-10-05 20:21:06 +02:00
parent c06bd28d9a
commit d96af50943
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
5 changed files with 18 additions and 4 deletions

View File

@ -104,6 +104,9 @@ class TokenableTo t s | s -> t where
instance TokenableTo a (Token a) where
toToken = pure
instance TokenableTo [a] [Token a] where
toToken = pure . ListToken
instance TokenableTo a (DepGenM' a) where
toToken = id
@ -164,14 +167,14 @@ unzipFstDepGenM t = do
t' <- toToken t
case t' of
ZipToken a _ -> pure a
Token _ -> genDependency (makeDependency t' UnzipFst)
_ -> genDependency (makeDependency t' UnzipFst)
unzipSndDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [b])
unzipSndDepGenM t = do
t' <- toToken t
case t' of
ZipToken _ b -> pure b
Token _ -> genDependency (makeDependency t' UnzipSnd)
_ -> genDependency (makeDependency t' UnzipSnd)
unzipDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [a], Token [b])
unzipDepGenM t = do

View File

@ -50,6 +50,9 @@ getTokenValue = \case
pure $ List $ zipWith (curry Tuple) as bs
_ ->
error "unexpected"
UListToken ts -> do
vs <- mapM getTokenValue ts
pure $ List vs
UNoToken ->
pure Empty

View File

@ -11,8 +11,8 @@ import Data.Text (Text)
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
thumbnailImageFilename filename = do
(base, ext) <- untupleDepGenM $ fileComponents filename
appendStrings base
$ appendStrings (inject "-thumbnail.") ext
suffix <- inject "-thumbnail."
concatStrings [ base, suffix, ext ]
makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' Text
makeImageHTML t = do

View File

@ -32,6 +32,7 @@ data Action = Function Function
data UToken = UToken Int
| UTupleToken UToken UToken
| UZipToken UToken UToken
| UListToken [UToken]
| UNoToken
deriving (Show, Lift)
@ -46,6 +47,7 @@ makeUToken = \case
Token i -> UToken i
TupleToken a b -> UTupleToken (makeUToken a) (makeUToken b)
ZipToken a b -> UZipToken (makeUToken a) (makeUToken b)
ListToken ts -> UListToken (map makeUToken ts)
NoToken -> UNoToken
formatDependencyTrees :: [Dependency] -> Text
@ -78,6 +80,11 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "")
, formatUToken b
, [ ")" ]
]
UListToken ts ->
[ "["
, T.intercalate ", " (map (T.concat . formatUToken) ts)
, "]"
]
UNoToken ->
[ "--" ]

View File

@ -9,6 +9,7 @@ data Token a where
Token :: Int -> Token a
TupleToken :: Token a -> Token b -> Token (a, b)
ZipToken :: Token [a] -> Token [b] -> Token [(a, b)]
ListToken :: [Token a] -> Token [a]
NoToken :: Token ()
deriving instance Show (Token a)