1
Fork 0

small fixes

work on the haddock
remove the old attoparsec position stuff from the lexer
change the lexer to accept position info in the same way as the parser
replace sqlindent with new test exe which can parse, lex and indent
This commit is contained in:
Jake Wheat 2015-08-01 12:13:53 +03:00
parent 2df76e3095
commit 913fce068b
7 changed files with 161 additions and 89 deletions

View file

@ -80,7 +80,7 @@ order on the generated documentation.
> makeLexerTest :: Dialect -> String -> [Token] -> T.TestTree
> makeLexerTest d s ts = H.testCase s $ do
> let lx = either (error . show) id $ lexSQL d ("", 1, 1) s
> let lx = either (error . show) id $ lexSQL d "" Nothing s
> H.assertEqual "" ts $ map snd lx
> let s' = prettyTokens d $ map snd lx
> H.assertEqual "pretty print" s s'

View file

@ -1,16 +0,0 @@
> import System.Environment
> import Language.SQL.SimpleSQL.Pretty
> import Language.SQL.SimpleSQL.Parser
> main :: IO ()
> main = do
> args <- getArgs
> case args of
> [f] -> do
> src <- readFile f
> either (error . peFormattedError)
> (putStrLn . prettyQueryExprs)
> $ parseQueryExprs f Nothing src
> _ -> error "please pass filename to indent"

View file

@ -0,0 +1,92 @@
Simple command line tool to experiment with simple-sql-parser
Commands:
parse: parse sql from file, stdin or from command line
lex: lex sql same
indent: parse then pretty print sql
> {-# LANGUAGE TupleSections #-}
> import System.Environment
> import Control.Monad
> import Data.Maybe
> import System.Exit
> import Data.List
> import Language.SQL.SimpleSQL.Pretty
> import Language.SQL.SimpleSQL.Parser
> import Language.SQL.SimpleSQL.Syntax
> import Language.SQL.SimpleSQL.Lexer
> main :: IO ()
> main = do
> args <- getArgs
> case args of
> [] -> do
> showHelp $ Just "no command given"
> (c:as) -> do
> let cmd = lookup c commands
> maybe (showHelp (Just "command not recognised"))
> (\(_,cmd') -> cmd' as)
> cmd
> commands :: [(String, (String,[String] -> IO ()))]
> commands =
> [("help", helpCommand)
> ,("parse", parseCommand)
> ,("lex", lexCommand)
> ,("indent", indentCommand)]
> showHelp :: Maybe String -> IO ()
> showHelp msg = do
> maybe (return ()) (\e -> putStrLn $ "Error: " ++ e) msg
> putStrLn "Usage:\n SimpleSqlParserTool command args"
> forM_ commands $ \(c, (h,_)) -> do
> putStrLn $ c ++ "\t" ++ h
> when (isJust msg) $ exitFailure
> helpCommand :: (String,[String] -> IO ())
> helpCommand =
> ("show help for this progam", \_ -> showHelp Nothing)
> getInput :: [String] -> IO (FilePath,String)
> getInput as =
> case as of
> ["-"] -> error "read stdin"
> ("-c":as') -> return ("-", unwords as')
> [filename] -> (filename,) <$> readFile filename
> _ -> showHelp (Just "arguments not recognised") >> error ""
> parseCommand :: (String,[String] -> IO ())
> parseCommand =
> ("parse SQL from file/stdin/command line (use -c to parse from command line)"
> ,\args -> do
> (f,src) <- getInput args
> either (error . peFormattedError)
> (putStrLn . prettyQueryExprs SQL2011)
> $ parseQueryExprs SQL2011 f Nothing src
> )
> lexCommand :: (String,[String] -> IO ())
> lexCommand =
> ("lex SQL from file/stdin/command line (use -c to parse from command line)"
> ,\args -> do
> (f,src) <- getInput args
> either (error . peFormattedError)
> (putStrLn . intercalate ",\n" . map show)
> $ lexSQL SQL2011 f Nothing src
> )
> indentCommand :: (String,[String] -> IO ())
> indentCommand =
> ("parse then pretty print SQL from file/stdin/command line (use -c to parse from command line)"
> ,\args -> do
> (f,src) <- getInput args
> either (error . peFormattedError)
> (putStrLn . prettyQueryExprs SQL2011)
> $ parseQueryExprs SQL2011 f Nothing src
> )