-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{- |
String interpolation quasi-quoters. The most basic version is 'i', it returns anything that
has a 'Fmt.FromBuilder' instance: 'Text', 'ByteString', 'String', @Builder@.

In some cases, it is more convenient to return a lazy @Text@ @Builder@, in that case 'ib', which
returns a non-polymorphic result, can be helpful, for instance, if you want to use one interpolated
string inside another one. Using @Builder@ is also more efficient in this case.

>>> let splice = [i|some text|]
>>> [i|larger text with #{splice}|] :: Text
...
... error:
... Ambiguous type variable ...
...

>>> let splice = [ib|some text|]
>>> [i|larger text with #{splice}|] :: Text
"larger text with some text"

There are also unindenting versions, i.e. those stripping the longest common indentation from each
line (note those do not consider indentation inside splices!), and trimming versions, i.e.
those that remove whitespace-only lines from beginning and end of the quote.

The mnemonic is @i@nterpolate @t@rimming @u@nindenting returning @b@uilder, i.e. 'itub' is
the trimming, unindenting version returning @Builder@.

Versions not interpreting Haskell escape sequences additionally start with @l@, e.g. 'litu' is
@l@iteral @i@nterpolation @t@trimming @u@nindenting.

>>> [i|\955\x1F600\\|]
λ😀\

>>> [li|\955\x1F600\\|]
\955\x1F600\\

Splices are specified in the form @#{variableName}@. Note that expressions are not supported.
You can add @\\@ before @#@, e.g. @\\#{variableName}@, to interpret it as literal text. All the usual
Haskell string escapes also work, unless using "literal" versions. A warning will be issued if an
escape is not recognized, however the code will still compile, ignoring the backslash, e.g.
@\\{@ will be treated as @{@.

All splices will be indented exactly to their column position in the original text, e.g.

>>> let splice = "multi\nline" :: Text
>>> [i|Some text #{splice}|]
Some text multi
          line

Multi-line splices will not automatically add any newlines after them, be mindful of that:

>>> let splice = "multi\nline" :: Text
>>> [i|Some text #{splice} trailing text|]
Some text multi
          line trailing text

If you wish to avoid that, either include the final newline in the splice explicitly (but be aware
that indentation of the trailing text won't be auto-adjusted, not even the leading spaces are
removed!), or include it in the quote:

>>> let splice = "multi\nline" :: Text
>>> :{
[itu|
  Some text #{splice}
  trailing text
  |]
:}
Some text multi
          line
trailing text

>>> let splice = "multi\nline\n" :: Text
>>> :{
[itu|
  Some text
    Some indented text #{splice} trailing text
  |]
:}
Some text
  Some indented text multi
                     line
 trailing text

Empty lines are never indented:

>>> let splice = "multi\n\nline" :: Text
>>> :{
print [itu|
  Some text #{splice}
  |]
:}
"Some text multi\n\n          line"

Unindenting versions will drop the first newline if the first line is empty, i.e.

>>> :{
print [iu|
There will be no leading newline here, but there will be a trailing one.
|]
:}
"There will be no leading newline here, but there will be a trailing one.\n"

but

>>> :{
print [iu|There will be a newline
here
|]
:}
"There will be a newline\nhere\n"

Unindent does not consider empty lines for finding common indentation, but it does consider
whitespace-only lines. As a result, one can control overall indentation by the indentation of the
last line:

>>> :{
let splice = "multi\nline" :: Text
in [itu|
    Some text #{splice}
    trailing text
  |]
:}
  Some text multi
            line
  trailing text
-}
module Morley.Util.Interpolate (
    i
  , ib
  , iu
  , iub
  , it
  , itb
  , itu
  , itub
  , li
  , lib
  , liu
  , liub
  , lit
  , litb
  , litu
  , litub
  ) where

import Language.Haskell.TH (Dec(SigD), Pat(VarP))
import Language.Haskell.TH.Quote (QuasiQuoter)

import Morley.Util.Interpolate.Internal
import Morley.Util.SizedList qualified as SL
import Morley.Util.SizedList.Types

$(
  let names = generateName <$> transformationsPowerSet
      infixp l r = [p| $l ::< $r |]
      pat = foldr infixp [p|Nil'|] (pure . VarP <$> names)
      sigs = traverse ((<$> [t|QuasiQuoter|]) . SigD) names
  in liftA2 (<>) sigs [d|$pat = mkQuoter <$> SL.unsafeFromList transformationsPowerSet|]
  )