git.iko.soy/streamly
on 2aae2da help sign in
streamly/src/Streamly/Internal/Unicode/String.hs
149 lines 4.4 kB history raw
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.
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 Control.Monad.Catch (MonadCatch)
39import Streamly.Internal.Data.Parser (Parser)
41import Language.Haskell.TH
42import Language.Haskell.TH.Quote
44import qualified Streamly.Internal.Data.Fold as Fold
45import qualified Streamly.Internal.Data.Parser as Parser
46import qualified Streamly.Internal.Data.Stream.IsStream as Stream
47import qualified Streamly.Internal.Unicode.Char.Parser as Parser
49-- $setup
50-- >>> :m
51-- >>> :set -package streamly
52-- >>> :set -XQuasiQuotes
53-- >>> import Streamly.Internal.Unicode.String
54--
55--------------------------------------------------------------------------------
56-- Parsing
57--------------------------------------------------------------------------------
59data StrSegment
60 = StrText String
61 | StrVar String
62 deriving (Show, Eq)
64haskellIdentifier :: MonadCatch m => Parser m Char String
65haskellIdentifier =
66 let p = Parser.alphaNum <|> Parser.char '\'' <|> Parser.char '_'
67 in Parser.some p Fold.toList
69strParser :: MonadCatch m => Parser m Char [StrSegment]
70strParser = Parser.many content Fold.toList
72 where
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 '#'
85 -- order is important
86 content = plainText <|> escHash <|> lineCont <|> var <|> plainHash
88strSegmentExp :: StrSegment -> Q Exp
89strSegmentExp (StrText text) = stringE text
90strSegmentExp (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"
99strExp :: [StrSegment] -> Q Exp
100strExp xs = appE [| concat |] $ listE $ map strSegmentExp xs
102expandVars :: String -> Q Exp
103expandVars ln =
104 case Stream.parse strParser (Stream.fromList ln) of
105 Left _ -> fail "Parsing of str quoted string failed."
106 Right xs -> strExp xs
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--
138str :: QuasiQuoter
139str =
140 QuasiQuoter
141 { quoteExp = expandVars
142 , quotePat = notSupported
143 , quoteType = notSupported
144 , quoteDec = notSupported
145 }
147 where
149 notSupported = error "str: Not supported."