tidying pass: update changelog, get example compiling, pass on haddock, rename MyStream to SQLStream, tweak cabal file

Language/SQL/SimpleSQL/Lex.hs

@@ -87,7 +87,7 @@ module Language.SQL.SimpleSQL.Lex
     ,prettyError
     ,tokenListWillPrintAndLex
     ,ansi2011
-    ,MyStream(..)
+    ,SQLStream(..)
     ) where
 
 import Language.SQL.SimpleSQL.Dialect
@@ -857,52 +857,53 @@ TODO: not 100% on this always being bad
 
 -- megaparsec stream boilerplate
 
-data MyStream = MyStream
+-- | Wrapper to allow using the lexer as input to a megaparsec parser.
-  { myStreamInput :: String
+data SQLStream = SQLStream
-  , unMyStream :: [WithPos Token]
+  { sqlStreamInput :: String
+  , unSQLStream :: [WithPos Token]
   }
 
-instance M.Stream MyStream where
+instance M.Stream SQLStream where
-  type Token  MyStream = WithPos Token
+  type Token  SQLStream = WithPos Token
-  type Tokens MyStream = [WithPos Token]
+  type Tokens SQLStream = [WithPos Token]
 
   tokenToChunk Proxy x = [x]
   tokensToChunk Proxy xs = xs
   chunkToTokens Proxy = id
   chunkLength Proxy = length
   chunkEmpty Proxy = null
-  take1_ (MyStream _ []) = Nothing
+  take1_ (SQLStream _ []) = Nothing
-  take1_ (MyStream str (t:ts)) = Just
+  take1_ (SQLStream str (t:ts)) = Just
     ( t
-    , MyStream (drop (tokensLength pxy (t NE.:|[])) str) ts
+    , SQLStream (drop (tokensLength pxy (t NE.:|[])) str) ts
     )
-  takeN_ n (MyStream str s)
+  takeN_ n (SQLStream str s)
-    | n <= 0    = Just ([], MyStream str s)
+    | n <= 0    = Just ([], SQLStream str s)
     | null s    = Nothing
     | otherwise =
         let (x, s') = splitAt n s
         in case NE.nonEmpty x of
-          Nothing -> Just (x, MyStream str s')
+          Nothing -> Just (x, SQLStream str s')
-          Just nex -> Just (x, MyStream (drop (tokensLength pxy nex) str) s')
+          Just nex -> Just (x, SQLStream (drop (tokensLength pxy nex) str) s')
-  takeWhile_ f (MyStream str s) =
+  takeWhile_ f (SQLStream str s) =
     let (x, s') = DL.span f s
     in case NE.nonEmpty x of
-      Nothing -> (x, MyStream str s')
+      Nothing -> (x, SQLStream str s')
-      Just nex -> (x, MyStream (drop (tokensLength pxy nex) str) s')
+      Just nex -> (x, SQLStream (drop (tokensLength pxy nex) str) s')
 
-instance VisualStream MyStream where
+instance VisualStream SQLStream where
   showTokens Proxy = DL.intercalate " "
     . NE.toList
     . fmap (showMyToken . tokenVal)
   tokensLength Proxy xs = sum (tokenLength <$> xs)
 
-instance TraversableStream MyStream where
+instance TraversableStream SQLStream where
   reachOffset o M.PosState {..} =
     ( Just (prefix ++ restOfLine)
     , PosState
-        { pstateInput = MyStream
+        { pstateInput = SQLStream
-            { myStreamInput = postStr
+            { sqlStreamInput = postStr
-            , unMyStream = post
+            , unSQLStream = post
             }
         , pstateOffset = max pstateOffset o
         , pstateSourcePos = newSourcePos
@@ -918,12 +919,12 @@ instance TraversableStream MyStream where
       sameLine = sourceLine newSourcePos == sourceLine pstateSourcePos
       newSourcePos =
         case post of
-          [] -> case unMyStream pstateInput of
+          [] -> case unSQLStream pstateInput of
             [] -> pstateSourcePos
             xs -> endPos (last xs)
           (x:_) -> startPos x
-      (pre, post) = splitAt (o - pstateOffset) (unMyStream pstateInput)
+      (pre, post) = splitAt (o - pstateOffset) (unSQLStream pstateInput)
-      (preStr, postStr) = splitAt tokensConsumed (myStreamInput pstateInput)
+      (preStr, postStr) = splitAt tokensConsumed (sqlStreamInput pstateInput)
       preLine = reverse . takeWhile (/= '\n') . reverse $ preStr
       tokensConsumed =
         case NE.nonEmpty pre of
@@ -931,7 +932,7 @@ instance TraversableStream MyStream where
           Just nePre -> tokensLength pxy nePre
       restOfLine = takeWhile (/= '\n') postStr
 
-pxy :: Proxy MyStream
+pxy :: Proxy SQLStream
 pxy = Proxy
 
 showMyToken :: Token -> String

Language/SQL/SimpleSQL/Parse.hs

@@ -186,6 +186,7 @@ module Language.SQL.SimpleSQL.Parse
     ,parseStatements
     ,ParseError(..)
     ,prettyError
+    ,ansi2011
     ) where
 
 import Text.Megaparsec
@@ -301,7 +302,7 @@ parseScalarExpr = wrapParse scalarExpr
 
 data ParseError
     = LexError L.ParseError
-    | ParseError (ParseErrorBundle L.MyStream Void)
+    | ParseError (ParseErrorBundle L.SQLStream Void)
 
 prettyError :: ParseError -> Text
 prettyError (LexError e) = T.pack $ errorBundlePretty e
@@ -326,7 +327,7 @@ wrapParse parser d f p src = do
     lx <- either (Left . LexError) Right $ L.lexSQLWithPositions d f p src
     either (Left . ParseError) Right $ 
         runReader (runParserT (parser <* (eof <?> "")) (T.unpack f)
-                   $ L.MyStream (T.unpack src) $ filter notSpace lx) d
+                   $ L.SQLStream (T.unpack src) $ filter notSpace lx) d
   where
     notSpace = notSpace' . L.tokenVal
     notSpace' (L.Whitespace {}) = False
@@ -338,7 +339,7 @@ wrapParse parser d f p src = do
 
 -- parsing code
 
-type Parser = ParsecT Void L.MyStream (Reader Dialect)
+type Parser = ParsecT Void L.SQLStream (Reader Dialect)
 
 {-
 ------------------------------------------------

changelog

@@ -5,6 +5,9 @@
 	use prettyprinter lib instead of pretty
 	nested block comments regressed - post a bug if you need this
 	fixed fixity parsing of union, except and intersect (matches postgres docs now)
+	removed the Errors module - the pretty printer function for errors is in the Parse module
+	parses from and pretty prints to strict Text
+	strict Text used instead of String everywhere
 0.6.1   added odbc handling to sqlsqerver dialect
 		added sqlserver dialect case for convert function
 0.6.0

simple-sql-parser.cabal

@@ -20,7 +20,7 @@ maintainer:          jakewheatmail@gmail.com
 copyright:           Copyright Jake Wheat 2013, 2014, 2015
 category:            Database,Language
 build-type:          Simple
-extra-source-files:  README,LICENSE,changelog
+extra-doc-files:     README,LICENSE,changelog
 bug-reports:         https://github.com/JakeWheat/simple-sql-parser/issues
 
 source-repository head
@@ -31,6 +31,10 @@ Flag parserexe
   Description: Build SimpleSqlParserTool exe
   Default:     False
 
+Flag exampleexe
+  Description: Build simple sql parser example exe
+  Default:     False
+
 common shared-properties
   default-language:    Haskell2010
   build-depends:       base >=4 && <5,
@@ -39,7 +43,7 @@ common shared-properties
                        mtl >=2.1 && <2.4,
                        prettyprinter >= 1.7 && < 1.8,
                        text  >= 2.1 && < 2.2,
-                       containers
+                       containers >= 0.6 && < 0.8
 
   ghc-options:         -Wall
 
@@ -97,3 +101,14 @@ executable SimpleSqlParserTool
     buildable:         True
   else
     buildable:         False
+
+executable SimpleSQLParserExample
+  import:              shared-properties
+  main-is:             SimpleSQLParserExample.hs
+  hs-source-dirs:      tools
+  Build-Depends:       simple-sql-parser,
+                       pretty-show >= 1.6 && < 1.10
+  if flag(exampleexe)
+    buildable:         True
+  else
+    buildable:         False

tools/SimpleSQLParserExample.hs

@@ -1,6 +1,7 @@
 
 -- Simple example to show parsing some SQL then pretty printing the AST
 
+{-# LANGUAGE OverloadedStrings #-}
 import System.Environment
 import Text.Show.Pretty
 import System.IO
@@ -8,9 +9,11 @@ import System.IO
 import Language.SQL.SimpleSQL.Parse
        (parseStatements
        ,ParseError
-       ,peFormattedError)
+       ,prettyError
+       ,ansi2011)
 
-import Language.SQL.SimpleSQL.Syntax (ansi2011, Statement)
+import Language.SQL.SimpleSQL.Syntax (Statement)
+import qualified Data.Text as T
 
 
 main :: IO ()
@@ -41,7 +44,7 @@ main = do
 doIt :: String -> IO ()
 doIt src = do
     let parsed :: Either ParseError [Statement]
-        parsed = parseStatements ansi2011 "" Nothing src
+        parsed = parseStatements ansi2011 "" Nothing (T.pack src)
-    either (error . peFormattedError)
+    either (error . T.unpack . prettyError)
            (putStrLn . ppShow)
            parsed