From d96af50943dc7dcc30beab2ce8c87e9095e73aa4 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Sat, 5 Oct 2024 20:21:06 +0200
Subject: [PATCH] Introduce ListToken and start using it for concat instead of
 append

---
 byg/src/DependencyGenerator.hs | 7 +++++--
 byg/src/DependencyRunner.hs    | 3 +++
 byg/src/SiteGenerator.hs       | 4 ++--
 byg/src/Types/Dependency.hs    | 7 +++++++
 byg/src/Types/Token.hs         | 1 +
 5 files changed, 18 insertions(+), 4 deletions(-)

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)