{-|
NeatInterpolation provides a quasiquoter for producing strings
with a simple interpolation of input values.
It removes the excessive indentation from the input and
accurately manages the indentation of all lines of interpolated variables.
But enough words, the code shows it better.

Consider the following declaration:

> {-# LANGUAGE QuasiQuotes #-}
>
> import NeatInterpolation
> import Data.Text (Text)
>
> f :: Text -> Text -> Text
> f a b =
>   [trimming|
>     function(){
>       function(){
>         $a
>       }
>       return $b
>     }
>   |]

Executing the following:

> main = Text.putStrLn $ f "1" "2"

will produce this (notice the reduced indentation compared to how it was
declared):

> function(){
>   function(){
>     1
>   }
>   return 2
> }

Now let's test it with multiline string parameters:

> main = Text.putStrLn $ f
>   "{\n  indented line\n  indented line\n}"
>   "{\n  indented line\n  indented line\n}"

We get

> function(){
>   function(){
>     {
>       indented line
>       indented line
>     }
>   }
>   return {
>     indented line
>     indented line
>   }
> }

See how it neatly preserved the indentation levels of lines the
variable placeholders were at?

If you need to separate variable placeholder from the following text to
prevent treating the rest of line as variable name, use escaped variable:

> f name = [trimming|this_could_be_${name}_long_identifier|]

So

> f "one" == "this_could_be_one_long_identifier"

If you want to write something that looks like a variable but should be
inserted as-is, escape it with another @$@:

> f word = [trimming|$$my ${word} $${string}|]

results in

> f "funny" == "$my funny ${string}"
-}
module NeatInterpolation (trimming, untrimming, text) where

import NeatInterpolation.Prelude
import Language.Haskell.TH
import Language.Haskell.TH.Quote hiding (quoteExp)
import qualified Data.Text as Text
import qualified NeatInterpolation.String as String
import qualified NeatInterpolation.Parsing as Parsing


expQQ :: ([Char] -> Q Exp) -> QuasiQuoter
expQQ [Char] -> Q Exp
quoteExp = ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter [Char] -> Q Exp
quoteExp [Char] -> Q Pat
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
notSupported [Char] -> Q Type
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
notSupported [Char] -> Q [Dec]
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
notSupported where
  notSupported :: p -> m a
notSupported p
_ = [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Quotation in this context is not supported"

{-|
An alias to `trimming` for backward-compatibility.
-}
text :: QuasiQuoter
text :: QuasiQuoter
text = QuasiQuoter
trimming

{-|
Trimmed quasiquoter variation.
Same as `untrimming`, but also
removes the leading and trailing whitespace.
-}
trimming :: QuasiQuoter
trimming :: QuasiQuoter
trimming = ([Char] -> Q Exp) -> QuasiQuoter
expQQ ([Char] -> Q Exp
quoteExp ([Char] -> Q Exp) -> ([Char] -> [Char]) -> [Char] -> Q Exp
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> [Char]
String.trim ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> [Char]
String.unindent ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> [Char]
String.tabsToSpaces)

{-|
Untrimmed quasiquoter variation.
Unindents the quoted template and converts tabs to spaces.
-}
untrimming :: QuasiQuoter
untrimming :: QuasiQuoter
untrimming = ([Char] -> Q Exp) -> QuasiQuoter
expQQ ([Char] -> Q Exp
quoteExp ([Char] -> Q Exp) -> ([Char] -> [Char]) -> [Char] -> Q Exp
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> [Char]
String.unindent ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> [Char]
String.tabsToSpaces)

indentQQPlaceholder :: Int -> Text -> Text
indentQQPlaceholder :: Int -> Text -> Text
indentQQPlaceholder Int
indent Text
text = case Text -> [Text]
Text.lines Text
text of
  Text
head:[Text]
tail -> Text -> [Text] -> Text
Text.intercalate (Char -> Text
Text.singleton Char
'\n') ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
               Text
head Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
Text.replicate Int
indent (Char -> Text
Text.singleton Char
' ') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
tail
  [] -> Text
text

quoteExp :: String -> Q Exp
quoteExp :: [Char] -> Q Exp
quoteExp [Char]
input =
  case [Char] -> Either ParseException [Line]
Parsing.parseLines [Char]
input of
    Left ParseException
e -> [Char] -> Q Exp
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ParseException -> [Char]
forall a. Show a => a -> [Char]
show ParseException
e
    Right [Line]
lines -> Q Exp -> Q Type -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Type -> m Exp
sigE (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|Text.intercalate (Text.singleton '\n')|] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Line -> Q Exp) -> [Line] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map Line -> Q Exp
lineExp [Line]
lines)
                        [t|Text|]

lineExp :: Parsing.Line -> Q Exp
lineExp :: Line -> Q Exp
lineExp (Parsing.Line Int
indent [LineContent]
contents) =
  case [LineContent]
contents of
    []  -> [| Text.empty |]
    [Item [LineContent]
x] -> LineContent -> Q Exp
toExp Item [LineContent]
LineContent
x
    [LineContent]
xs  -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|Text.concat|] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (LineContent -> Q Exp) -> [LineContent] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map LineContent -> Q Exp
toExp [LineContent]
xs
  where toExp :: LineContent -> Q Exp
toExp = Integer -> LineContent -> Q Exp
contentExp (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indent)

contentExp :: Integer -> Parsing.LineContent -> Q Exp
contentExp :: Integer -> LineContent -> Q Exp
contentExp Integer
_ (Parsing.LineContentText [Char]
text) = Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|Text.pack|] ([Char] -> Q Exp
forall (m :: * -> *). Quote m => [Char] -> m Exp
stringE [Char]
text)
contentExp Integer
indent (Parsing.LineContentIdentifier [Char]
name) = do
  Maybe Name
valueName <- [Char] -> Q (Maybe Name)
lookupValueName [Char]
name
  case Maybe Name
valueName of
    Just Name
valueName -> do
      Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
        (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'indentQQPlaceholder) (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
integerL Integer
indent)
        (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
valueName)
    Maybe Name
Nothing -> [Char] -> Q Exp
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Char]
"Value `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"` is not in scope"