on 2e4b883 help sign in
148 lines 4.4 kB history raw
1{-# LANGUAGE TemplateHaskell #-}
2-- |
3-- Module : Streamly.Internal.Unicode.String
4-- Copyright : (c) 2022 Composewell Technologies
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
8-- Portability : GHC
9--
10-- Convenient template Haskell quasiquoters to format strings.
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.
33module Streamly.Internal.Unicode.String
34 ( str
35 ) where
37import Control.Applicative (Alternative(..))
38import Streamly.Internal.Data.Parser (Parser)
40import Language.Haskell.TH
41import Language.Haskell.TH.Quote
43import qualified Streamly.Data.Fold as Fold
44import qualified Streamly.Internal.Data.Parser as Parser
45 (some, many, takeWhile1)
46import qualified Streamly.Data.Stream as Stream (fromList, parse)
47import qualified Streamly.Internal.Unicode.Char.Parser as Parser
49-- $setup
50-- >>> :m
51-- >>> :set -XQuasiQuotes
52-- >>> import Streamly.Internal.Unicode.String
53--
54--------------------------------------------------------------------------------
55-- Parsing
56--------------------------------------------------------------------------------
58data StrSegment
59 = StrText String
60 | StrVar String
61 deriving (Show, Eq)
63haskellIdentifier :: Monad m => Parser Char m String
64haskellIdentifier =
65 let p = Parser.alphaNum <|> Parser.char '\'' <|> Parser.char '_'
66 in Parser.some p Fold.toList
68strParser :: Monad m => Parser Char m [StrSegment]
69strParser = Parser.many content Fold.toList
71 where
73 plainText = StrText <$> Parser.takeWhile1 (/= '#') Fold.toList
74 escHash = StrText . (: []) <$> (Parser.char '#' *> Parser.char '#')
75 lineCont = StrText [] <$ (Parser.char '#' *> Parser.char '\n')
76 var = StrVar <$>
77 ( Parser.char '#'
78 *> Parser.char '{'
79 *> haskellIdentifier
80 <* Parser.char '}'
81 )
82 plainHash = StrText . (: []) <$> Parser.char '#'
84 -- order is important
85 content = plainText <|> escHash <|> lineCont <|> var <|> plainHash
87strSegmentExp :: StrSegment -> Q Exp
88strSegmentExp (StrText text) = stringE text
89strSegmentExp (StrVar name) = do
90 valueName <- lookupValueName name
91 case valueName of
92 Just vn -> varE vn
93 Nothing ->
94 fail
95 $ "str quote: Haskell symbol `" ++ name
96 ++ "` is not in scope"
98strExp :: [StrSegment] -> Q Exp
99strExp xs = appE [| concat |] $ listE $ map strSegmentExp xs
101expandVars :: String -> Q Exp
102expandVars ln =
103 case Stream.parse strParser (Stream.fromList ln) of
104 Left _ -> fail "Parsing of str quoted string failed."
105 Right xs -> strExp xs
107-- | A QuasiQuoter that treats the input as a string literal:
108--
109-- >>> [str|x|]
110-- "x"
111--
112-- Any @#{symbol}@ is replaced by the value of the Haskell symbol @symbol@
113-- which is in scope:
114--
115-- >>> x = "hello"
116-- >>> [str|#{x} world!|]
117-- "hello world!"
118--
119-- @##@ means a literal @#@ without the special meaning for referencing
120-- haskell symbols:
121--
122-- >>> [str|##{x} world!|]
123-- "#{x} world!"
124--
125-- A @#@ at the end of line means the line continues to the next line without
126-- introducing a newline character:
127--
128-- >>> :{
129-- [str|hello#
130-- world!|]
131-- :}
132-- "hello world!"
133--
134-- Bugs: because of a bug in parsers, a lone # at the end of input gets
135-- removed.
136--
137str :: QuasiQuoter
138str =
139 QuasiQuoter
140 { quoteExp = expandVars
141 , quotePat = notSupported
142 , quoteType = notSupported
143 , quoteDec = notSupported
144 }
146 where
148 notSupported = error "str: Not supported."