-- |
-- Module      : Data.String.Interpolate
-- Description : Unicode-aware string interpolation that handles all textual types.
-- Copyright   : (c) William Yao, 2019-2021
-- 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 #-}
-- >
-- > 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 :: [a] -> [a]
fore []    = []
fore (a
x:[a]
_) = [a
x]

-- |
-- Singleton list of the last element, if there is one.
aft :: [a] -> [a]
aft :: [a] -> [a]
aft []     = []
aft [a
x]    = [a
x]
aft (a
_:[a]
xs) = [a] -> [a]
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 (String -> OutputSegment) -> String -> OutputSegment
forall a b. (a -> b) -> a -> b
$ String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2) OutputSegment -> [OutputSegment] -> [OutputSegment]
forall a. a -> [a] -> [a]
: [OutputSegment]
rest)
collapseStrings (OutputSegment
other : [OutputSegment]
rest) = OutputSegment
other OutputSegment -> [OutputSegment] -> [OutputSegment]
forall a. a -> [a] -> [a]
: [OutputSegment] -> [OutputSegment]
collapseStrings [OutputSegment]
rest

renderLines :: Lines -> [OutputSegment]
renderLines :: Lines -> [OutputSegment]
renderLines = [OutputSegment] -> [[OutputSegment]] -> [OutputSegment]
forall a. [a] -> [[a]] -> [a]
intercalate [String -> OutputSegment
OfString String
"\n"] ([[OutputSegment]] -> [OutputSegment])
-> (Lines -> [[OutputSegment]]) -> Lines -> [OutputSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> [OutputSegment]) -> Lines -> [[OutputSegment]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Line -> [OutputSegment]
renderLine
  where
    renderLine :: Line -> [OutputSegment]
    renderLine :: Line -> [OutputSegment]
renderLine = (InterpSegment -> OutputSegment) -> Line -> [OutputSegment]
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 (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ')
    renderSegment (Tabs Int
n)          = String -> OutputSegment
OfString (Int -> Char -> String
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 = (OutputSegment -> Q Exp -> Q Exp)
-> Q Exp -> [OutputSegment] -> Q Exp
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 :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  =
      [OutputSegment] -> Q Exp
outputToExp
        ([OutputSegment] -> Q Exp)
-> (String -> Q [OutputSegment]) -> String -> Q Exp
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ([OutputSegment] -> Q [OutputSegment]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OutputSegment] -> Q [OutputSegment])
-> (Lines -> [OutputSegment]) -> Lines -> Q [OutputSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> [OutputSegment]
renderLines)
        (Lines -> Q [OutputSegment])
-> (String -> Q Lines) -> String -> Q [OutputSegment]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Interpolator
transform
        Interpolator -> (String -> Q ParseOutput) -> String -> Q Lines
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Either String ParseOutput -> Q ParseOutput
forall a. String -> Either String a -> Q a
unwrap String
qqName (Either String ParseOutput -> Q ParseOutput)
-> (String -> Either String ParseOutput) -> String -> Q ParseOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String ParseOutput
parseInput (String -> Either String ParseOutput)
-> (String -> String) -> String -> Either String ParseOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dosToUnix
  , quotePat :: String -> Q Pat
quotePat  = Q Pat -> String -> Q Pat
forall a b. a -> b -> a
const (Q Pat -> String -> Q Pat) -> Q Pat -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ String -> String -> Q Pat
forall a. String -> String -> Q a
errQQType String
qqName String
"pattern"
  , quoteType :: String -> Q Type
quoteType = Q Type -> String -> Q Type
forall a b. a -> b -> a
const (Q Type -> String -> Q Type) -> Q Type -> String -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> String -> Q Type
forall a. String -> String -> Q a
errQQType String
qqName String
"type"
  , quoteDec :: String -> Q [Dec]
quoteDec  = Q [Dec] -> String -> Q [Dec]
forall a b. a -> b -> a
const (Q [Dec] -> String -> Q [Dec]) -> Q [Dec] -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ String -> String -> Q [Dec]
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) =
      Lines -> Q Lines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lines -> Q Lines) -> Lines -> Q Lines
forall a b. (a -> b) -> a -> b
$! [Lines] -> Lines
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
      (IndentWarning -> Q ()) -> [IndentWarning] -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ IndentWarning -> Q ()
reportIndentWarning [IndentWarning]
warns
      Lines -> Q Lines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lines -> Q Lines) -> Lines -> Q Lines
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
      (IndentWarning -> Q ()) -> [IndentWarning] -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ IndentWarning -> Q ()
reportIndentWarning [IndentWarning]
warns
      Lines -> Q Lines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lines -> Q Lines) -> Lines -> Q Lines
forall a b. (a -> b) -> a -> b
$! [Lines] -> Lines
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
      (IndentWarning -> Q ()) -> [IndentWarning] -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ IndentWarning -> Q ()
reportIndentWarning [IndentWarning]
warns
      Lines -> Q Lines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lines -> Q Lines) -> Lines -> Q Lines
forall a b. (a -> b) -> a -> b
$! [Lines] -> Lines
forall a. Monoid a => [a] -> a
mconcat [Lines -> Lines
forall a. [a] -> [a]
aft Lines
header, Lines
withoutIndent, Lines -> Lines
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
_) =
      Lines -> Q Lines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lines -> Q Lines) -> Lines -> Q Lines
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 Lines -> Q Lines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lines -> Q Lines) -> Lines -> Q Lines
forall a b. (a -> b) -> a -> b
$! [Lines] -> Lines
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 Lines -> Q Lines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lines -> Q Lines) -> Lines -> Q Lines
forall a b. (a -> b) -> a -> b
$! [Lines] -> Lines
forall a. Monoid a => [a] -> a
mconcat [Lines -> Lines
forall a. [a] -> [a]
aft Lines
header, [Line
collapsed], Lines -> Lines
forall a. [a] -> [a]
fore Lines
footer]

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

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

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

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

unwrapWith :: (err -> String) -> String -> Either err a -> Q a
unwrapWith :: (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 -> String -> String -> Q a
forall a. String -> String -> Q a
errQQ String
qqName (String -> Q a) -> String -> Q a
forall a b. (a -> b) -> a -> b
$ err -> String
f err
err
  Right a
x  -> a -> Q a
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      <- (([Extension] -> [Extension]) -> Q [Extension] -> Q [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Extension] -> [Extension]) -> Q [Extension] -> Q [Extension])
-> ((Extension -> Extension) -> [Extension] -> [Extension])
-> (Extension -> Extension)
-> Q [Extension]
-> Q [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension -> Extension) -> [Extension] -> [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (String -> Extension
Ext.parseExtension (String -> Extension)
-> (Extension -> String) -> Extension -> Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Show a => a -> String
show) Q [Extension]
extsEnabled
  ParseMode
parseMode <- ParseMode -> Q 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  -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$
      String
"Data.String.Interpolate.i: got error: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' while parsing expression: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
    ParseOk Exp SrcSpanInfo
e -> Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp SrcSpanInfo -> Exp
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 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
line String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"
  String -> Q ()
reportWarning String
message