tidying pass: update changelog, get example compiling, pass on haddock, rename MyStream to SQLStream, tweak cabal file
This commit is contained in:
Jake Wheat
parent
de121d1fd6
commit
2fd285e670
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
{-
|
||||
------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue