@@ -0,0 +1,149 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+-- |
3+-- Module : Streamly.Internal.Unicode.String
4+-- Copyright : (c) 2022 Composewell Technologies
5+-- License : Apache-2.0
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+--
10+-- Convenient template Haskell quasiquoters to format strings.
11+
12+-- Design Notes:
13+--
14+-- Essential requirements are:
15+--
16+-- Haskell expression expansion
17+-- Newline treatment (continue without introducing a newline)
18+-- Indentation treatment
19+--
20+-- We choose #{expr} for patching a Haskell expression's value in a string. "$"
21+-- instead of "#" was another option (like in neat-interpolation package) but
22+-- we did not use that to avoid conflict with strings that are used as shell
23+-- commands. Another option was to use just "{}" (like in PyF package) but we
24+-- did not use that to avoid conflict with "${}" used in shell.
25+--
26+-- We use a "#" at the end of line to continue the line. We could use a "\"
27+-- as well but that may interfere with CPP.
28+--
29+-- Stripping is not part of the quasiquoter as it can be done by a Haskell
30+-- function. Other type of formatting on the Haskell expression can be done
31+-- using Haskell functions.
32+
33+module Streamly.Internal.Unicode.String
34+ ( str
35+ ) where
36+
37+import Control.Applicative (Alternative(..))
38+import Control.Monad.Catch (MonadCatch)
39+import Streamly.Internal.Data.Parser (Parser)
40+
41+import Language.Haskell.TH
42+import Language.Haskell.TH.Quote
43+
44+import qualified Streamly.Internal.Data.Fold as Fold
45+import qualified Streamly.Internal.Data.Parser as Parser
46+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
47+import qualified Streamly.Internal.Unicode.Char.Parser as Parser
48+
49+-- $setup
50+-- >>> :m
51+-- >>> :set -package streamly
52+-- >>> :set -XQuasiQuotes
53+-- >>> import Streamly.Internal.Unicode.String
54+--
55+--------------------------------------------------------------------------------
56+-- Parsing
57+--------------------------------------------------------------------------------
58+
59+data StrSegment
60+ = StrText String
61+ | StrVar String
62+ deriving (Show, Eq)
63+
64+haskellIdentifier :: MonadCatch m => Parser m Char String
65+haskellIdentifier =
66+ let p = Parser.alphaNum <|> Parser.char '\'' <|> Parser.char '_'
67+ in Parser.some p Fold.toList
68+
69+strParser :: MonadCatch m => Parser m Char [StrSegment]
70+strParser = Parser.many content Fold.toList
71+
72+ where
73+
74+ plainText = StrText <$> Parser.takeWhile1 (/= '#') Fold.toList
75+ escHash = StrText . (: []) <$> (Parser.char '#' *> Parser.char '#')
76+ lineCont = StrText [] <$ (Parser.char '#' *> Parser.char '\n')
77+ var = StrVar <$>
78+ ( Parser.char '#'
79+ *> Parser.char '{'
80+ *> haskellIdentifier
81+ <* Parser.char '}'
82+ )
83+ plainHash = StrText . (: []) <$> Parser.char '#'
84+
85+ -- order is important
86+ content = plainText <|> escHash <|> lineCont <|> var <|> plainHash
87+
88+strSegmentExp :: StrSegment -> Q Exp
89+strSegmentExp (StrText text) = stringE text
90+strSegmentExp (StrVar name) = do
91+ valueName <- lookupValueName name
92+ case valueName of
93+ Just vn -> varE vn
94+ Nothing ->
95+ fail
96+ $ "str quote: Haskell symbol `" ++ name
97+ ++ "` is not in scope"
98+
99+strExp :: [StrSegment] -> Q Exp
100+strExp xs = appE [| concat |] $ listE $ map strSegmentExp xs
101+
102+expandVars :: String -> Q Exp
103+expandVars ln =
104+ case Stream.parse strParser (Stream.fromList ln) of
105+ Left _ -> fail "Parsing of str quoted string failed."
106+ Right xs -> strExp xs
107+
108+-- | A QuasiQuoter that treats the input as a string literal:
109+--
110+-- >>> [str|x|]
111+-- "x"
112+--
113+-- Any @#{symbol}@ is replaced by the value of the Haskell symbol @symbol@
114+-- which is in scope:
115+--
116+-- >>> x = "hello"
117+-- >>> [str|#{x} world!|]
118+-- "hello world!"
119+--
120+-- @##@ means a literal @#@ without the special meaning for referencing
121+-- haskell symbols:
122+--
123+-- >>> [str|##{x} world!|]
124+-- "#{x} world!"
125+--
126+-- A @#@ at the end of line means the line continues to the next line without
127+-- introducing a newline character:
128+--
129+-- >>> :{
130+-- [str|hello#
131+-- world!|]
132+-- :}
133+-- "hello world!"
134+--
135+-- Bugs: because of a bug in parsers, a lone # at the end of input gets
136+-- removed.
137+--
138+str :: QuasiQuoter
139+str =
140+ QuasiQuoter
141+ { quoteExp = expandVars
142+ , quotePat = notSupported
143+ , quoteType = notSupported
144+ , quoteDec = notSupported
145+ }
146+
147+ where
148+
149+ notSupported = error "str: Not supported."