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:
parent
2df76e3095
commit
913fce068b
7 changed files with 161 additions and 89 deletions
tools
|
@ -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'
|
||||
|
|
|
@ -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"
|
92
tools/SimpleSqlParserTool.lhs
Normal file
92
tools/SimpleSqlParserTool.lhs
Normal 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
|
||||
|
||||
> )
|
Loading…
Add table
Add a link
Reference in a new issue