git.iko.soy/streamly
on 106939a help sign in
streamly/core/src/Streamly/Internal/Unicode/String.hs
150 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 Control.Monad.Catch (MonadCatch)
39import Streamly.Internal.Data.Parser (Parser)
41import Language.Haskell.TH
42import Language.Haskell.TH.Quote
44import qualified Streamly.Data.Fold as Fold
45import qualified Streamly.Internal.Data.Parser as Parser
46 (some, many, takeWhile1)
47import qualified Streamly.Data.Stream as Stream (fromList, parse)
48import qualified Streamly.Internal.Unicode.Char.Parser as Parser
50-- $setup
51-- >>> :m
52-- >>> :set -package streamly
53-- >>> :set -XQuasiQuotes
54-- >>> import Streamly.Internal.Unicode.String
55--
56--------------------------------------------------------------------------------
57-- Parsing
58--------------------------------------------------------------------------------
60data StrSegment
61 = StrText String
62 | StrVar String
63 deriving (Show, Eq)
65haskellIdentifier :: MonadCatch m => Parser m Char String
66haskellIdentifier =
67 let p = Parser.alphaNum <|> Parser.char '\'' <|> Parser.char '_'
68 in Parser.some p Fold.toList
70strParser :: MonadCatch m => Parser m Char [StrSegment]
71strParser = Parser.many content Fold.toList
73 where
75 plainText = StrText <$> Parser.takeWhile1 (/= '#') Fold.toList
76 escHash = StrText . (: []) <$> (Parser.char '#' *> Parser.char '#')
77 lineCont = StrText [] <$ (Parser.char '#' *> Parser.char '\n')
78 var = StrVar <$>
79 ( Parser.char '#'
80 *> Parser.char '{'
81 *> haskellIdentifier
82 <* Parser.char '}'
83 )
84 plainHash = StrText . (: []) <$> Parser.char '#'
86 -- order is important
87 content = plainText <|> escHash <|> lineCont <|> var <|> plainHash
89strSegmentExp :: StrSegment -> Q Exp
90strSegmentExp (StrText text) = stringE text
91strSegmentExp (StrVar name) = do
92 valueName <- lookupValueName name
93 case valueName of
94 Just vn -> varE vn
95 Nothing ->
96 fail
97 $ "str quote: Haskell symbol `" ++ name
98 ++ "` is not in scope"
100strExp :: [StrSegment] -> Q Exp
101strExp xs = appE [| concat |] $ listE $ map strSegmentExp xs
103expandVars :: String -> Q Exp
104expandVars ln =
105 case Stream.parse strParser (Stream.fromList ln) of
106 Left _ -> fail "Parsing of str quoted string failed."
107 Right xs -> strExp xs
109-- | A QuasiQuoter that treats the input as a string literal:
110--
111-- >>> [str|x|]
112-- "x"
113--
114-- Any @#{symbol}@ is replaced by the value of the Haskell symbol @symbol@
115-- which is in scope:
116--
117-- >>> x = "hello"
118-- >>> [str|#{x} world!|]
119-- "hello world!"
120--
121-- @##@ means a literal @#@ without the special meaning for referencing
122-- haskell symbols:
123--
124-- >>> [str|##{x} world!|]
125-- "#{x} world!"
126--
127-- A @#@ at the end of line means the line continues to the next line without
128-- introducing a newline character:
129--
130-- >>> :{
131-- [str|hello#
132-- world!|]
133-- :}
134-- "hello world!"
135--
136-- Bugs: because of a bug in parsers, a lone # at the end of input gets
137-- removed.
138--
139str :: QuasiQuoter
140str =
141 QuasiQuoter
142 { quoteExp = expandVars
143 , quotePat = notSupported
144 , quoteType = notSupported
145 , quoteDec = notSupported
146 }
148 where
150 notSupported = error "str: Not supported."