1{-|
2NeatInterpolation provides a quasiquoter for producing strings
3with a simple interpolation of input values.
4It removes the excessive indentation from the input and
5accurately manages the indentation of all lines of interpolated variables.
6But enough words, the code shows it better.
7
8Consider the following declaration:
9
10> {-# LANGUAGE QuasiQuotes #-}
11>
12> import NeatInterpolation
13> import Data.Text (Text)
14>
15> f :: Text -> Text -> Text
16> f a b =
17>   [trimming|
18>     function(){
19>       function(){
20>         $a
21>       }
22>       return $b
23>     }
24>   |]
25
26Executing the following:
27
28> main = Text.putStrLn $ f "1" "2"
29
30will produce this (notice the reduced indentation compared to how it was
31declared):
32
33> function(){
34>   function(){
35>     1
36>   }
37>   return 2
38> }
39
40Now let's test it with multiline string parameters:
41
42> main = Text.putStrLn $ f
43>   "{\n  indented line\n  indented line\n}"
44>   "{\n  indented line\n  indented line\n}"
45
46We get
47
48> function(){
49>   function(){
50>     {
51>       indented line
52>       indented line
53>     }
54>   }
55>   return {
56>     indented line
57>     indented line
58>   }
59> }
60
61See how it neatly preserved the indentation levels of lines the
62variable placeholders were at?
63
64If you need to separate variable placeholder from the following text to
65prevent treating the rest of line as variable name, use escaped variable:
66
67> f name = [trimming|this_could_be_${name}_long_identifier|]
68
69So
70
71> f "one" == "this_could_be_one_long_identifier"
72
73If you want to write something that looks like a variable but should be
74inserted as-is, escape it with another @$@:
75
76> f word = [trimming|$$my ${word} $${string}|]
77
78results in
79
80> f "funny" == "$my funny ${string}"
81-}
82module NeatInterpolation (trimming, untrimming, text) where
83
84import NeatInterpolation.Prelude
85import Language.Haskell.TH
86import Language.Haskell.TH.Quote hiding (quoteExp)
87import qualified Data.Text as Text
88import qualified NeatInterpolation.String as String
89import qualified NeatInterpolation.Parsing as Parsing
90
91
92expQQ quoteExp = QuasiQuoter quoteExp notSupported notSupported notSupported where
93  notSupported _ = fail "Quotation in this context is not supported"
94
95{-|
96An alias to `trimming` for backward-compatibility.
97-}
98text :: QuasiQuoter
99text = trimming
100
101{-|
102Trimmed quasiquoter variation.
103Same as `untrimming`, but also
104removes the leading and trailing whitespace.
105-}
106trimming :: QuasiQuoter
107trimming = expQQ (quoteExp . String.trim . String.unindent . String.tabsToSpaces)
108
109{-|
110Untrimmed quasiquoter variation.
111Unindents the quoted template and converts tabs to spaces.
112-}
113untrimming :: QuasiQuoter
114untrimming = expQQ (quoteExp . String.unindent . String.tabsToSpaces)
115
116indentQQPlaceholder :: Int -> Text -> Text
117indentQQPlaceholder indent text = case Text.lines text of
118  head:tail -> Text.intercalate (Text.singleton '\n') $
119               head : map (Text.replicate indent (Text.singleton ' ') <>) tail
120  [] -> text
121
122quoteExp :: String -> Q Exp
123quoteExp input =
124  case Parsing.parseLines input of
125    Left e -> fail $ show e
126    Right lines -> sigE (appE [|Text.intercalate (Text.singleton '\n')|] $ listE $ map lineExp lines)
127                        [t|Text|]
128
129lineExp :: Parsing.Line -> Q Exp
130lineExp (Parsing.Line indent contents) =
131  case contents of
132    []  -> [| Text.empty |]
133    [x] -> toExp x
134    xs  -> appE [|Text.concat|] $ listE $ map toExp xs
135  where toExp = contentExp (fromIntegral indent)
136
137contentExp :: Integer -> Parsing.LineContent -> Q Exp
138contentExp _ (Parsing.LineContentText text) = appE [|Text.pack|] (stringE text)
139contentExp indent (Parsing.LineContentIdentifier name) = do
140  valueName <- lookupValueName name
141  case valueName of
142    Just valueName -> do
143      appE
144        (appE (varE 'indentQQPlaceholder) $ litE $ integerL indent)
145        (varE valueName)
146    Nothing -> fail $ "Value `" ++ name ++ "` is not in scope"
147