Add an st quasiquoter for generating strict Text

src/Buf.hs

@@ -1,9 +1,12 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Buf (Buf (..), SizedStr, SizedBuilder) where
+module Buf (Buf (..), SizedStr, SizedBuilder, SizedStrictBuilder) where
 
 import Data.Char (intToDigit)
+import Data.Coerce
 import qualified Data.DList as D
 import Data.Kind (Type)
 import Data.String
@@ -15,8 +18,12 @@ import qualified Data.Text.Lazy.Builder.Int as T
 
 newtype Sized a = Sized {unSized :: (a, Int)} deriving (Show, Ord, Eq)
 
+newtype StrictBuilder = StrictBuilder {unStrictBuilder :: T.Builder}
+  deriving (Eq, Ord, Show, IsString, Semigroup, Monoid)
+
 type SizedStr = Sized (D.DList Char)
 type SizedBuilder = Sized T.Builder
+type SizedStrictBuilder = Sized StrictBuilder
 
 instance (IsString a) => IsString (Sized a) where
   fromString s = Sized (fromString s, length s)
@@ -74,3 +81,13 @@ instance Buf SizedBuilder where
   digit c = Sized (T.hexadecimal c, 1)
   finalize = T.toLazyText . fst . unSized
   size = snd . unSized
+
+instance Buf SizedStrictBuilder where
+  type Output SizedStrictBuilder = S.Text
+  str = coerce $ str @SizedBuilder
+  sText = coerce $ sText @SizedBuilder
+  lText = coerce $ lText @SizedBuilder
+  singleton = coerce $ singleton @SizedBuilder
+  digit = coerce $ digit @SizedBuilder
+  finalize = L.toStrict . coerce (finalize @SizedBuilder)
+  size = coerce $ size @SizedBuilder

src/Language/Haskell/Printf.hs

@@ -20,6 +20,7 @@ your input must be an instance of "Bounded".
 module Language.Haskell.Printf (
   s,
   t,
+  st,
   p,
   hp,
 ) where
@@ -77,6 +78,12 @@ t = quoter $ \s' -> do
   (lhss, rhs) <- toSplices s' OutputText
   return $ LamE lhss rhs
 
+-- | Behaves identically to 's', but produces strict 'Data.Text.Text'.
+st :: QuasiQuoter
+st = quoter $ \s' -> do
+  (lhss, rhs) <- toSplices s' OutputStrictText
+  return $ LamE lhss rhs
+
 {- | Like 's', but prints the resulting string to @stdout@.
 
 @

src/Language/Haskell/Printf/Lib.hs

@@ -21,6 +21,7 @@ import Language.Haskell.TH.Syntax
 import Buf (
   SizedBuilder,
   SizedStr,
+  SizedStrictBuilder,
   finalize,
  )
 import Control.Monad (mapAndUnzipM)
@@ -30,7 +31,7 @@ import Parser.Types hiding (
   width,
  )
 
-data OutputType = OutputString | OutputText
+data OutputType = OutputString | OutputText | OutputStrictText
   deriving (Show, Eq, Ord, Generic, Enum, Bounded)
 
 {- | Takes a format string as input and produces a tuple @(args, outputExpr)@.
@@ -57,6 +58,7 @@ toSplices s' ot = case parseStr s' of
   otype = case ot of
     OutputString -> [t|SizedStr|]
     OutputText -> [t|SizedBuilder|]
+    OutputStrictText -> [t|SizedStrictBuilder|]
 
 extractExpr :: Atom -> Q ([Name], ExpQ)
 extractExpr (Str s') = return ([], [|fromString $(stringE s')|])