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