GHC String Interpolation - Prototypes

I announced a survey over in GHC String Interpolation Survey Open!, but I got a lot of good feedback around people wanting to have a tool in hand to play around with and get a feel for the actual (not theoretical) ergonomics of the different options.

So I implemented a prototype of 5 different options here, and it’s extensible, so feel free to clone it, play around with your own proposals, and open PRs for any interesting options.

Spoiler: I kind of like the extensible-hasclass option.

18 Likes

No particular timeframe. Shall we say about a month? That should give ample time to settle

1 Like

implicit-builder

Design with MPTC Interpolate can produce rather weird results when one writes instances polymorphic in string type. And given number of possible stings one would want to write such instances. For example

data Foo a = Foo { foo :: String, bar :: a }

instance (Interpolate String s, Interpolate a s) => Interpolate (Foo a) s where
  interpolate Foo{..} = interpolate ("Foo<"::String)
                     <> interpolate foo
                     <> interpolate ("  "::String)
                     <> interpolate bar
                     <> interpolate (">"::String)

following code will bind 5 parameters when used with SQL queries. It’s probably not something user wanted. Is it good abstraction?

HasClass

I like this design. But Interpolate is tied to string. It’s suboptimal performance-wise. We could instead work with some abstract string with builder:

class (IsString s, Monoid (Builder s)) => IsInterpolatedString s where
  type Builder s = b | b -> s
  toBuilder   :: s -> Builder s
  fromBuilder :: Builder s -> s
  interpolateString  :: String -> Builder s
  interpolateInteger :: Integer -> Builder s
  {- Probably a lot of primitives -}

and Interpolate could have polymorphic return type:

class Interpolate a where
  iterpolate :: IsInterpolatedString s => a -> Builder s

Another question. Do we need extensibility? We have quasiquotes already and they serve basically same niche.

Formatting

And I what are plans for formatting options?

Why would someone write an instance polymorphic on String? Just write it on the specific types you use Foo with in your project

I’m not actually sure String would be noticably less performant, since it’s a flat mconcat. Maybe try running some benchmarks?

EDIT: Also, since it’s extensible, text could define their own interpolator that interpolates with Text.Builder, if performance is a bigger concern

Quasiquoters are really heavyweight; you have to use TH and figure out how to convert a string into an Exp (not sure how discoverable haskell-src-meta or ghc-meta are), both of which aren’t very welcoming to newer people. Unlike, say, macros in Rust or template literals in JS, which beginners easily use.

I’m not a fan of hardcoding a special formatting syntax a la Python f-strings. It feels too special-cased for me. It’s easily done IMO in userland, just use functions

pad :: Int -> Int -> String
pad n x = replicate (n - length (show x)) "0" ++ show x

s"Month: ${pad 2 month}"
3 Likes

That’s very weird question. Because it’s natural thing to do. It certainly beats writing 3 instances for string, text and lazy text. And it’s good smoke test. If polymorphic code starts to behave weirdly and it’s difficult to explain what does it do design in question likely has problems.

EDIT

Idea is about being able to define single instance which works for all string types and isn’t performance liability

It has advantage of being compact. And very common I think most if not all string interpolation implementations have some variant of it. Problem is we don’t have vocabulary of such functions.

Thanks for the feedback! Can you elaboarate on the pages of errors? I noticed in one of the issues you reported in the repo is the same error as normal OverloadedStrings behavior. I’m curious about interpolation-specific errors. I’m especially interested in the errors with the extensible-hasclass option, as that’s the option I’m currently leaning towards.

That’s surprising to me, as most languages use braces here. What would you prefer, just parentheses?

s"name=${name}"
“name=”<>name
s"name=$name"

To be fair, compare:

s"Hi ${name}, does ${otherPerson} know how ${function1} and ${function2} work?"
"Hi " <> name <> ", does " <> otherPerson <> " know how " <> function1 <> " and " <> function2 <> " work?"

And with the second, it’s a lot of leading/trailing spaces that are annoying to get right / not forget. AND lots of double quotes to start and close strings.

1 Like

Why add spaces ?

Are you talking about the spaces around <>?
(the spaces in the strings are there because of English, but I’m assuming that’s not what you meant, but that’s the spaces I was talking about)

The spaces around the operators are just my preference.

"Hi "<>name<>", does "<>otherPerson<>" know how "<>function1<>" and "<>function2<>" work?"

This feels like a worse “interpolation”, TBH.
${ vs. "<>, and } vs. <>")

I prefer the ${..} syntax because it makes it obvious where the variables are. (FYI, I also prefer ${A} over $A in bash scripts for example.)

Sure, I can add $name. I liked there being just one way to interpolate, and not being forced to escape every dollar sign in an interpolated string (only if there’s a brace afterwards), but it’s not a big deal.

Yes, you can put any expression in the bracket, so s"${x :: Int}".

Can you show your original + new code? It’s not clear to me how string interpolation causes the ambiguous Traversable error for mapM. It’s also not clear how you have an ambiguous Num constraint; your old code should also be ambiguous if you did show x

It’s still not clear why Traversable is an issue. skus is very clearly a list, unless you have OverloadedLists enabled? You should also see an issue without string interpolation.

Num should also have happened before string interpolation; tshow i is ambiguous if i is a polymorphic Num a => a

The only ambiguity I agree with here is that colour was previously constrained and is now ambiguous. I don’t personally see an issue with it, and don’t think it’d be that surprising if you were writing it as an interpolated string from the beginning (instead of rewriting a manually concatenated expression). But I acknowledge the wart there

1 Like

This is very cool! Thanks for putting this together. I also like extensible-hasclass, but extensible-th is strictly more general. Specifically, you can define extensibleTHFromExtensibleHasClass to get the behaviour of extensible-hasclass in terms of extensible-th. Here’s an example using your extensible-hasclass version of sql in terms of extensible-th.

By contrast, there are things that extensible-th can do that extensible-hasclass cannot, so I think the former should be preferred. In fact, I suspect that extensnible-th generalizes all the others.

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module MyProject where

import Data.String (IsString (..))
import Data.String.Syntax.ExtensibleHasClass (HasClass (HasClass))
import Data.String.Syntax.ExtensibleTH (Interpolate (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Language.Haskell.TH

extensibleTHFromExtensibleHasClass ::
  -- | @([Either String (HasClass c)] -> a)@
  Q Exp ->
  [Either String (Q Exp)] ->
  Q Exp
extensibleTHFromExtensibleHasClass k parts =
  [|$k $(listE (map go parts))|]
  where
    go = \case
      Left str -> [|Left str|]
      Right e -> [|Right (HasClass $e)|]

sqlImpl :: [Either String (HasClass ToSqlValue)] -> SqlQuery
sqlImpl = mconcat . map go
  where
    go :: Either String (HasClass ToSqlValue) -> SqlQuery
    go = \case
      Left s -> SqlQuery s []
      Right (HasClass v) -> SqlQuery "?" [toSqlValue v]

sql :: [Either String (Q Exp)] -> Q Exp
sql = extensibleTHFromExtensibleHasClass [|sqlImpl|]

Using it gives the expected results:

Summary
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module MyProjectUse where

import Data.String (IsString (..))
import Data.String.Syntax.ExtensibleTH (Interpolate)
import Data.Text (Text)
import MyProject

data Person = Person {name :: String, age :: Int}

instance Interpolate Person where
  interpolate Person {..} = s"Person<${name}, ${age}>"

main :: IO ()
main = do
  let name = "Alice" :: String; age = 30 :: Int; person = Person {..}

  print (s"Hello ${name}! Your age is ${age}" :: String)
  print (s"You are: ${person}" :: String)

  let name2 = fromString "Alice" :: Text
  print (s"Hello ${name2}! Your age is ${age}" :: Text)

  -- use our own `sql` function defined in Lib
  print sql"SELECT * FROM user WHERE name ILIKE ${name} AND age = ${age}"
ghci> main
"Hello Alice! Your age is 30"
"You are: Person<Alice, 30>"
"Hello Alice! Your age is 30"
SqlQuery {sqlText = "SELECT * FROM user WHERE name ILIKE ? AND age = ?", sqlValues = [SqlString "Alice",SqlInt 30]}
1 Like

I like extensible-th in the combination with the HasClass idea as proposed by Tom above. I think that design could be simplified even more by removing HasClass (not tested, though):

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module MyProject where

import Data.String (IsString (..))
import Data.String.Syntax.ExtensibleHasClass (HasClass (HasClass))
import Data.String.Syntax.ExtensibleTH (Interpolate (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Language.Haskell.TH

extensibleTHFromExtensibleHasClass ::
  -- | @(TExp String -> TExp str)@
  (Q Exp -> Q Exp) ->
  -- | @(TExp v -> TExp str)@
  (Q Exp -> Q Exp) ->
  [Either String (Q Exp)] ->
  Q Exp -- ^ TExp (Monoid str => str) -- roughly
extensibleTHFromExtensibleHasClass mkStr mkVal parts =
  [|mconcat $(listE (map go parts))|]
  where
    go = \case
      Left str -> mkStr str
      Right e -> mkVal e

sql :: [Either String (Q Exp)] -> Q Exp
sql = extensibleTHFromExtensibleHasClass (s -> [| SqlQuery $s [] |]) (v -> [| SqlQuery "?" (toSqlValue $v) |])

Re: TH: Any serious issues with TH (impact on compile-times, build parallelism, cross compilation) are likely to be resolved in the mid-term future. The first two will be solved by the new -XExplicitLevelImports proposal which is likely to be accepted soon. IIUC enabling TH for cross compilation is “just” a huge engineering effort that mostly concerns adding support for retargetable package DBs to Cabal etc. (The stage restriction does not appear to be a problem worth fixing in practice, but it could be solved, too.)

4 Likes

I suppose it would be possible with extensible-hasclass to define an interpolation function

hacky :: [Either String (HasClass a)] -> Q Exp

Then if you did $hacky"a ${x} b", you’d get to evaluate the splice at compile time. Assuming the parsing works like that.

How does that compare to extensible-th?

Interesting! I like that, let me add it as a note for extensible-hasclass. As mentioned above, you could implement hasclass with the th version, but with your idea, we could also recover the th version with HasClass. One slight difference is that the th version takes in splices as Q Exp, so the th version could theoretically inspect/modify the expressions before interpolation

I’m also not sure how the following would work with hacky:

sumAndInterp :: Int -> Int -> String
sumAndInterp x y = $hacky"the sum is: ${x + y}"

We would like to embed the expression x+y, but from a glance this would only let us embed values.

For instance, this doesn’t compile:

sumAndSplice x y = $(lift $ x + y)
2 Likes

Does

foo x y = $(lift [| x + y |])

work? extensible-hasclass might allow the following for free:

hacky :: [Either String (HasClass Quote)] -> Q Exp
foo x y = $(hacky"a ${[| x + y |]} b")

A future proposal could drop the extra parens if this is sufficiently useful

2 Likes

Rather than $(lift [| x + y|]), I think you want $([| x + y|]).

Good point!
If it gets desugared like so then it should work:

foo x y = $(hacky"a ${[| x + y|]} b")
-- desguars to
foo x y = $(hacky [Left "a", Right (HasClass [| x + y|]), Left "b")

Though this is quite verbose, and eliminating verbosity is the aim of this proposal.

A future proposal could drop the extra parens if this is sufficiently useful

I feel like we should aim to either handle these cases well in this proposal or try to go for something really quite minimal and leave the extensible case wholesale to a later one.

2 Likes