@@ -13,6 +13,7 @@
1313--
1414-----------------------------------------------------------------------------
1515{-# LANGUAGE PatternGuards #-}
16+{-# LANGUAGE OverloadedStrings #-}
1617{-# LANGUAGE CPP #-}
1718
1819module Language.PureScript.Pretty.Cpp
@@ -23,165 +24,158 @@ module Language.PureScript.Pretty.Cpp
2324
2425import Prelude.Compat
2526
26−import Data.Bits
2727import Data.Char
28−import Data.List
29−import Data.Maybe (catMaybes, fromMaybe)
28+import Data.Maybe (fromMaybe)
29+import Data.Text (Text)
30+import qualified Data.Text as T
31+import Data.Monoid ((<>))
32+
3033#if __GLASGOW_HASKELL__ < 710
3134import Control.Applicative
3235#endif
3336import Control.Arrow ((<+>))
3437import qualified Control.Arrow as A
3538import Control.Monad.State
39+import Numeric (showHex)
3640import Control.PatternArrows
3741
3842import Language.PureScript.CodeGen.Cpp.AST
3943import Language.PureScript.CodeGen.Cpp.Types
4044import Language.PureScript.Comments
4145import qualified Language.PureScript.Constants as C
42−import Numeric
43−import Text.Printf (printf)
44−
45−-- import Debug.Trace
46−---------------------------------------------------------------------------------------------------
47−-- TODO: Go back to using Pretty.Common? (will require some work)
48−--
49−newtype PrinterState = PrinterState
50− { indent :: Int
51− } deriving (Show, Read, Eq, Ord)
52−
53−-- |
54−-- Pretty print with a new indentation level
55−--
56−withIndent :: StateT PrinterState Maybe String -> StateT PrinterState Maybe String
57−withIndent action = do
58− modify $ \st -> st { indent = indent st + blockIndent }
59− result <- action
60− modify $ \st -> st { indent = indent st - blockIndent }
61− return result
46+import Language.PureScript.Pretty.Common (PrinterState(..), intercalate, parensT)
6247
6348-- |
6449-- Get the current indentation level
6550--
66−currentIndent :: StateT PrinterState Maybe String
51+currentIndent :: StateT PrinterState Maybe Text
6752currentIndent = do
6853 current <- get
69− return $ replicate (indent current) ' '
54+ return $ T.replicate (indent current) " "
7055
7156blockIndent :: Int
7257blockIndent = 2
7358
7459-- |
75−-- Wrap a string in parentheses
60+-- Pretty print with a new indentation level
7661--
77−parens :: String -> String
78−parens s = '(' : s ++ ")"
62+withIndent :: StateT PrinterState Maybe Text -> StateT PrinterState Maybe Text
63+withIndent action = do
64+ modify $ \st -> st { indent = indent st + blockIndent }
65+ result <- action
66+ modify $ \st -> st { indent = indent st - blockIndent }
67+ return result
7968
69+show' :: Show a => a -> Text
70+show' = T.pack . show
71+
72+---------------------------------------------------------------------------------------------------
73+literals :: Pattern PrinterState Cpp Text
8074---------------------------------------------------------------------------------------------------
81−literals :: Pattern PrinterState Cpp String
8275literals = mkPattern' match
8376 where
84− match :: Cpp -> StateT PrinterState Maybe String
85− match CppNoOp = return []
86− match CppEndOfHeader = return []
87− match (CppNumericLiteral (Left n)) = return $ show n
88− match (CppNumericLiteral n) = return $ either show show n
77+ match :: Cpp -> StateT PrinterState Maybe Text
78+ match CppNoOp = return ""
79+ match CppEndOfHeader = return ""
80+ match (CppNumericLiteral (Left n)) = return $ show' n
81+ match (CppNumericLiteral n) = return $ either show' show' n
8982 match (CppStringLiteral s)
90− | all isAscii s = return $ string s
91− match (CppStringLiteral s) = return $ "u8" ++ string s
92− match (CppCharLiteral c) = return $ show c
83+ | T.all isAscii s = return $ string s
84+ match (CppStringLiteral s) = return $ "u8" <> string s
85+ match (CppCharLiteral c) = return $ "'" <> T.singleton c <> "'"
9386 match (CppBooleanLiteral True) = return "true"
9487 match (CppBooleanLiteral False) = return "false"
9588 match (CppArrayLiteral [x@CppArrayLiteral {}]) = -- Works around what appears to be a recent clang bug
96− fmap concat $ sequence
89+ mconcat <$> sequence
9790 [ return $ runType arrayType
9891 , return "{ { "
9992 , prettyPrintCpp' x
10093 , return " } }"
10194 ]
102− match (CppArrayLiteral xs) = fmap concat $ sequence
95+ match (CppArrayLiteral xs) = mconcat <$> sequence
10396 [ return $ runType arrayType
10497 , return "{ "
105− , fmap (intercalate ", ") $ forM xs prettyPrintCpp'
98+ , fmap (T.intercalate ", ") $ forM xs prettyPrintCpp'
10699 , return " }"
107100 ]
108− match (CppDataLiteral xs) = fmap concat $ sequence
101+ match (CppDataLiteral xs) = mconcat <$> sequence
109102 [ return $ runType (dataType $ length xs)
110103 , return "{ "
111− , fmap (intercalate ", ") $ forM xs prettyPrintCpp'
104+ , fmap (T.intercalate ", ") $ forM xs prettyPrintCpp'
112105 , return " }"
113106 ]
114− match (CppEnum name ty es) = fmap concat $ sequence
107+ match (CppEnum name ty es) = mconcat <$> sequence
115108 [ return "enum"
116− , return $ maybe "" (" " ++) name
117− , return $ maybe "" ((" : " ++) . runType) ty
109+ , return $ maybe "" (" " <>) name
110+ , return $ maybe "" ((" : " <>) . runType) ty
118111 , return " { "
119− , return $ intercalate ", " es
112+ , return $ T.intercalate ", " es
120113 , return " }"
121114 ]
122− match (CppMapLiteral _ ps) = fmap concat $ sequence
123− [ return $ runType (mapType $ length ps + 1) ++ "{{\n"
115+ match (CppMapLiteral _ ps) = mconcat <$> sequence
116+ [ return $ runType (mapType $ length ps + 1) <> "{{\n"
124117 , withIndent $ do
125118 cpps <-
126119 forM ps $ \(key, value) -> do
127120 value' <- prettyPrintCpp' value
128121 key' <- prettyPrintCpp' key
129− return $ "{ " ++ key' ++ ", " ++ value' ++ " }"
122+ return $ "{ " <> key' <> ", " <> value' <> " }"
130123 indentString <- currentIndent
131− return $ intercalate ", \n" $ map (indentString ++) (cpps ++ ["{ nullptr, nullptr }"])
124+ return $ T.intercalate ", \n" $ map (indentString <>) (cpps ++ ["{ nullptr, nullptr }"])
132125 , return "\n"
133126 , currentIndent
134127 , return "}}"
135128 ]
136− match (CppFunction name args rty qs ret) =
137− fmap concat $ sequence
138− [ return . concatMap (++ " ") . filter (not . null) $ runValueQual <$> qs
129+ match (CppFunction name args rty qs ret) = mconcat <$> sequence
130+ [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs
139131 , return "auto "
140132 , return name
141− , return $ parens (intercalate ", " $ argstr <$> args)
142− , return (maybe "" ((" -> " ++) . runType) rty)
133+ , return $ parensT (T.intercalate ", " $ argstr <$> args)
134+ , return (maybe "" ((" -> " <>) . runType) rty)
143135 , if ret /= CppNoOp
144136 then do
145137 cpps <- prettyPrintCpp' ret
146− return $ ' ' : cpps
138+ return $ ' ' `T.cons` cpps
147139 else return ""
148140 ]
149− match (CppBlock sts) = concat <$> sequence
141+ match (CppBlock sts) = mconcat <$> sequence
150142 [ return "{\n"
151143 , withIndent $ prettyStatements sts
152144 , return $ if null sts then "" else "\n"
153145 , currentIndent
154146 , return "}"
155147 ]
156− match (CppNamespace _ []) = return []
157− match (CppNamespace [] sts) = fmap concat $ sequence $
148+ match (CppNamespace _ []) = return ""
149+ match (CppNamespace name sts) | T.null name = mconcat <$> sequence
158150 [ return "\n"
159151 , prettyStatements sts
160152 , return "#"
161153 ]
162− match (CppNamespace (':':':':name) sts) = fmap concat $ sequence $
154+ match (CppNamespace name sts)
155+ | Just name' <- T.stripPrefix "::" name = mconcat <$> sequence
163156 [ return "\n"
164157 , currentIndent
165− , return $ "namespace " ++ (dotsTo '_' name) ++ " {\n"
158+ , return $ "namespace " <> (dotsTo '_' name') <> " {\n"
166159 , withIndent $ prettyStatements sts
167160 , return "\n"
168161 , currentIndent
169162 , return "}#"
170163 ]
171− match (CppNamespace name sts) = fmap concat $ sequence $
164+ match (CppNamespace name sts) = mconcat <$> sequence (
172165 [ return "\n"
173166 , currentIndent
174− , return $ "namespace " ++ (dotsTo '_' name) ++ " {\n"
167+ , return $ "namespace " <> (dotsTo '_' name) <> " {\n"
175168 , withIndent $ prettyStatements sts'
176169 , return "\n"
177170 , currentIndent
178171 , return "}#"
179− ] ++
172+ ] <>
180173 let (cpp', cpps') = fromNested nested'
181174 in map match cpp' ++
182175 if null cpps'
183176 then []
184− else [match (CppNamespace name (filter isUseNamespace sts ++ cpps'))]
177+ else [match (CppNamespace name (filter isUseNamespace sts <> cpps'))]
178+ )
185179 where
186180 (sts', nested') = break isNestedNamespace sts
187181 fromNested :: [Cpp] -> ([Cpp], [Cpp])
@@ -201,11 +195,11 @@ literals = mkPattern' match
201195 isUseNamespace :: Cpp -> Bool
202196 isUseNamespace (CppUseNamespace {}) = True
203197 isUseNamespace _ = False
204− match (CppStruct (name) []) = return $ "struct " ++ name ++ " {}"
205− match (CppStruct (name) mems) = fmap concat $ sequence $
198+ match (CppStruct (name) []) = return $ "struct " <> name <> " {}"
199+ match (CppStruct (name) mems) = mconcat <$> sequence
206200 [ return "\n"
207201 , currentIndent
208− , return $ "struct " ++ name ++ " {\n"
202+ , return $ "struct " <> name <> " {\n"
209203 , withIndent $ prettyStatements mems
210204 , return "\n"
211205 , currentIndent
@@ -213,60 +207,60 @@ literals = mkPattern' match
213207 ]
214208 match (CppInclude path name) =
215209 let fullpath
216− | null path = last . words . dotsTo ' ' $ name
217− | otherwise = path ++ '/' : (last . words . dotsTo ' ' $ name) in
218− fmap concat $ sequence
219− [ return $ "#include \"" ++ fullpath ++ ".hh\""
210+ | T.null path = last . T.words . dotsTo ' ' $ name
211+ | otherwise = path <> "/" <> (last . T.words . dotsTo ' ' $ name) in
212+ mconcat <$> sequence
213+ [ return $ "#include \"" <> fullpath <> ".hh\""
220214 ]
221− match (CppUseNamespace name) = fmap concat $ sequence
222− [ return $ "using namespace " ++ (dotsTo '_' name)
215+ match (CppUseNamespace name) = mconcat <$> sequence
216+ [ return $ "using namespace " <> (dotsTo '_' name)
223217 ]
224218 match (CppTypeAlias (newName, newTyps) typ spec) =
225219 let typ' = runType typ
226220 (tmps, name') = if null newTyps
227221 then ([], typ')
228222 else ([return (templDecl newTyps), return "\n", currentIndent], typ')
229− in fmap concat $ sequence $
223+ in mconcat <$> sequence (
230224 tmps ++
231− [ return $ "using "
225+ [ return "using "
232226 , return newName
233227 , return " = "
234− , return $ if null spec then name' else spec ++ angles name'
235− ]
228+ , return $ if T.null spec then name' else spec <> angles name'
229+ ])
236230 match (CppCast typ val) = return $
237231 case val of
238232 CppNumericLiteral {} -> vstr
239233 CppStringLiteral {} -> vstr
240234 CppBooleanLiteral {} -> vstr
241− _ -> "cast" ++ angles (runType typ) ++ parens val'
235+ _ -> "cast" <> angles (runType typ) <> parensT val'
242236 where
243237 vstr = prettyPrintCpp1 val
244− val' | '(' `elem` vstr || '[' `elem` vstr = parens vstr
238+ val' | "(" `T.isInfixOf` vstr || "[" `T.isInfixOf` vstr = parensT vstr
245239 | otherwise = vstr
246240 match (CppGet i@(CppSymbol _) val) =
247− return $ printf "get(%s, %s)" (prettyPrintCpp1 i) (prettyPrintCpp1 val)
241+ return . prettyPrintCpp1 $ CppApp (CppVar "get") [i, val]
248242 match (CppGet i val) =
249− return $ printf "get<%s>(%s)" (prettyPrintCpp1 i) (prettyPrintCpp1 val)
243+ return . prettyPrintCpp1 $ CppApp (CppVar $ "get" <> angles (prettyPrintCpp1 i)) [val]
250244 match (CppVar ident)
251− | ident == C.__unused = match (CppVar $ '$' : ident)
245+ | ident == C.__unused = match (CppVar $ '$' `T.cons` ident)
252246 match (CppVar ident) = return ident
253− match (CppSymbol ident) = return $ "SYMBOL" ++ parens (symbolname ident)
247+ match (CppSymbol ident) = return $ "SYMBOL" <> parensT (symbolname ident)
254248 match (CppApp v [CppNoOp]) = return (prettyPrintCpp1 v)
255249 match (CppVariableIntroduction (ident, typ) qs value)
256− | ident == C.__unused = match (CppVariableIntroduction ('$' : ident, typ) qs value)
250+ | ident == C.__unused = match (CppVariableIntroduction ('$' `T.cons` ident, typ) qs value)
257251 match (CppVariableIntroduction (ident, typ) qs value) =
258− fmap concat $ sequence
259− [ return . concatMap (++ " ") . filter (not . null) $ runValueQual <$> qs
260− , return $ runType (fromMaybe (Any [Const]) typ) ++ " "
252+ mconcat <$> sequence
253+ [ return . T.concat . fmap (<> " ") . filter (not . T.null) $ runValueQual <$> qs
254+ , return $ runType (fromMaybe (Any [Const]) typ) <> " "
261255 , return ident
262− , maybe (return "") (fmap (" = " ++) . prettyPrintCpp') value
256+ , maybe (return "") (fmap (" = " <>) . prettyPrintCpp') value
263257 ]
264− match (CppAssignment target value) = fmap concat $ sequence
258+ match (CppAssignment target value) = mconcat <$> sequence
265259 [ prettyPrintCpp' target
266260 , return " = "
267261 , prettyPrintCpp' value
268262 ]
269− match (CppWhile cond sts) = fmap concat $ sequence
263+ match (CppWhile cond sts) = mconcat <$> sequence
270264 [ return "while ("
271265 , prettyPrintCpp' cond
272266 , return ") "
@@ -276,24 +270,24 @@ literals = mkPattern' match
276270 sts' | CppBlock cpps'@(_:_) <- sts,
277271 last cpps' == CppContinue = CppBlock (init cpps')
278272 | otherwise = sts
279− match (CppIfElse cond thens elses) = fmap concat $ sequence
273+ match (CppIfElse cond thens elses) = mconcat <$> sequence
280274 [ return "if ("
281275 , prettyPrintCpp' cond
282276 , return ") "
283277 , prettyPrintCpp' thens
284− , maybe (return "") (fmap (" else " ++) . prettyPrintCpp') elses
278+ , maybe (return "") (fmap (" else " <>) . prettyPrintCpp') elses
285279 ]
286− match (CppSwitch cond cases@((case1,_):_:_)) = fmap concat $ sequence
280+ match (CppSwitch cond cases@((case1,_):_:_)) = mconcat <$> sequence
287281 [ return "switch "
288− , return . parens $ prettyPrintCpp1 (cast case1 cond)
282+ , return . parensT $ prettyPrintCpp1 (cast case1 cond)
289283 , return " {\n"
290284 , withIndent $ do
291285 cpps <- forM cases $ \(c, s) -> do
292286 c' <- prettyPrintCpp' c
293287 s' <- prettyPrintCpp' s
294− return $ "case " ++ c' ++ ": " ++ s' ++ ";"
288+ return $ "case " <> c' <> ": " <> s' <> ";"
295289 indentString <- currentIndent
296− return $ intercalate "\n" $ map (indentString ++) cpps
290+ return $ T.intercalate "\n" $ map (indentString <>) cpps
297291 , return "\n"
298292 , currentIndent
299293 , return "}"
@@ -304,71 +298,63 @@ literals = mkPattern' match
304298 cast CppBooleanLiteral {} cpp' = CppCast boolType cpp'
305299 cast CppCharLiteral {} cpp' = CppCast charType cpp'
306300 cast _ cpp' = cpp'
307− match (CppReturn (CppBlock (cpp:cpps))) = fmap concat $ sequence
301+ match (CppReturn (CppBlock (cpp:cpps))) = mconcat <$> sequence
308302 [ do s <- prettyPrintCpp' cpp
309− return $ dropWhile isSpace s
303+ return $ T.dropWhile isSpace s
310304 , return $ if null cpps then "" else "\n"
311305 , prettyStatements cpps
312306 ]
313− match (CppReturn value@(CppStringLiteral _)) = fmap concat $ sequence
307+ match (CppReturn value@(CppStringLiteral _)) = mconcat <$> sequence
314308 [ return "return "
315309 , return . runType $ Any []
316310 , return "("
317311 , prettyPrintCpp' value
318312 , return ")"
319313 ]
320− match (CppReturn value) = fmap concat $ sequence
314+ match (CppReturn value) = mconcat <$> sequence
321315 [ return "return "
322316 , prettyPrintCpp' value
323317 ]
324− match (CppThrow value) = fmap concat $ sequence
318+ match (CppThrow value) = mconcat <$> sequence
325319 [ return "throw "
326320 , prettyPrintCpp' value
327321 ]
328322 match CppContinue = return "continue"
329323 match (CppComment [] cpp) = match cpp
330− match (CppComment com cpp) = fmap concat $ sequence $
331− [ return "\n"
324+ match (CppComment com cpp) = mconcat <$> sequence
325+ ([ return "\n"
332326 , currentIndent
333327 , return "/**\n"
334− ] ++
335− map asLine (concatMap commentLines com) ++
328+ ] <>
329+ map asLine (concat $ commentLines <$> com) ++
336330 [ currentIndent
337331 , return " */\n"
338332 , currentIndent
339333 , prettyPrintCpp' cpp
340− ]
334+ ])
341335 where
342− commentLines :: Comment -> [String]
336+ commentLines :: Comment -> [Text]
343337 commentLines (LineComment s) = [s]
344− commentLines (BlockComment s) = lines s
345− asLine :: String -> StateT PrinterState Maybe String
338+ commentLines (BlockComment s) = T.lines s
339+ asLine :: Text -> StateT PrinterState Maybe Text
346340 asLine s = do
347341 i <- currentIndent
348− return $ i ++ " * " ++ removeComments s ++ "\n"
349− removeComments :: String -> String
350− removeComments ('*':'/':s) = removeComments s
351− removeComments (c:s) = c : removeComments s
352− removeComments [] = []
342+ return $ i <> " * " <> removeComments s <> "\n"
343+
344+ removeComments :: Text -> Text
345+ removeComments t =
346+ case T.stripPrefix "*/" t of
347+ Just rest -> removeComments rest
348+ Nothing -> case T.uncons t of
349+ Just (x, xs) -> x `T.cons` removeComments xs
350+ Nothing -> ""
353351 match (CppRaw cpp) = return cpp
354352 match _ = mzero
355353
356−string :: String -> String
357−string s = '"' : concatMap encodeChar (decodeSurrogates s) ++ "\""
354+string :: Text -> Text
355+string s = "\"" <> T.concatMap encodeChar s <> "\""
358356 where
359− decodeSurrogates :: String -> String
360− decodeSurrogates [c] = [c]
361− decodeSurrogates s' = catMaybes $ zipWith decodePair s' (tail s' ++ ['\0'])
362− where
363− decodePair :: Char -> Char -> Maybe Char
364− decodePair a b
365− | fromEnum a >= 0xD800 && fromEnum a <= 0xDFFF &&
366− fromEnum b >= 0xD800 && fromEnum b <= 0xDFFF
367− = Just . chr $ 0x10000 + shiftL (fromEnum a .&. 0x03FF) 10 + (fromEnum b .&. 0x03FF)
368− decodePair a _
369− | fromEnum a >= 0xD800 && fromEnum a <= 0xDFFF = Nothing
370− decodePair a _ = Just a
371− encodeChar :: Char -> String
357+ encodeChar :: Char -> Text
372358 encodeChar '\b' = "\\b"
373359 encodeChar '\t' = "\\t"
374360 encodeChar '\n' = "\\n"
@@ -377,73 +363,69 @@ string s = '"' : concatMap encodeChar (decodeSurrogates s) ++ "\""
377363 encodeChar '\r' = "\\r"
378364 encodeChar '"' = "\\\""
379365 encodeChar '\\' = "\\\\"
380− encodeChar c
381− | fromEnum c > 0xFFFF = "\\U" ++ leading ++ hex
382− where
383− hex = showHex (fromEnum c) ""
384− leading = replicate (8 - length hex) '0'
385− encodeChar c
386− | fromEnum c > 0xFFF = "\\u" ++ showHex (fromEnum c) ""
387− encodeChar c
388− | fromEnum c > 0xFF = "\\u0" ++ showHex (fromEnum c) ""
389− encodeChar c
390− | fromEnum c < 0x10 = "\\x0" ++ showHex (fromEnum c) ""
391− encodeChar c
392− | fromEnum c > 0x7E || fromEnum c < 0x20 = "\\x" ++ showHex (fromEnum c) ""
393− encodeChar c = [c]
394−
395−accessor :: Pattern PrinterState Cpp (String, Cpp)
366+ -- PureScript strings are sequences of UTF-16 code units, so this case should never be hit.
367+ -- If it is somehow hit, though, output the designated Unicode replacement character U+FFFD.
368+ encodeChar c | fromEnum c > 0xFFFF = "\\uFFFD"
369+ encodeChar c | fromEnum c > 0xFFF = "\\u" <> showHex' (fromEnum c) ""
370+ encodeChar c | fromEnum c > 0xFF = "\\u0" <> showHex' (fromEnum c) ""
371+ encodeChar c | fromEnum c < 0x10 = "\\x0" <> showHex' (fromEnum c) ""
372+ encodeChar c | fromEnum c > 0x7E || fromEnum c < 0x20 = "\\x" <> showHex' (fromEnum c) ""
373+ encodeChar c = T.singleton c
374+
375+ showHex' a b = T.pack (showHex a b)
376+
377+accessor :: Pattern PrinterState Cpp (Text, Cpp)
396378accessor = mkPattern match
397379 where
398380 match (CppAccessor prop val) = Just (prettyPrintCpp1 prop, val)
399381 match _ = Nothing
400382
401−indexer :: Pattern PrinterState Cpp (String, Cpp)
383+indexer :: Pattern PrinterState Cpp (Text, Cpp)
402384indexer = mkPattern' match
403385 where
404386 match (CppIndexer (CppNumericLiteral (Left 0)) val) = return ("0UL", val)
405− match (CppIndexer (CppNumericLiteral (Left index)) val) = return (show index, val)
387+ match (CppIndexer (CppNumericLiteral (Left index)) val) = return (show' index, val)
406388 match (CppIndexer index val) = do
407389 index' <- prettyPrintCpp' index
408390 return (index', val)
409391 match _ = mzero
410392
411−lam :: Pattern PrinterState Cpp ((String, [(String, Maybe CppType)], Maybe CppType), Cpp)
393+lam :: Pattern PrinterState Cpp ((Text, [(Text, Maybe CppType)], Maybe CppType), Cpp)
412394lam = mkPattern match
413395 where
414− match (CppLambda caps args rty ret) = Just ((concatMap runCaptureType caps, args, rty), ret)
396+ match (CppLambda caps args rty ret) = Just ((T.concat $ runCaptureType <$> caps, args, rty), ret)
415397 match _ = Nothing
416398
417−app :: Pattern PrinterState Cpp (String, Cpp)
399+app :: Pattern PrinterState Cpp (Text, Cpp)
418400app = mkPattern' match
419401 where
420402 match (CppApp _ [CppNoOp]) = mzero
421403 match (CppApp val args) = do
422404 cpps <- mapM prettyPrintCpp' args
423− return (intercalate ", " cpps, val)
405+ return (T.intercalate ", " cpps, val)
424406 match _ = mzero
425407
426−unary' :: UnaryOperator -> (Cpp -> String) -> Operator PrinterState Cpp String
427−unary' op mkStr = Wrap match (++)
408+unary' :: UnaryOperator -> (Cpp -> Text) -> Operator PrinterState Cpp Text
409+unary' op mkStr = Wrap match (<>)
428410 where
429− match :: Pattern PrinterState Cpp (String, Cpp)
411+ match :: Pattern PrinterState Cpp (Text, Cpp)
430412 match = mkPattern match'
431413 where
432414 match' (CppUnary op' val)
433415 | op' == op = Just (mkStr val, val)
434416 match' _ = Nothing
435417
436−unary :: UnaryOperator -> String -> Operator PrinterState Cpp String
418+unary :: UnaryOperator -> Text -> Operator PrinterState Cpp Text
437419unary op str = unary' op (const str)
438420
439−negateOperator :: Operator PrinterState Cpp String
421+negateOperator :: Operator PrinterState Cpp Text
440422negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")
441423 where
442424 isNegate (CppUnary Negate _) = True
443425 isNegate _ = False
444426
445−binary :: BinaryOperator -> String -> Operator PrinterState Cpp String
446−binary op str = AssocL match (\v1 v2 -> v1 ++ str ++ v2)
427+binary :: BinaryOperator -> Text -> Operator PrinterState Cpp Text
428+binary op str = AssocL match (\v1 v2 -> v1 <> str <> v2)
447429 where
448430 match :: Pattern PrinterState Cpp (Cpp, Cpp)
449431 match = mkPattern match'
@@ -454,53 +436,54 @@ binary op str = AssocL match (\v1 v2 -> v1 ++ str ++ v2)
454436 | op' == op = Just (v1, v2)
455437 match' _ = Nothing
456438
457−prettyStatements :: [Cpp] -> StateT PrinterState Maybe String
439+prettyStatements :: [Cpp] -> StateT PrinterState Maybe Text
458440prettyStatements sts = do
459441 cpps <- forM (filter (not . isNoOp) sts) prettyPrintCpp'
460442 indentString <- currentIndent
461− return $ intercalate "\n" $ map (addsemi . (indentString ++)) cpps
443+ return $ T.intercalate "\n" $ map (addsemi . (indentString <>)) cpps
462444 where
463− addsemi :: String -> String
464− addsemi [] = []
445+ addsemi :: Text -> Text
446+ addsemi s | T.null s = s
447+ addsemi s
448+ | T.all isSpace s = ""
465449 addsemi s
466− | all isSpace s = []
467− addsemi s@('#':_) = s
450+ | T.head s == '#' = s
468451 addsemi s
469− | last s == '#' = init s
470− addsemi s = s ++ ";"
452+ | T.last s == '#' = T.init s
453+ addsemi s = s <> ";"
471454
472455-- |
473456-- Generate a pretty-printed string representing a C++11 expression
474457--
475−prettyPrintCpp1 :: Cpp -> String
458+prettyPrintCpp1 :: Cpp -> Text
476459prettyPrintCpp1 = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyPrintCpp'
477460
478461-- |
479462-- Generate a pretty-printed string representing a collection of C++11 expressions at the same indentation level
480463--
481−prettyPrintCpp :: [Cpp] -> String
464+prettyPrintCpp :: [Cpp] -> Text
482465prettyPrintCpp = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyStatements
483466
484467-- |
485468-- Generate an indented, pretty-printed string representing a C++11 expression
486469--
487−prettyPrintCpp' :: Cpp -> StateT PrinterState Maybe String
470+prettyPrintCpp' :: Cpp -> StateT PrinterState Maybe Text
488471prettyPrintCpp' = A.runKleisli $ runPattern matchValue
489472 where
490− matchValue :: Pattern PrinterState Cpp String
491− matchValue = buildPrettyPrinter operators (literals <+> fmap parens matchValue)
492− operators :: OperatorTable PrinterState Cpp String
473+ matchValue :: Pattern PrinterState Cpp Text
474+ matchValue = buildPrettyPrinter operators (literals <+> fmap parensT matchValue)
475+ operators :: OperatorTable PrinterState Cpp Text
493476 operators =
494− OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "::" ++ prop ]
495− , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]
496− , [ Wrap app $ \args val -> val ++ parens args ]
477+ OperatorTable [ [ Wrap accessor $ \prop val -> val <> "::" <> prop ]
478+ , [ Wrap indexer $ \index val -> val <> "[" <> index <> "]" ]
479+ , [ Wrap app $ \args val -> val <> parensT args ]
497480 , [ unary New "new " ]
498− , [ Wrap lam $ \(caps, args, rty) ret -> '[' : caps ++ "]"
499− ++ let args' = argstr <$> args in
500− parens (intercalate ", " args')
501− ++ maybe "" ((" -> " ++) . runType) rty
502− ++ " "
503− ++ ret ]
481+ , [ Wrap lam $ \(caps, args, rty) ret -> '[' `T.cons` caps <> "]"
482+ <> let args' = argstr <$> args in
483+ parensT (T.intercalate ", " args')
484+ <> maybe "" ((" -> " <>) . runType) rty
485+ <> " "
486+ <> ret ]
504487 , [ unary Not "!"
505488 , unary BitwiseNot "~"
506489 , unary Positive "+"
@@ -526,35 +509,35 @@ prettyPrintCpp' = A.runKleisli $ runPattern matchValue
526509 , [ binary Or " || " ]
527510 ]
528511
529−dotsTo :: Char -> String -> String
530−dotsTo chr' = map (\c -> if c == '.' then chr' else c)
512+dotsTo :: Char -> Text -> Text
513+dotsTo chr' = T.map (\c -> if c == '.' then chr' else c)
531514
532−argstr :: (String, Maybe CppType) -> String
515+argstr :: (Text, Maybe CppType) -> Text
533516argstr (name, Nothing) = argStr name (Auto [])
534517argstr (name, Just typ)
535− | name == C.__unused = argStr [] typ
518+ | name == C.__unused = argStr "" typ
536519argstr (name, Just typ) = argStr name typ
537520
538−argStr :: String -> CppType -> String
539−argStr name typ =
540− runType typ ++
541− if null name
542− then []
543− else " " ++ name
521+argStr :: Text -> CppType -> Text
522+argStr name typ = runType typ <>
523+ if T.null name
524+ then ""
525+ else " " <> name
544526
545−templDecl :: [(String, Int)] -> String
546−templDecl ps = "template " ++ angles (intercalate ", " (go <$> ps))
527+templDecl :: [(Text, Int)] -> Text
528+templDecl ps = "template " <> angles (intercalate ", " (go <$> ps))
547529 where
548− go :: (String, Int) -> String
549− go (name, 0) = "typename " ++ name
550− go (name, n) = "typename" ++ parens (intercalate "," $ replicate n "typename") ++ ' ' : name
530+ go :: (Text, Int) -> Text
531+ go (name, 0) = "typename " <> name
532+ go (name, n) = "typename" <> parensT (intercalate "," $ replicate n "typename") <> (' ' `T.cons` name)
551533
552534isNestedNamespace :: Cpp -> Bool
553−isNestedNamespace (CppNamespace (':':':':_) _) = True
535+isNestedNamespace (CppNamespace name _)
536+ | "::" `T.isPrefixOf` name = True
554537isNestedNamespace _ = False
555538
556−angles :: String -> String
557−angles s = '<' : s ++ ">"
539+angles :: Text -> Text
540+angles s = "<" <> s <> ">"
558541
559542linebreak :: [Cpp]
560543linebreak = [CppRaw ""]