diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index 5522f8e..369c42a 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -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 diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs index ffc0b4c..39d1ca7 100644 --- a/byg/src/DependencyRunner.hs +++ b/byg/src/DependencyRunner.hs @@ -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 diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index 002ae12..2966cbc 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -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 diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs index c70caf1..da4fbc3 100644 --- a/byg/src/Types/Dependency.hs +++ b/byg/src/Types/Dependency.hs @@ -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 -> [ "--" ] diff --git a/byg/src/Types/Token.hs b/byg/src/Types/Token.hs index f84f2bf..cfd5476 100644 --- a/byg/src/Types/Token.hs +++ b/byg/src/Types/Token.hs @@ -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)