Tidy up building strings with string-interpolate

app/Main.hs

@@ -7,6 +7,7 @@ import Control.Applicative (optional, (<**>))
 import Control.Monad (unless)
 import Control.Monad.Trans.Class (lift)
 import Data.List (isPrefixOf, stripPrefix)
+import Data.String.Interpolate (i)
 import Data.Version (showVersion)
 import Effectful (Eff, IOE, MonadIO, liftIO, runEff, (:>))
 import Effectful.State.Static.Local (State, evalState, get, modify, put)
@@ -87,13 +88,13 @@ runFile path = do
 
 repl :: IOE :> es => Eff es ()
 repl = do
-  let adjectives = ["cunning", "crafty", "guileful", "shrewd"]
+  let adjectives = ["cunning", "crafty", "guileful", "shrewd"] :: [String]
 
   stdGen <- liftIO initStdGen
   let (n, _) = uniformR (0, length adjectives - 1) stdGen
-  outputStrLn $
-    "Welcome to " <> versionString <> ", the " <> adjectives !! n <> " λ-calculus interpreter!\n"
-      <> "Type :quit or press C-d to exit."
+  outputStrLn
+    [i|Welcome to #{versionString}, the #{adjectives !! n} λ-calculus interpreter!|]
+  outputStrLn "Type :quit or press C-d to exit."
 
   evalState mempty $ runInputT defaultSettings loop
  where

cabal.project

@@ -4,4 +4,7 @@
 packages: sly.cabal
 test-show-details: direct
 
+allow-newer:
+  string-interpolate-0.3.2.1:text
+
 -- vim: ft=cabal

sly.cabal

@@ -38,6 +38,7 @@ common defaults
     NoFieldSelectors,
     OverloadedRecordDot,
     OverloadedStrings,
+    QuasiQuotes,
     RecordWildCards,
     UnicodeSyntax,
 
@@ -50,6 +51,7 @@ common deps
     effectful-plugin ^>=1.1.0.2,
     megaparsec ^>=9.6.0,
     parser-combinators ^>=1.3.0,
+    string-interpolate ^>=0.3.2.1,
     text ^>=2.1,
     transformers ^>=0.5.6.2 || ^>=0.6.1.0,
     unicode-data ^>=0.4.0.1,

src/Sly/Syntax.hs

@@ -12,6 +12,7 @@ module Sly.Syntax (
   fromChurchBool,
 ) where
 
+import Data.String.Interpolate (i)
 import Data.Text (Text)
 
 import Data.Text qualified as T
@@ -33,7 +34,7 @@ data Statement
 
 instance Show Statement where
   show (Term t) = show t <> "."
-  show (Ass (Name n) t) = T.unpack $ "let " <> n <> " := " <> T.pack (show t) <> "."
+  show (Ass (Name n) t) = T.unpack [i|let #{n} := #{T.pack (show t)}.|]
 
 -- | A λ-term.
 data Term
@@ -51,11 +52,11 @@ instance Show Term where
     go :: Term -> Text
     go (Var (Name n)) = n
     go (Abs (Name n) body) = "λ" <> n <> slurp body
-    go (App l@(Abs _ _) r@(Abs _ _)) = "(" <> go l <> ") " <> "(" <> go r <> ")"
-    go (App l@(Abs _ _) r) = "(" <> go l <> ") " <> go r
-    go (App l r@(Abs _ _)) = go l <> " (" <> go r <> ")"
-    go (App l r@(App _ _)) = go l <> " (" <> go r <> ")"
-    go (App l r) = go l <> " " <> go r
+    go (App l@(Abs _ _) r@(Abs _ _)) = [i|(#{go l}) (#{go r})|]
+    go (App l@(Abs _ _) r) = [i|(#{go l}) #{go r}|]
+    go (App l r@(Abs _ _)) = [i|#{go l} (#{go r})|]
+    go (App l r@(App _ _)) = [i|#{go l} (#{go r})|]
+    go (App l r) = [i|#{go l} #{go r}|]
 
     -- Slurp up λ-abstractions!
     slurp :: Term -> Text
@@ -67,8 +68,8 @@ astShow :: Term -> String
 astShow = T.unpack . go
  where
   go (Var (Name n)) = n
-  go (Abs (Name n) t) = "(λ" <> n <> " -> " <> go t <> ")"
-  go (App l r) = "(" <> go l <> " " <> go r <> ")"
+  go (Abs (Name n) t) = [i|λ#{n} -> #{go t})|]
+  go (App l r) = [i|(#{go l} #{go r})|]
 
 -- | Convert a nonnegative integer into a Church numeral term.
 toChurchNat :: Int -> Term