Introduce ListToken and start using it for concat instead of append
This commit is contained in:
parent
c06bd28d9a
commit
d96af50943
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ->
|
||||
[ "--" ]
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue