diff --git a/Language/SQL/SimpleSQL/Lex.hs b/Language/SQL/SimpleSQL/Lex.hs index 00d456d..8cd63a7 100644 --- a/Language/SQL/SimpleSQL/Lex.hs +++ b/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 - { myStreamInput :: String - , unMyStream :: [WithPos Token] +-- | Wrapper to allow using the lexer as input to a megaparsec parser. +data SQLStream = SQLStream + { sqlStreamInput :: String + , unSQLStream :: [WithPos Token] } -instance M.Stream MyStream where - type Token MyStream = WithPos Token - type Tokens MyStream = [WithPos Token] +instance M.Stream SQLStream where + type Token SQLStream = 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_ (MyStream str (t:ts)) = Just + take1_ (SQLStream _ []) = Nothing + 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) - | n <= 0 = Just ([], MyStream str s) + takeN_ n (SQLStream 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') - Just nex -> Just (x, MyStream (drop (tokensLength pxy nex) str) s') - takeWhile_ f (MyStream str s) = + Nothing -> Just (x, SQLStream str s') + Just nex -> Just (x, SQLStream (drop (tokensLength pxy nex) 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') - Just nex -> (x, MyStream (drop (tokensLength pxy nex) str) s') + Nothing -> (x, SQLStream 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 - { myStreamInput = postStr - , unMyStream = post + { pstateInput = SQLStream + { sqlStreamInput = postStr + , 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) - (preStr, postStr) = splitAt tokensConsumed (myStreamInput pstateInput) + (pre, post) = splitAt (o - pstateOffset) (unSQLStream 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 diff --git a/Language/SQL/SimpleSQL/Parse.hs b/Language/SQL/SimpleSQL/Parse.hs index 53d4737..d44de80 100644 --- a/Language/SQL/SimpleSQL/Parse.hs +++ b/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) {- ------------------------------------------------ diff --git a/changelog b/changelog index bbc7cc2..cd56e0b 100644 --- a/changelog +++ b/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 diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index c7ed54a..9955f3f 100644 --- a/simple-sql-parser.cabal +++ b/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 diff --git a/tools/SimpleSQLParserExample.hs b/tools/SimpleSQLParserExample.hs index e612dbe..5a64232 100644 --- a/tools/SimpleSQLParserExample.hs +++ b/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 - either (error . peFormattedError) + parsed = parseStatements ansi2011 "" Nothing (T.pack src) + either (error . T.unpack . prettyError) (putStrLn . ppShow) parsed