-- |
-- Module      : Data.String.Interpolate
-- Description : Unicode-aware string interpolation that handles all textual types.
-- Copyright   : (c) William Yao, 2019-2023
-- License     : BSD-3
-- Maintainer  : williamyaoh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- This module provides three quasiquoters, `i', `__i', and `iii', which:
--
-- * handle all of String\/Text\/ByteString, both strict and lazy
-- * can interpolate /into/ anything that implements `IsString'
-- * can interpolate anything that implements `Show'
-- * are Unicode aware
-- * are fast
-- * handle multiline strings
--
-- `i' leaves newlines and whitespace intact as they are in the source
-- code. `__i' strips leading indentation and surrounding blank lines, while
-- leaving linebreaks intact. `iii' collapses newlines/whitespace into single
-- spaces, putting all the output on a single line.
--
-- As an example,
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > {-# LANGUAGE QuasiQuotes #-}
-- >
-- > import Data.Text
-- > import Data.String.Interpolate ( i )
-- >
-- > λ> age = 33 :: Int
-- > λ> name = "Tatiana" :: Text
-- > λ> [i|{"name": "#{name}", "age": #{age}}|] :: String
-- > >>> "{\"name\": \"Tatiana\", \"age\": 33}"
-- >
-- > λ> [i|
-- > Name: #{name}
-- > Age: #{age}
-- > |] :: String
-- > >>> "\nName: Tatiana\nAge: 33\n"
--
-- There are also variants of `__i' and `iii' which have different behavior
-- for surrounding newlines.
--
-- See the README at <https://gitlab.com/williamyaoh/string-interpolate/blob/master/README.md>
-- for more details and examples.

{-# LANGUAGE TemplateHaskell #-}

module Data.String.Interpolate
  (
    -- * Basic interpolators
    i, __i, iii
    -- * Interpolator variants for newline handling
  , __i'E, __i'L, iii'E, iii'L
  )
where

import Control.Monad ( (<=<) )

import Data.Foldable ( traverse_ )
import Data.List     ( intercalate )
import Data.Proxy

import qualified Language.Haskell.Exts.Extension as Ext
import           Language.Haskell.Exts.Parser
  ( ParseMode(..), ParseResult(..), defaultParseMode, parseExpWithMode )
import           Language.Haskell.Meta           ( ToExp(..) )
import           Language.Haskell.TH
import           Language.Haskell.TH.Quote       ( QuasiQuoter(..) )

import Data.String.Interpolate.Conversion ( build, finalize, interpolate, ofString )

import Data.String.Interpolate.Lines      ( IndentWarning(..), Mindent(..), handleIndents )
import Data.String.Interpolate.Parse
import Data.String.Interpolate.Types
import Data.String.Interpolate.Whitespace ( collapseWhitespace )

data OutputSegment
  = OfString String
  | Interpolate String

-- |
-- Singleton list of the first element, if there is one.
fore :: [a] -> [a]
fore :: forall a. [a] -> [a]
fore []    = []
fore (a
x:[a]
_) = [a
x]

-- |
-- Singleton list of the last element, if there is one.
aft :: [a] -> [a]
aft :: forall a. [a] -> [a]
aft []     = []
aft [a
x]    = [a
x]
aft (a
_:[a]
xs) = forall a. [a] -> [a]
aft [a]
xs

collapseStrings :: [OutputSegment] -> [OutputSegment]
collapseStrings :: [OutputSegment] -> [OutputSegment]
collapseStrings [] = []
collapseStrings (OfString String
s1 : OfString String
s2 : [OutputSegment]
rest) =
  [OutputSegment] -> [OutputSegment]
collapseStrings ((String -> OutputSegment
OfString forall a b. (a -> b) -> a -> b
$ String
s1 forall a. [a] -> [a] -> [a]
++ String
s2) forall a. a -> [a] -> [a]
: [OutputSegment]
rest)
collapseStrings (OutputSegment
other : [OutputSegment]
rest) = OutputSegment
other forall a. a -> [a] -> [a]
: [OutputSegment] -> [OutputSegment]
collapseStrings [OutputSegment]
rest

renderLines :: Lines -> [OutputSegment]
renderLines :: Lines -> [OutputSegment]
renderLines = forall a. [a] -> [[a]] -> [a]
intercalate [String -> OutputSegment
OfString String
"\n"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Line -> [OutputSegment]
renderLine
  where
    renderLine :: Line -> [OutputSegment]
    renderLine :: Line -> [OutputSegment]
renderLine = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InterpSegment -> OutputSegment
renderSegment

    renderSegment :: InterpSegment -> OutputSegment
    renderSegment :: InterpSegment -> OutputSegment
renderSegment (Expression String
expr) = String -> OutputSegment
Interpolate String
expr
    renderSegment (Verbatim String
str)    = String -> OutputSegment
OfString String
str
    renderSegment (Spaces Int
n)        = String -> OutputSegment
OfString (forall a. Int -> a -> [a]
replicate Int
n Char
' ')
    renderSegment (Tabs Int
n)          = String -> OutputSegment
OfString (forall a. Int -> a -> [a]
replicate Int
n Char
'\t')

-- |
-- Produce the final Template Haskell expression. Handles collapsing
-- intermediate strings.
outputToExp :: [OutputSegment] -> Q Exp
outputToExp :: [OutputSegment] -> Q Exp
outputToExp [OutputSegment]
segs = [|finalize Proxy $(go (collapseStrings segs))|]
  where
    go :: [OutputSegment] -> Q Exp
    go :: [OutputSegment] -> Q Exp
go = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\OutputSegment
seg Q Exp
qexp -> [|build Proxy $(renderExp seg) $(qexp)|])
      [|ofString Proxy ""|]

    renderExp :: OutputSegment -> Q Exp
    renderExp :: OutputSegment -> Q Exp
renderExp (OfString String
str)     = [|ofString Proxy str|]
    renderExp (Interpolate String
expr) = [|interpolate Proxy $(reifyExpression expr)|]

type Interpolator = ParseOutput -> Q Lines

-- |
-- Fundamentally all our interpolators are, are functions from the parse
-- input to some transformed lines. The rest is just boilerplate.
interpolator :: String -> Interpolator -> QuasiQuoter
interpolator :: String -> Interpolator -> QuasiQuoter
interpolator String
qqName Interpolator
transform = QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  =
      [OutputSegment] -> Q Exp
outputToExp
        forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> [OutputSegment]
renderLines)
        forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Interpolator
transform
        forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. String -> Either String a -> Q a
unwrap String
qqName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String ParseOutput
parseInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dosToUnix
  , quotePat :: String -> Q Pat
quotePat  = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. String -> String -> Q a
errQQType String
qqName String
"pattern"
  , quoteType :: String -> Q Type
quoteType = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. String -> String -> Q a
errQQType String
qqName String
"type"
  , quoteDec :: String -> Q [Dec]
quoteDec  = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. String -> String -> Q a
errQQType String
qqName String
"declaration"
  }

-- |
-- The basic, no-frills interpolator. Will interpolate anything you wrap in @#{}@, and
-- otherwise leaves what you write alone.
i :: QuasiQuoter
i :: QuasiQuoter
i = String -> Interpolator -> QuasiQuoter
interpolator String
"i" Interpolator
transform
  where
    transform :: Interpolator
    transform :: Interpolator
transform (ParseOutput Lines
header Lines
content Lines
footer) =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [Lines
header, Lines
content, Lines
footer]

-- |
-- An interpolator that handles indentation. Will interpolate anything you wrap in @#{}@,
-- remove leading indentation, and remove any blank lines before and after the content.
--
-- If the contained interpolation uses both tabs and spaces for indentation, @__i@
-- will assume the indentation type it finds in the first nonblank line, ignoring
-- indentation of the other type. Please don't use mixed indentation.
--
-- Note that only indentation you actually write in source code will be stripped;
-- @__i@ does not touch any lines or whitespace inserted by interpolations themselves.
--
-- There is no extra performance penalty for using @__i@.
__i :: QuasiQuoter
__i :: QuasiQuoter
__i = String -> Interpolator -> QuasiQuoter
interpolator String
"__i" Interpolator
transform
  where
    transform :: Interpolator
    transform :: Interpolator
transform (ParseOutput Lines
_ Lines
content Lines
_) = do
      let ([IndentWarning]
warns, Lines
withoutIndent) = Lines -> ([IndentWarning], Lines)
handleIndents Lines
content
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ IndentWarning -> Q ()
reportIndentWarning [IndentWarning]
warns
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Lines
withoutIndent

-- |
-- Like `__i', but leaves any surrounding newlines intact.
--
-- The way to remember which is which is to look at the suffix character;
-- the multiple horizontal lines of the capital @E@ suggests multiple
-- textual lines.
__i'E :: QuasiQuoter
__i'E :: QuasiQuoter
__i'E = String -> Interpolator -> QuasiQuoter
interpolator String
"__i'E" Interpolator
transform
  where
    transform :: Interpolator
    transform :: Interpolator
transform (ParseOutput Lines
header Lines
content Lines
footer) = do
      let ([IndentWarning]
warns, Lines
withoutIndent) = Lines -> ([IndentWarning], Lines)
handleIndents Lines
content
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ IndentWarning -> Q ()
reportIndentWarning [IndentWarning]
warns
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [Lines
header, Lines
withoutIndent, Lines
footer]

-- |
-- Like `__i', but collapses any surrounding newlines into a single newline.
--
-- The way to remember which is which is to look at the suffix character;
-- the single horizontal line of the capital @L@ suggests that it leaves
-- only a single newline.
__i'L :: QuasiQuoter
__i'L :: QuasiQuoter
__i'L = String -> Interpolator -> QuasiQuoter
interpolator String
"__i'L" Interpolator
transform
  where
    transform :: Interpolator
    transform :: Interpolator
transform (ParseOutput Lines
header Lines
content Lines
footer) = do
      let ([IndentWarning]
warns, Lines
withoutIndent) = Lines -> ([IndentWarning], Lines)
handleIndents Lines
content
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ IndentWarning -> Q ()
reportIndentWarning [IndentWarning]
warns
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [forall a. [a] -> [a]
aft Lines
header, Lines
withoutIndent, forall a. [a] -> [a]
fore Lines
footer]

-- |
-- An interpolator that strips excess whitespace. Will collapse any sequences of
-- multiple spaces or whitespace into a single space, putting the output onto a
-- single line with surrounding whitespace removed.
--
-- Note that only whitespace you actually write in source code will be collapsed;
-- @iii@ does not touch any lines or whitespace inserted by interpolations themselves.
--
-- There is no extra performance penalty for using @iii@.
iii :: QuasiQuoter
iii :: QuasiQuoter
iii = String -> Interpolator -> QuasiQuoter
interpolator String
"iii" Interpolator
transform
  where
    transform :: Interpolator
    transform :: Interpolator
transform (ParseOutput Lines
_ Lines
content Lines
_) =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! [Lines -> Line
collapseWhitespace Lines
content]

-- |
-- Like `iii', but leaves any surrounding newlines intact.
--
-- The way to remember which is which is to look at the suffix character;
-- the multiple horizontal lines of the capital @E@ suggests multiple
-- textual lines.
iii'E :: QuasiQuoter
iii'E :: QuasiQuoter
iii'E = String -> Interpolator -> QuasiQuoter
interpolator String
"iii'E" Interpolator
transform
  where
    transform :: Interpolator
    transform :: Interpolator
transform (ParseOutput Lines
header Lines
content Lines
footer) =
      let collapsed :: Line
collapsed = Lines -> Line
collapseWhitespace Lines
content
      in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [Lines
header, [Line
collapsed], Lines
footer]

-- |
-- Like `iii', but collapses any surrounding newlines into a single newline.
--
-- The way to remember which is which is to look at the suffix character;
-- the single horizontal line of the capital @L@ suggests that it leaves
-- only a single newline.
iii'L :: QuasiQuoter
iii'L :: QuasiQuoter
iii'L = String -> Interpolator -> QuasiQuoter
interpolator String
"iii'L" Interpolator
transform
  where
    transform :: Interpolator
    transform :: Interpolator
transform (ParseOutput Lines
header Lines
content Lines
footer) =
      let collapsed :: Line
collapsed = Lines -> Line
collapseWhitespace Lines
content
      in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat [forall a. [a] -> [a]
aft Lines
header, [Line
collapsed], forall a. [a] -> [a]
fore Lines
footer]

--------------------
-- UTILITIES
--------------------

errQQ :: String -> String -> Q a
errQQ :: forall a. String -> String -> Q a
errQQ String
qqName String
msg =
  forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Data.String.Interpolate." forall a. [a] -> [a] -> [a]
++ String
qqName forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg)

errQQType :: String -> String -> Q a
errQQType :: forall a. String -> String -> Q a
errQQType String
qqName = forall a. String -> String -> Q a
errQQ String
qqName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"This QuasiQuoter cannot be used as a " forall a. [a] -> [a] -> [a]
++)

unwrap :: String -> Either String a -> Q a
unwrap :: forall a. String -> Either String a -> Q a
unwrap = forall err a. (err -> String) -> String -> Either err a -> Q a
unwrapWith forall a. a -> a
id

unwrapWith :: (err -> String) -> String -> Either err a -> Q a
unwrapWith :: forall err a. (err -> String) -> String -> Either err a -> Q a
unwrapWith err -> String
f String
qqName Either err a
e = case Either err a
e of
  Left err
err -> forall a. String -> String -> Q a
errQQ String
qqName forall a b. (a -> b) -> a -> b
$ err -> String
f err
err
  Right a
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

reifyExpression :: String -> Q Exp
reifyExpression :: String -> Q Exp
reifyExpression String
s = do
  -- We want to explicitly use whatever extensions are enabled in current module
  [Extension]
exts      <- (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (String -> Extension
Ext.parseExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Q [Extension]
extsEnabled
  ParseMode
parseMode <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseMode
defaultParseMode { extensions :: [Extension]
extensions = [Extension]
exts })
  case ParseMode -> String -> ParseResult (Exp SrcSpanInfo)
parseExpWithMode ParseMode
parseMode String
s of
    ParseFailed SrcLoc
_ String
err  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
      String
"Data.String.Interpolate.i: got error: '" forall a. [a] -> [a] -> [a]
++ String
err forall a. [a] -> [a] -> [a]
++ String
"' while parsing expression: " forall a. [a] -> [a] -> [a]
++ String
s
    ParseOk Exp SrcSpanInfo
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. ToExp a => a -> Exp
toExp Exp SrcSpanInfo
e)

reportIndentWarning :: IndentWarning -> Q ()
reportIndentWarning :: IndentWarning -> Q ()
reportIndentWarning (IndentWarning String
line Mindent
base) = do
  let
    header :: String
header = case Mindent
base of
      UsesSpaces Int
_ -> String
"found TAB in SPACE-based indentation on this line:"
      UsesTabs Int
_   -> String
"found SPACE in TAB-based indentation on this line:"
    message :: String
message =
         String
header forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
      forall a. Semigroup a => a -> a -> a
<> String
"  " forall a. Semigroup a => a -> a -> a
<> String
line forall a. Semigroup a => a -> a -> a
<> String
"\n"
  String -> Q ()
reportWarning String
message