checkpoint during parser conversion to megaparsec

website/RenderTestCases.hs

@@ -1,43 +1,52 @@
 
 -- Converts the test data to asciidoc
 
+{-# LANGUAGE OverloadedStrings #-}
 import Language.SQL.SimpleSQL.Tests
 import Text.Show.Pretty
 import Control.Monad.State
-import Language.SQL.SimpleSQL.Parse
-import Language.SQL.SimpleSQL.Lex
+import qualified Language.SQL.SimpleSQL.Parse as P
+import qualified Language.SQL.SimpleSQL.Lex as L
 import Data.List
 import Control.Monad (when, unless)
+import Data.Text (Text)
+import qualified Data.Text as T
 
-data TableItem = Heading Int String
-               | Row String String
+import Prelude hiding (putStrLn)
+import Data.Text.IO (putStrLn)
+
+data TableItem = Heading Int Text
+               | Row Text Text
 
 doc :: Int -> TestItem -> [TableItem]
 -- filter out some groups of tests
-doc n (Group nm _) | "generated" `isInfixOf` nm = []
+doc n (Group nm _) | "generated" `T.isInfixOf` nm = []
 doc n (Group nm is) =
     Heading n nm
     : concatMap (doc (n + 1)) is
 doc _ (TestScalarExpr _ str e) =
-    [Row str (ppShow e)]
+    [Row str (T.pack $ ppShow e)]
 doc _ (TestQueryExpr _ str e) =
-    [Row str (ppShow e)]
+    [Row str (T.pack $ ppShow e)]
 doc _ (TestStatement _ str e) =
-    [Row str (ppShow e)]
+    [Row str (T.pack $ ppShow e)]
 doc _ (TestStatements _ str e) =
-    [Row str (ppShow e)]
+    [Row str (T.pack $ ppShow e)]
 doc _ (ParseQueryExpr d str) =
-    [Row str (ppShow $ parseQueryExpr d "" Nothing str)]
+    [Row str (showResult $ P.parseQueryExpr d "" Nothing str)]
 doc _ (ParseQueryExprFails d str) =
-    [Row str (ppShow $ parseQueryExpr d "" Nothing str)]
+    [Row str (showResult $ P.parseQueryExpr d "" Nothing str)]
 doc _ (ParseScalarExprFails d str) =
-    [Row str (ppShow $ parseScalarExpr d "" Nothing str)]
+    [Row str (showResult $ P.parseScalarExpr d "" Nothing str)]
 
 doc _ (LexTest d str t) =
-    [Row str (ppShow $ lexSQL d "" Nothing str)]
+    [Row str (T.pack $ ppShow $ L.lexSQL d "" Nothing str)]
 
 doc _ (LexFails d str) =
-    [Row str (ppShow $ lexSQL d "" Nothing str)]
+    [Row str (T.pack $ ppShow $ L.lexSQL d "" Nothing str)]
+
+showResult :: Show a => Either P.ParseError a -> Text
+showResult = either P.prettyError (T.pack . ppShow)
 
 -- TODO: should put the dialect in the html output
 
@@ -49,20 +58,21 @@ render = go False
         when t $ putStrLn "|==="
         -- slight hack
         when (level > 1) $
-            putStrLn $ "\n" ++ replicate level '=' ++ " " ++ title
+            putStrLn $ "\n" <> T.replicate level "=" <> " " <> title
         go False is
     go t (Row sql hask : is) = do
         unless t $ putStrLn "[cols=\"2\"]\n|==="
-        let sql' = "\n[source,sql]\n----\n" ++ sql ++ "\n----\n"
-            hask' = "\n[source,haskell]\n----\n" ++ hask ++ "\n----\n"
-        putStrLn $ "a| " ++ escapePipe sql'
-                   ++ "a| " ++ escapePipe hask' ++ " "
+        let sql' = "\n[source,sql]\n----\n" <> sql <> "\n----\n"
+            hask' = "\n[source,haskell]\n----\n" <> hask <> "\n----\n"
+        putStrLn $ "a| " <> escapePipe sql'
+                   <> "a| " <> escapePipe hask' <> " "
         go True is
     go t [] = when t $ putStrLn "|==="
-    escapePipe [] = []
-    escapePipe ('\\':'|':xs) = '\\' : '\\' : '\\' : '|' : escapePipe xs
-    escapePipe ('|':xs) = '\\' : '|' : escapePipe xs
-    escapePipe (x:xs) = x : escapePipe xs
+    escapePipe t = T.pack $ escapePipe' $ T.unpack t
+    escapePipe' [] = []
+    escapePipe' ('\\':'|':xs) = '\\' : '\\' : '\\' : '|' : escapePipe' xs
+    escapePipe' ('|':xs) = '\\' : '|' : escapePipe' xs
+    escapePipe' (x:xs) = x : escapePipe' xs
 
 main :: IO ()
 main = do