qhs (empty) → 0.3.2
raw patch · 14 files changed
+854/−0 lines, 14 filesdep +basedep +bytestringdep +containerssetup-changed
Dependencies added: base, bytestring, containers, cryptonite, hspec, optparse-applicative, process, simple-sql-parser, split, sqlite-simple, syb, text, zlib
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- qhs.cabal +68/−0
- src/File.hs +65/−0
- src/Main.hs +118/−0
- src/Option.hs +61/−0
- src/Parser.hs +71/−0
- src/SQL.hs +61/−0
- src/SQLType.hs +44/−0
- test/FileSpec.hs +107/−0
- test/MainSpec.hs +38/−0
- test/ParserSpec.hs +125/−0
- test/SQLSpec.hs +72/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016-2020 itchyny++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ qhs.cabal view
@@ -0,0 +1,68 @@+name: qhs+version: 0.3.2+author: itchyny <https://github.com/itchyny>+maintainer: itchyny <https://github.com/itchyny>+license: MIT+license-file: LICENSE+category: Console+build-type: Simple+cabal-version: >=1.10+synopsis: Command line tool qhs, SQL queries on CSV and TSV files.+description: This is a Haskell port of q command (https://github.com/harelba/q).++executable qhs+ hs-source-dirs: src+ main-is: Main.hs+ ghc-options: -threaded -Wall+ default-language: Haskell2010+ other-modules: Parser+ , SQL+ , SQLType+ , File+ , Option+ , Paths_qhs+ build-depends: base >= 4.9 && < 5+ , bytestring+ , containers+ , cryptonite+ , optparse-applicative+ , simple-sql-parser >= 0.6.0+ , split+ , sqlite-simple+ , syb >= 0.4+ , text+ , zlib++test-suite spec+ hs-source-dirs: test,src+ main-is: Spec.hs+ ghc-options: -threaded -Wall+ other-modules: Parser+ , SQL+ , SQLType+ , File+ , Option+ , Paths_qhs+ , ParserSpec+ , SQLSpec+ , FileSpec+ , MainSpec+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ build-depends: base >= 4.9 && < 5+ , bytestring+ , containers+ , cryptonite+ , hspec+ , optparse-applicative+ , process+ , simple-sql-parser >= 0.6.0+ , split+ , sqlite-simple+ , syb >= 0.4+ , text+ , zlib++source-repository head+ type: git+ location: git@github.com:itchyny/qhs.git
+ src/File.hs view
@@ -0,0 +1,65 @@+module File where++import qualified Codec.Compression.GZip as GZip+import Control.Applicative ((<|>))+import Control.Monad (guard, when)+import qualified Data.ByteString.Lazy as ByteString+import qualified Data.ByteString.Lazy.Char8 as Char8+import Data.Char (isSpace)+import System.Exit (exitFailure)+import System.IO++import qualified Option as Option++readFromFile :: Option.Option -> Handle -> IO ([String], [[String]])+readFromFile opts handle = do+ contents <- joinMultiLines <$> lines <$>+ if Option.gzipped opts+ then Char8.unpack <$> GZip.decompress <$> ByteString.hGetContents handle+ else hGetContents handle+ let (headLine : secondLine : _) = contents ++ [ "", "" ]+ let delimiter = guard (Option.tabDelimited opts) *> Just "\t" <|> Option.delimiter opts+ when (maybe False ((/=1) . length) delimiter) $ do+ hPutStrLn stderr "Invalid delimiter."+ exitFailure+ let splitter = case delimiter of+ Just [c] -> (==) c+ _ -> detectSplitter headLine secondLine+ let headColumns = splitFixedSize splitter 0 headLine+ let size = length headColumns+ let columns = if Option.skipHeader opts then headColumns else [ 'c' : show i | i <- [1..size] ]+ let skipLine = if Option.skipHeader opts then tail else id+ let stripSpaces = if Option.keepLeadingWhiteSpace opts then id else dropWhile isSpace+ let body = filter (not . null) $ map (map stripSpaces . splitFixedSize splitter size) (skipLine contents)+ return (columns, body)+ where joinMultiLines (cs:ds:css) | valid True cs = cs : joinMultiLines (ds:css)+ | otherwise = joinMultiLines $ (cs ++ "\n" ++ ds) : css+ where valid False ('"':'"':xs) = valid False xs+ valid False ('\\':'"':xs) = valid False xs+ valid b ('"':xs) = valid (not b) xs+ valid b (_:xs) = valid b xs+ valid b "" = b+ joinMultiLines css = css++detectSplitter :: String -> String -> Char -> Bool+detectSplitter xs ys = head $ [ splitter | (x, y, splitter) <- map splitLines splitters+ , 1 < length x && length x <= length y ] ++ splitters+ where splitLines f = (splitFixedSize f 0 xs, splitFixedSize f 0 ys, f)+ splitters = [ (==','), isSpace ]++splitFixedSize :: (Char -> Bool) -> Int -> String -> [String]+splitFixedSize f n = fill . go n+ where go _ "" = []+ go k (c:cs@(c':_)) | f c && f c' && not (f ' ' && isSpace c') = "" : go (k - 1) cs+ | f c = go k cs+ go k ('"':cs) = let (ys, xs) = takeQuotedString cs in xs : go (k - 1) ys+ where takeQuotedString ('"':'"':xs) = fmap ('"':) (takeQuotedString xs)+ takeQuotedString ('\\':'"':xs) = fmap ('"':) (takeQuotedString xs)+ takeQuotedString ('"':xs) = (xs, "")+ takeQuotedString (x:xs) = fmap (x:) (takeQuotedString xs)+ takeQuotedString "" = ("", "")+ go k (c:cs) | f c = go k cs+ go 1 cs = [cs]+ go k cs = let (xs, ys) = break f cs in xs : go (k - 1) ys+ fill [] = []+ fill xs = xs ++ replicate (n - length xs) ""
+ src/Main.hs view
@@ -0,0 +1,118 @@+module Main where++import Control.Applicative+import Control.Monad (forM_, guard, when)+import Data.Char (isSpace)+import Data.List (isSuffixOf, intercalate, transpose)+import qualified Data.Map as Map+import Data.Maybe+import qualified Data.Set as Set+import Data.Set ((\\))+import qualified Database.SQLite.Simple as SQLite+import Options.Applicative (execParser, helper, info, fullDesc, header)+import System.Exit (exitFailure)+import System.IO+import Text.Read (readMaybe)++import qualified File as File+import qualified Option as Option+import qualified Parser as Parser+import qualified SQL as SQL+import qualified SQLType as SQLType++main :: IO ()+main = runCommand =<< execParser opts+ where opts = info (helper <*> Option.version <*> Option.options)+ (fullDesc <> header "qhs - SQL queries on CSV and TSV files")++runCommand :: Option.Option -> IO ()+runCommand opts = do+ conn <- SQL.open ":memory:"+ maybeQueryTableMap <- parseQuery =<< fetchQuery opts+ forM_ maybeQueryTableMap $ runQuery opts conn+ SQL.close conn++runQuery :: Option.Option -> SQLite.Connection -> (String, Parser.TableNameMap) -> IO ()+runQuery opts conn (query, tableMap) = do+ readFilesCreateTables opts conn tableMap+ ret <- SQL.execute conn query+ case ret of+ Right (cs, rs) -> do+ let outputDelimiter =+ fromMaybe " " $ guard (Option.tabDelimitedOutput opts) *> Just "\t"+ <|> Option.outputDelimiter opts+ <|> guard (Option.tabDelimited opts) *> Just "\t"+ <|> Option.delimiter opts+ when (Option.outputHeader opts) $+ putStrLn $ intercalate outputDelimiter $ cs+ mapM_ (putStrLn . intercalate outputDelimiter . map show) rs+ Left err -> putStrLn err++fetchQuery :: Option.Option -> IO String+fetchQuery opts = do+ when (isJust (Option.query opts) && isJust (Option.queryFile opts)) $ do+ hPutStrLn stderr "Can't provide both a query file and a query on the command line."+ exitFailure+ query <- fromMaybe "" <$> case Option.query opts of+ Just q -> return (Just q)+ Nothing -> mapM readFile (Option.queryFile opts)+ when (all isSpace query) $ do+ hPutStrLn stderr "Query cannot be empty."+ hPutStrLn stderr "For basic information, try the `--help' option."+ exitFailure+ return query++parseQuery :: String -> IO (Maybe (String, Parser.TableNameMap))+parseQuery qs = do+ let (query, tableMap) = Parser.replaceTableNames qs+ case Parser.extractTableNames query "<<query>>" of+ Left err -> do+ putStrLn $ Parser.replaceBackTableNames tableMap $ Parser.errorString err+ return Nothing+ Right tableNames -> do+ let xs = Set.fromList tableNames+ let ys = Set.fromList (Map.elems tableMap)+ if xs == ys+ then return $ Just (query, tableMap)+ else do+ putStrLn "Invalid table name:"+ putStrLn $ " " ++ show (Set.union (xs \\ ys) (ys \\ xs))+ putStrLn "Probably a bug of qhs. Please submit a issue report."+ return Nothing++readFilesCreateTables :: Option.Option -> SQLite.Connection -> Parser.TableNameMap -> IO ()+readFilesCreateTables opts conn tableMap =+ forM_ (Map.toList tableMap) $ \(path, name) -> do+ let path' = unquote path+ handle <- openFile (if path' == "-" then "/dev/stdin" else path') ReadMode+ let opts' = opts { Option.gzipped = Option.gzipped opts || ".gz" `isSuffixOf` path' }+ (columns, body) <- File.readFromFile opts' handle+ when (length columns == 0) $ do+ hPutStrLn stderr $ if Option.skipHeader opts+ then "Header line is expected but missing in file " ++ path+ else "Warning - data is empty"+ exitFailure+ when (any (elem ',') columns) $ do+ hPutStrLn stderr "Column name cannot contain commas"+ exitFailure+ when (length columns >= 1) $+ createTable conn name path columns body+ hClose handle+ where unquote (x:xs@(_:_)) | x `elem` "\"'`" && x == last xs = init xs+ unquote xs = xs++createTable :: SQLite.Connection -> String -> String -> [String] -> [[String]] -> IO ()+createTable conn name path columns body = do+ let probablyNumberColumn =+ [ all isJust [ readMaybe x :: Maybe Float | x <- xs, not (all isSpace x) ]+ | xs <- transpose body ]+ let types = [ if b then SQLType.SQLInt else SQLType.SQLChar | b <- probablyNumberColumn ]+ ret <- SQL.createTable conn name columns types+ case ret of+ Just err -> do+ putStrLn "Error on creating a new table:"+ putStrLn $ " " ++ path ++ " (" ++ name ++ ") " ++ show columns+ putStrLn err+ Nothing ->+ forM_ body $ \entry -> do+ mapM_ (hPutStrLn stderr) =<< SQL.insertRow conn name columns types entry
+ src/Option.hs view
@@ -0,0 +1,61 @@+module Option where++import Data.Version (showVersion)+import Options.Applicative++import qualified Paths_qhs as QHS++-- | Command options+data Option = Option { skipHeader :: Bool,+ outputHeader :: Bool,+ delimiter :: Maybe String,+ tabDelimited :: Bool,+ outputDelimiter :: Maybe String,+ tabDelimitedOutput :: Bool,+ keepLeadingWhiteSpace :: Bool,+ gzipped :: Bool,+ queryFile :: Maybe String,+ query :: Maybe String }++-- | Option parser+options :: Parser Option+options = Option+ <$> switch (long "skip-header"+ <> short 'H'+ <> help "Skip the header row for row input and use it for column names instead.")+ <*> switch (long "output-header"+ <> short 'O'+ <> help "Output the header line.")+ <*> optional (strOption (long "delimiter"+ <> short 'd'+ <> metavar "DELIMITER"+ <> help "Field delimiter. If not specified, automatically detected."))+ <*> switch (long "tab-delimited"+ <> short 't'+ <> help "Same as -d $'\\t'.")+ <*> optional (strOption (long "output-delimiter"+ <> short 'D'+ <> metavar "OUTPUT_DELIMITER"+ <> help "Field delimiter for output. If not specified, the argument of -d DELIMITER is used."))+ <*> switch (long "tab-delimited-output"+ <> short 'T'+ <> help "Same as -D $'\\t'.")+ <*> switch (long "keep-leading-whitespace"+ <> short 'k'+ <> help "Keep leading whitespace in values. The leading whitespaces are stripped off by default.")+ <*> switch (long "gzipped"+ <> short 'z'+ <> help "Assuming the gzipped input.")+ <*> optional (strOption (long "query-filename"+ <> short 'q'+ <> metavar "QUERY_FILENAME"+ <> help "Read query from the provided filename."))+ <*> optional (argument str (metavar "QUERY"))++-- | Parser for --version/-v+version :: Parser (a -> a)+version = abortOption (InfoMsg ("qhs " ++ showVersion QHS.version)) $+ long "version" <>+ short 'v' <>+ help "Show the version of the command." <>+ hidden
+ src/Parser.hs view
@@ -0,0 +1,71 @@+module Parser (replaceTableNames, roughlyExtractTableNames, replaceBackTableNames, extractTableNames, errorString, TableNameMap) where++import qualified Crypto.Hash as Crypto+import qualified Data.ByteString.Char8 as Char8+import Data.Char (isNumber, isSpace, toUpper)+import Data.Generics (everything, mkQ)+import Data.List (unfoldr)+import qualified Data.Map as Map+import Data.Tuple (swap)+import qualified Language.SQL.SimpleSQL.Dialect as Dialect+import qualified Language.SQL.SimpleSQL.Parse as Parse+import qualified Language.SQL.SimpleSQL.Syntax as Syntax++type TableNameMap = Map.Map String String++-- | Replace all the occurrence of table names (file names, in many cases) into+-- valid table names in SQL. The table names are calculated based on the file+-- names, keeping its length so that error position stays at the same position+-- after we replace them back to the file names. I take `max 5` to avoid conflict.+replaceTableNames :: String -> (String, TableNameMap)+replaceTableNames qs = (replaceQueryWithTableMap tableMap qs, tableMap)+ where genTableName xs = take (max 5 (length xs)) $ dropWhile isNumber $ concat $ tail $ iterate sha1Encode xs+ tableMap = Map.fromList [ (name, genTableName name) | name <- roughlyExtractTableNames qs ]++sha1Encode :: String -> String+sha1Encode = show . (Crypto.hash :: Char8.ByteString -> Crypto.Digest Crypto.SHA1) . Char8.pack++-- | This function roughly extract the table names. We need this function because+-- the given query contains the file names so the SQL parser cannot parse.+roughlyExtractTableNames :: String -> [String]+roughlyExtractTableNames qs = [ ys | (xs, ys) <- zip qss (drop 2 qss), isTableNamePrefix xs ]+ where qss = splitQuery qs++-- | The words after these words are possibly table names.+isTableNamePrefix :: String -> Bool+isTableNamePrefix xs = map toUpper xs `elem` ["FROM", "JOIN"]++-- | Replace the table names using the tableMap.+replaceQueryWithTableMap :: TableNameMap -> String -> String+replaceQueryWithTableMap tableMap qs = query+ where qss = splitQuery qs+ query = concat [ if isTableNamePrefix xs then Map.findWithDefault ys ys tableMap else ys | (xs, ys) <- zip ("" : "" : qss) qss ]++-- | Split the query string with spaces, taking the quotes into consideration.+splitQuery :: String -> [String]+splitQuery = unfoldr split'+ where split' :: String -> Maybe (String, String)+ split' ccs@(c:cs) | c `elem` "\"'`" = Just $ splitAt (1 + countUntil c cs) ccs+ | isSpace c = Just $ span isSpace ccs+ | otherwise = Just $ break (\d -> isSpace d || d `elem` "\"'`") ccs+ split' [] = Nothing+ countUntil c ('\\':c':cs) | c == c' = 2 + countUntil c cs+ countUntil c (c':cs) | c == c' = 1+ | otherwise = 1 + countUntil c cs+ countUntil _ [] = 0++-- | Replace the generated table names back into the original file names.+replaceBackTableNames :: TableNameMap -> String -> String+replaceBackTableNames tableMap = replaceQueryWithTableMap reverseMap+ where reverseMap = Map.fromList $ map swap $ Map.toList tableMap++-- | Extracts the table names using the rigid SQL parser.+extractTableNames :: String -> FilePath -> Either Parse.ParseError [String]+extractTableNames query path = everything (++) ([] `mkQ` tableNames)+ <$> Parse.parseQueryExpr Dialect.mysql path Nothing query+ where tableNames (Syntax.TRSimple (name:_)) = fromName name+ tableNames _ = []+ fromName (Syntax.Name _ name) = [name]++errorString :: Parse.ParseError -> String+errorString = Parse.peFormattedError
+ src/SQL.hs view
@@ -0,0 +1,61 @@+module SQL (open, close, createTable, insertRow, execute) where++import Control.Exception (try, SomeException)+import Control.Monad (forM)+import Data.List (intersperse)+import Data.String (fromString)+import qualified Data.Text as T+import qualified Database.SQLite.Simple as SQLite++import SQLType++-- | Open a new database connection.+open :: String -> IO SQLite.Connection+open = SQLite.open++-- | Close a database connection.+close :: SQLite.Connection -> IO ()+close = SQLite.close++-- | Creates a new table.+createTable :: SQLite.Connection -> String -> [String] -> [SQLType] -> IO (Maybe String)+createTable conn name columns types = do+ let stmt = "CREATE TABLE " ++ sqlQuote name ++ " "+ ++ tupled (map quote (zip types columns)) ++ ";"+ e <- try $ SQLite.execute_ conn (fromString stmt)+ return $ either (Just . (show :: SomeException -> String)) (const Nothing) e+ where quote (t, c) = sqlQuote c ++ " " ++ showType t++-- | Inserts a row into a table.+insertRow :: SQLite.Connection -> String -> [String] -> [SQLType] -> [String] -> IO (Maybe String)+insertRow conn name columns types entry = do+ let stmt = "INSERT INTO " ++ sqlQuote name ++ tupled (map sqlQuote columns)+ ++ " VALUES " ++ tupled (map quote (zip types entry)) ++ ";"+ e <- try $ SQLite.execute_ conn (fromString stmt)+ return $ either (Just . (show :: SomeException -> String)) (const Nothing) e+ where quote (t, "") | isDigitType t = "NULL"+ quote (t, cs) | isDigitType t = cs+ | otherwise = "'" ++ toSQLString cs ++ "'"+ isDigitType SQLInt = True+ isDigitType _ = False++toSQLString :: String -> String+toSQLString "" = ""+toSQLString ('\'':xs) = '\'':'\'':toSQLString xs+toSQLString (x:xs) = x : toSQLString xs++-- | Executes a SQL statement.+execute :: SQLite.Connection -> String -> IO (Either String ([String], [[Any]]))+execute conn query = do+ e <- try $ SQLite.query_ conn (fromString query)+ columns <- SQLite.withStatement conn (fromString query) $ \stmt -> do+ cnt <- toInteger <$> SQLite.columnCount stmt+ forM [0..cnt-1] $ \i ->+ T.unpack <$> SQLite.columnName stmt (fromInteger i)+ return $ either (Left . (show :: SomeException -> String)) (Right . (,) columns) $ e++sqlQuote :: String -> String+sqlQuote xs = "`" ++ xs ++ "`"++tupled :: [String] -> String+tupled xs = "(" ++ concat (intersperse ", " xs) ++ ")"
+ src/SQLType.hs view
@@ -0,0 +1,44 @@+module SQLType (SQLType(..), showType, Any, fromColumnsAndEntries) where++import Data.String (IsString(..))+import qualified Data.Text as T+import Database.SQLite.Simple+import Database.SQLite.Simple.FromField+import Database.SQLite.Simple.Internal (Field(..))+import Database.SQLite.Simple.Ok+import Text.Read (readMaybe)++data SQLType = SQLChar | SQLInt++showType :: SQLType -> String+showType t =+ case t of+ SQLChar -> "CHAR"+ SQLInt -> "INTEGER"++data Any = AnyDouble Double | AnyInt Int | AnyString String | AnyNull+ deriving (Eq)++instance FromField Any where+ fromField (Field (SQLFloat d) _) = Ok . AnyDouble $ d+ fromField (Field (SQLInteger i) _) = Ok . AnyInt . fromIntegral $ i+ fromField (Field (SQLText s) _) = Ok . AnyString . T.unpack $ s+ fromField (Field SQLNull _) = Ok AnyNull+ fromField f = returnError ConversionFailed f "expecting SQLText column type"++instance IsString Any where+ fromString s =+ case readMaybe s of+ Just i -> AnyInt i+ Nothing -> case readMaybe s of+ Just d -> AnyDouble d+ Nothing -> if s == "" then AnyNull else AnyString s++instance Show Any where+ show (AnyDouble d) = show d+ show (AnyInt i) = show i+ show (AnyString s) = s+ show AnyNull = ""++fromColumnsAndEntries :: [String] -> [[String]] -> ([String], [[Any]])+fromColumnsAndEntries columns xs = (columns, map (map fromString) xs)
+ test/FileSpec.hs view
@@ -0,0 +1,107 @@+module FileSpec (spec) where++import Data.Char (isSpace)+import System.IO+import Test.Hspec (Spec, describe, it, shouldBe, shouldReturn)++import File+import Option++spec :: Spec+spec = do+ readFromFileSpec+ detectSplitterSpec+ splitFixedSizeSpec++readFromFileSpec :: Spec+readFromFileSpec =+ describe "readFromFile" $ do+ let opts = Option { skipHeader = True,+ outputHeader = False,+ delimiter = Nothing,+ tabDelimited = False,+ outputDelimiter = Nothing,+ tabDelimitedOutput = False,+ keepLeadingWhiteSpace = False,+ gzipped = False,+ queryFile = Nothing,+ query = Nothing }++ it "should read from a test file" $ do+ handle <- openFile "test/tests/basic.csv" ReadMode+ let expected = (["foo", "bar", "baz"], [["a0", "1", "a2"], ["b0", "3", "b2"], ["c0", "", "c2"]])+ readFromFile opts handle `shouldReturn` expected+ hClose handle++ it "should read from a gzipped file" $ do+ handle <- openFile "test/tests/basic.csv.gz" ReadMode+ let expected = (["foo", "bar", "baz"], [["a0", "1", "a2"], ["b0", "3", "b2"], ["c0", "", "c2"]])+ readFromFile (opts { gzipped = True }) handle `shouldReturn` expected+ hClose handle++ it "should read from a test file which contains a multiline cell" $ do+ handle <- openFile "test/tests/multiline.csv" ReadMode+ let expected = (["foo", "bar", "baz", "qux", "quux"], [["a0", "1", "a2\nb0\",3,\"b2\nc0", "", "c2"]])+ readFromFile opts handle `shouldReturn` expected+ hClose handle++detectSplitterSpec :: Spec+detectSplitterSpec =+ describe "detectSplitter" $ do++ it "should detect the column splitter space" $ do+ let (headLine, secondLine) = ("c0 c1 c2 c3 c4", "0 1 2 3 4")+ detectSplitter headLine secondLine ' ' `shouldBe` True+ detectSplitter headLine secondLine '\t' `shouldBe` True++ it "should detect the column splitter comma" $ do+ let (headLine, secondLine) = ("c0,c1,c2,c3,c4", "0,1,2,3,4")+ detectSplitter headLine secondLine ',' `shouldBe` True++ it "should detect the column splitter comma even if the column title has spaces" $ do+ let (headLine, secondLine) = ("foo bar baz,qux quux,hoge huga,cmd", "100,200,300,foo bar baz qux")+ detectSplitter headLine secondLine ',' `shouldBe` True++splitFixedSizeSpec :: Spec+splitFixedSizeSpec =+ describe "splitFixedSize" $ do++ it "should split the String with isSpace" $ do+ let (input, expected) = ("c0 c1 c2", [ "c0", "c1", "c2" ])+ splitFixedSize isSpace 0 input `shouldBe` expected++ it "should ignore the successive spaces when splitting with isSpace" $ do+ let (input, expected) = ("c0 c1 c2 \t\t c3", [ "c0", "c1", "c2", "c3" ])+ splitFixedSize isSpace 0 input `shouldBe` expected++ it "should take the column size into account when splitting with isSpace" $ do+ let (input, (n1, expected1), (n2, expected2), (n3, expected3), (n4, expected4))+ = ("c0 c1 c2 \t\t c3 c4 c5 ",+ (1, [ "c0 c1 c2 \t\t c3 c4 c5 " ]),+ (4, [ "c0", "c1", "c2", "c3 c4 c5 " ]),+ (6, [ "c0", "c1", "c2", "c3", "c4", "c5 " ]),+ (9, [ "c0", "c1", "c2", "c3", "c4", "c5", "", "", "" ]))+ splitFixedSize isSpace n1 input `shouldBe` expected1+ splitFixedSize isSpace n2 input `shouldBe` expected2+ splitFixedSize isSpace n3 input `shouldBe` expected3+ splitFixedSize isSpace n4 input `shouldBe` expected4++ it "should split the String with (==',')" $ do+ let (input, expected) = ("c0,c1,c2", [ "c0", "c1", "c2" ])+ splitFixedSize (==',') 0 input `shouldBe` expected++ it "should not ignore the successive commas when splitting with (==',')" $ do+ let (input, expected) = ("c0,c1,c2,,c3,,,c4", [ "c0", "c1", "c2", "", "c3", "", "", "c4" ])+ splitFixedSize (==',') 0 input `shouldBe` expected++ it "should take the column size into account when splitting with (==',')" $ do+ let (input, (n1, expected1), (n2, expected2), (n3, expected3), (n4, expected4))+ = ("c0,c1,,c2,foo bar baz,c4",+ (1, [ "c0,c1,,c2,foo bar baz,c4" ]),+ (4, [ "c0", "c1", "", "c2,foo bar baz,c4" ]),+ (6, [ "c0", "c1", "", "c2", "foo bar baz", "c4" ]),+ (9, [ "c0", "c1", "", "c2", "foo bar baz", "c4", "", "", "" ]))+ splitFixedSize (==',') n1 input `shouldBe` expected1+ splitFixedSize (==',') n2 input `shouldBe` expected2+ splitFixedSize (==',') n3 input `shouldBe` expected3+ splitFixedSize (==',') n4 input `shouldBe` expected4
+ test/MainSpec.hs view
@@ -0,0 +1,38 @@+module MainSpec (spec) where++import Control.Applicative+import Control.Monad+import System.IO+import System.Process+import Test.Hspec (Spec, describe, it, shouldReturn)++spec :: Spec+spec = qhsSpec++qhsSpec :: Spec+qhsSpec =++ describe "qhs" $ do++ let tests = [+ "basic", "columns", "stdin", "header", "where", "tab", "tab2",+ "count", "is_null", "not_null", "output_header", "spaces",+ "output_delimiter", "tab_delimited_output", "multiline",+ "query_file", "empty_query", "empty_query_file", "file_spaces",+ "gzip", "gzip_stdin", "avg", "sum", "avg_sum", "seq",+ "group", "group_sum", "concat", "join", "invalid"+ ]++ forM_ tests $ \test -> do++ it ("should be executed correctly: " ++ test) $ do+ let cp = (shell ("bash " ++ test ++ ".sh")) {+ cwd = Just "test/tests",+ std_out = CreatePipe,+ std_err = CreatePipe+ }+ (_, Just out, Just err, _) <- createProcess cp+ hSetBuffering out NoBuffering+ hSetBuffering err NoBuffering+ outExpected <- readFile $ "test/tests/" ++ test ++ ".out"+ liftA2 (++) (hGetContents out) (hGetContents err) `shouldReturn` outExpected
+ test/ParserSpec.hs view
@@ -0,0 +1,125 @@+module ParserSpec (spec) where++import Data.Either+import qualified Data.Map as Map+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)++import Parser++spec :: Spec+spec = do+ replaceTableNamesSpec+ roughlyExtractTableNamesSpec+ replaceBackTableNamesSpec+ extractTableNamesSpec++replaceTableNamesSpec :: Spec+replaceTableNamesSpec =+ describe "replaceTableNames" $ do++ it "should replace the file names with table names" $ do+ let query = "SELECT * FROM ./table0 WHERE c0 > 0"+ let expected = ("SELECT * FROM d8dc7ec0 WHERE c0 > 0",+ Map.fromList [("./table0", "d8dc7ec0")])+ replaceTableNames query `shouldBe` expected++ it "should replace multiple file names with table names" $ do+ let query = "SELECT * FROM ./src/table0.csv\nJOIN /tmp/table1.csv\tON c1 = c2 WHERE c0 > 0"+ let expected = ("SELECT * FROM d0bf242ceb32ba2b\nJOIN bb239869bdfc764\tON c1 = c2 WHERE c0 > 0",+ Map.fromList [("./src/table0.csv", "d0bf242ceb32ba2b"),("/tmp/table1.csv", "bb239869bdfc764")])+ replaceTableNames query `shouldBe` expected++ it "should replace only the table names" $ do+ let query = "SELECT * FROM ./table0 WHERE c0 LIKE '%foo ./table0 bar%'"+ let expected = ("SELECT * FROM d8dc7ec0 WHERE c0 LIKE '%foo ./table0 bar%'",+ Map.fromList [("./table0", "d8dc7ec0")])+ replaceTableNames query `shouldBe` expected++ it "should take care of multi-byte file names correctly" $ do+ let query = "SELECT * FROM ./テスト"+ let expected = ("SELECT * FROM e4c1e",+ Map.fromList [("./テスト", "e4c1e")])+ replaceTableNames query `shouldBe` expected++ it "should take care of file name whose sha1 hash has only numbers" $ do+ let query = "SELECT * FROM vdbdc.csv"+ let expected = ("SELECT * FROM f8ce01ceb",+ Map.fromList [("vdbdc.csv", "f8ce01ceb")])+ replaceTableNames query `shouldBe` expected++ it "should not replace inside single quotes" $ do+ let query = "SELECT * FROM table0.csv WHERE c0 LIKE '%foo FROM table1.csv bar%'"+ let expected = ("SELECT * FROM ec0f6d989c WHERE c0 LIKE '%foo FROM table1.csv bar%'",+ Map.fromList [("table0.csv", "ec0f6d989c")])+ replaceTableNames query `shouldBe` expected++ it "should not replace inside double quotes" $ do+ let query = "SELECT * FROM table0.csv WHERE c0 LIKE \"%foo FROM table0.csv bar%\""+ let expected = ("SELECT * FROM ec0f6d989c WHERE c0 LIKE \"%foo FROM table0.csv bar%\"",+ Map.fromList [("table0.csv", "ec0f6d989c")])+ replaceTableNames query `shouldBe` expected++ it "should replace the file name containing spaces" $ do+ let query = "SELECT * FROM `foo/bar baz qux/quux.csv`"+ let expected = ("SELECT * FROM a3ecf94bae7d224b52e9ad3df3",+ Map.fromList [("`foo/bar baz qux/quux.csv`", "a3ecf94bae7d224b52e9ad3df3")])+ replaceTableNames query `shouldBe` expected++roughlyExtractTableNamesSpec :: Spec+roughlyExtractTableNamesSpec =+ describe "roughlyExtractTableNames" $ do++ it "should roughly extract table name" $ do+ roughlyExtractTableNames "SELECT * FROM table0 WHERE c0 > 0" `shouldBe` [ "table0" ]+ roughlyExtractTableNames "select * from table0 where c0 > 0" `shouldBe` [ "table0" ]++ it "should roughly extract multiple table names" $ do+ roughlyExtractTableNames "SELECT * FROM table0 JOIN table1 ON c1 = c2 WHERE c0 > 0" `shouldBe` [ "table0", "table1" ]+ roughlyExtractTableNames "select * from table0 join table1 on c1 = c2 where c0 > 0" `shouldBe` [ "table0", "table1" ]++ it "should roughly extract table names but ignore inside quotes" $ do+ roughlyExtractTableNames "SELECT * FROM table0 JOIN table1 ON c1 = c2 WHERE c3 LIKE 'A FROM table3 '" `shouldBe` [ "table0", "table1" ]+ roughlyExtractTableNames "select * from table0 join table1 on c1 = c2 where c3 like 'a from table3 '" `shouldBe` [ "table0", "table1" ]++ it "should roughly extract quoted table names" $ do+ roughlyExtractTableNames "SELECT * FROM `src/table 0 .csv` JOIN '/tmp/table 1.csv'" `shouldBe` [ "`src/table 0 .csv`", "'/tmp/table 1.csv'" ]++replaceBackTableNamesSpec :: Spec+replaceBackTableNamesSpec =+ describe "replaceBackTableNames" $ do++ it "should replace back table names to the file names" $ do+ let query = "SELECT * FROM ./table0 WHERE c0 > 0"+ let (query', tableMap) = replaceTableNames query+ replaceBackTableNames tableMap query' `shouldBe` query++ it "should replace back multiple table names with the file names" $ do+ let query = "SELECT * FROM ./src/table0.csv\nJOIN /tmp/table1.csv\tON c1 = c2 WHERE c0 > 0"+ let (query', tableMap) = replaceTableNames query+ replaceBackTableNames tableMap query' `shouldBe` query++ it "should replace back only the table names" $ do+ let query = "SELECT * FROM ./table0 WHERE c0 LIKE '%foo d8dc7ec0 bar%'"+ let (query', tableMap) = replaceTableNames query+ replaceBackTableNames tableMap query' `shouldBe` query++ it "should replace back the table name to the file name containing spaces" $ do+ let query = "SELECT * FROM `foo/bar baz qux/quux.csv`"+ let (query', tableMap) = replaceTableNames query+ replaceBackTableNames tableMap query' `shouldBe` query++extractTableNamesSpec :: Spec+extractTableNamesSpec =+ describe "extractTableNames" $ do++ it "should extract table name" $ do+ extractTableNames "SELECT * FROM table0 WHERE c0 > 0" "" `shouldBe` Right [ "table0" ]+ extractTableNames "select * from table0 where c0 > 0" "" `shouldBe` Right [ "table0" ]++ it "should extract multiple table names" $ do+ extractTableNames "SELECT * FROM table0 JOIN table1 ON c1 = c2 WHERE c0 > 0" "" `shouldBe` Right [ "table0", "table1" ]+ extractTableNames "select * from table0 join table1 on c1 = c2 where c0 > 0" "" `shouldBe` Right [ "table0", "table1" ]++ it "should return a parse error" $ do+ extractTableNames "SELECT ** FROM table0 WHERE c0 > 0" "" `shouldSatisfy` isLeft+ extractTableNames "SELECT * FROM table0 WHERE > 0" "" `shouldSatisfy` isLeft
+ test/SQLSpec.hs view
@@ -0,0 +1,72 @@+module SQLSpec (spec) where++import Control.Monad+import Test.Hspec (Spec, describe, it, shouldBe)++import SQL+import SQLType++spec :: Spec+spec = do+ openCloseSpec+ tableSpec++openCloseSpec :: Spec+openCloseSpec =+ describe "open, close" $ do++ it "should not throw exception" $ do+ conn <- SQL.open ":memory:"+ SQL.close conn++tableSpec :: Spec+tableSpec =+ describe "createTable, insertRow, execute" $ do++ it "should create a table" $ do+ conn <- SQL.open ":memory:"+ let columns = ["foo", "bar", "baz", "qux"]+ let types = repeat SQLChar+ _ <- SQL.createTable conn "test_table" columns types+ let entries = [ ["c0", "c1", "c2", "c3"],+ ["d0", "d1", "d2", "d3"],+ ["f0", "f1", "f2", "f3"] ]+ forM_ entries $ SQL.insertRow conn "test_table" columns types+ ret <- SQL.execute conn "SELECT * FROM test_table"+ ret `shouldBe` Right (fromColumnsAndEntries columns entries)+ SQL.close conn++ it "should take care of null values in a number column" $ do+ conn <- SQL.open ":memory:"+ let columns = ["foo", "num", "bar", "baz"]+ let types = cycle [SQLChar, SQLInt]+ _ <- SQL.createTable conn "test_table" columns types+ let entries = [ ["c0", "2", "c2", "3"],+ ["d0", "", "d2", "2"],+ ["f0", "3", "f2", ""],+ ["e0", "", "e2", "4"] ]+ forM_ entries $ SQL.insertRow conn "test_table" columns types+ ret0 <- SQL.execute conn "SELECT * FROM test_table"+ ret0 `shouldBe` Right (fromColumnsAndEntries columns entries)+ ret1 <- SQL.execute conn "SELECT * FROM test_table WHERE num IS NOT NULL"+ ret1 `shouldBe` Right (fromColumnsAndEntries columns [e | e <- entries, e !! 1 /= ""])+ ret2 <- SQL.execute conn "SELECT avg(num) FROM test_table"+ ret2 `shouldBe` Right (fromColumnsAndEntries ["avg(num)"] [["2.5"]])+ ret3 <- SQL.execute conn "SELECT avg(baz) FROM test_table"+ ret3 `shouldBe` Right (fromColumnsAndEntries ["avg(baz)"] [["3.0"]])+ SQL.close conn++ it "can create a table when name and column names contain spaces" $ do+ conn <- SQL.open ":memory:"+ let columns = ["foo bar", "baz qux"]+ let types = repeat SQLChar+ _ <- SQL.createTable conn "test table" columns types+ let entries = [ ["c0 c1", "c2 c3"],+ ["d0 d1", "d2 d3"],+ ["f0 f1", "f2 f3"] ]+ forM_ entries $ SQL.insertRow conn "test table" columns types+ ret0 <- SQL.execute conn "SELECT * FROM `test table`"+ ret0 `shouldBe` Right (fromColumnsAndEntries columns entries)+ ret1 <- SQL.execute conn "SELECT `foo bar` FROM `test table`"+ ret1 `shouldBe` Right (fromColumnsAndEntries ["foo bar"] (map (take 1) entries))+ SQL.close conn
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}