a lot of stuff sorry

make-pages/BuilderQQ.hs

@@ -4,6 +4,7 @@ module BuilderQQ (b) where
 import Data.Char (isLower, isSpace, isDigit, isAlphaNum)
 import Language.Haskell.TH
 import Language.Haskell.TH.Quote
+import Data.Maybe (mapMaybe)
 import Data.Text.Lazy.Builder
   (Builder, fromText, fromString, singleton, toLazyText)
 import Text.Read (readMaybe)
@@ -18,6 +19,7 @@ data VarType =
     Plain
   | FromText
   | FromString
+  | FromChar
   | Show
   | Reindent !Int
   | ReindentList !Int
@@ -72,6 +74,11 @@ chunks = reverse . go "" [] . trimEnd where
       go "" ((Var FromString, var) : lit acc : cs) rest2
     where (var, rest2) = splitVar rest
 
+  -- $'var: expands to (singleton $var)
+  go acc cs ('$' :. '\'' :. rest) =
+      go "" ((Var FromChar, var) : lit acc : cs) rest2
+    where (var, rest2) = splitVar rest
+
   -- $^var: expands to (fromString (show $var))
   go acc cs ('$' :. '^' :. rest) =
       go "" ((Var Show, var) : lit acc : cs) rest2
@@ -98,8 +105,8 @@ chunks = reverse . go "" [] . trimEnd where
   go acc cs (c :. rest) = go (acc <> singleton c) cs rest
 
   splitVar s
-    | (var, s') <- Text.span isIdChar s,
-      isLower (Text.head var)
+    | (var@(v :. _), s') <- Text.span isIdChar s,
+      isLower v
     = (var, s')
   splitVar _ = error "invalid variable name"
 
@@ -121,13 +128,15 @@ toStrictText = toStrict . toLazyText
 
 
 chunksToExpQ :: [Chunk] -> ExpQ
-chunksToExpQ cs = [|$expr :: Builder|] where
-  expr = foldl1 (\x y -> [|$x <> $y|]) $ map chunk1 cs
-  chunk1 (Lit, lit) = stringE $ Text.unpack lit
-  chunk1 (Var t, name) = case t of
+chunksToExpQ cs = [|mconcat $es|] where
+  es = listE $ mapMaybe chunk1 cs
+  chunk1 (Lit, "")     = Nothing
+  chunk1 (Lit, lit)    = Just $ stringE $ Text.unpack lit
+  chunk1 (Var t, name) = Just $ case t of
       Plain          -> var
       FromText       -> [|fromText $var|]
       FromString     -> [|fromString $var|]
+      FromChar       -> [|singleton $var|]
       Show           -> [|fromString $ show $var|]
       Reindent n     -> [|reindent n $var|]
       ReindentList n -> [|reindentList n $var|]