{-|
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 :: (String -> Q Exp) -> QuasiQuoter
expQQ String -> Q Exp
quoteExp = (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter String -> Q Exp
quoteExp String -> Q Pat
forall (m :: * -> *) p a. MonadFail m => p -> m a
notSupported String -> Q Type
forall (m :: * -> *) p a. MonadFail m => p -> m a
notSupported String -> Q [Dec]
forall (m :: * -> *) p a. MonadFail m => p -> m a
notSupported where
  notSupported :: p -> m a
notSupported p
_ = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 = (String -> Q Exp) -> QuasiQuoter
expQQ (String -> Q Exp
quoteExp (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
String.trim (String -> String) -> (String -> String) -> String -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
String.unindent (String -> String) -> (String -> String) -> String -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
String.tabsToSpaces)

{-|
Untrimmed quasiquoter variation.
Unindents the quoted template and converts tabs to spaces.
-}
untrimming :: QuasiQuoter
untrimming :: QuasiQuoter
untrimming = (String -> Q Exp) -> QuasiQuoter
expQQ (String -> Q Exp
quoteExp (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
String.unindent (String -> String) -> (String -> String) -> String -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String
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 :: String -> Q Exp
quoteExp String
input =
  case String -> Either ParseException [Line]
Parsing.parseLines String
input of
    Left ParseException
e -> 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
$ ParseException -> String
forall a. Show a => a -> String
show ParseException
e
    Right [Line]
lines -> Q Exp -> Q Type -> Q Exp
sigE (Q Exp -> Q Exp -> Q 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
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
appE [|Text.concat|] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q 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 String
text) = Q Exp -> Q Exp -> Q Exp
appE [|Text.pack|] (String -> Q Exp
stringE String
text)
contentExp Integer
indent (Parsing.LineContentIdentifier String
name) = do
  Maybe Name
valueName <- String -> Q (Maybe Name)
lookupValueName String
name
  case Maybe Name
valueName of
    Just Name
valueName -> do
      Q Exp -> Q Exp -> Q Exp
appE
        (Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'indentQQPlaceholder) (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Q Exp
litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
integerL Integer
indent)
        (Name -> Q Exp
varE Name
valueName)
    Maybe Name
Nothing -> 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
"Value `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"` is not in scope"