-- |
-- 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 qualified Data.Text as Text
import Language.Haskell.TH
import Language.Haskell.TH.Quote hiding (quoteExp)
import qualified NeatInterpolation.Parsing as Parsing
import NeatInterpolation.Prelude
import qualified NeatInterpolation.String as String

expQQ :: (String -> Q Exp) -> QuasiQuoter
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 forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
notSupported forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
notSupported forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
notSupported
  where
    notSupported :: p -> m a
notSupported p
_ = 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 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 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 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 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 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') forall a b. (a -> b) -> a -> b
$
      Text
head forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
Text.replicate Int
indent (Char -> Text
Text.singleton Char
' ') 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 -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show ParseException
e
    Right [Line]
lines ->
      forall (m :: * -> *). Quote m => m Exp -> m Type -> m Exp
sigE
        (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|Text.intercalate (Text.singleton '\n')|] forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE forall a b. (a -> b) -> a -> b
$ 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]
x
    [LineContent]
xs -> forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|Text.concat|] forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE forall a b. (a -> b) -> a -> b
$ 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 (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) = forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [|Text.pack|] (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
      forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
        (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall (m :: * -> *). Quote m => Name -> m Exp
varE 'indentQQPlaceholder) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Lit -> m Exp
litE forall a b. (a -> b) -> a -> b
$ Integer -> Lit
integerL Integer
indent)
        (forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
valueName)
    Maybe Name
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Value `" forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
"` is not in scope"