diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/qhs.cabal b/qhs.cabal new file mode 100644 --- /dev/null +++ b/qhs.cabal @@ -0,0 +1,68 @@ +name: qhs +version: 0.3.2 +author: itchyny +maintainer: 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 diff --git a/src/File.hs b/src/File.hs new file mode 100644 --- /dev/null +++ b/src/File.hs @@ -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) "" diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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 "<>" 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 diff --git a/src/Option.hs b/src/Option.hs new file mode 100644 --- /dev/null +++ b/src/Option.hs @@ -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 diff --git a/src/Parser.hs b/src/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Parser.hs @@ -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 diff --git a/src/SQL.hs b/src/SQL.hs new file mode 100644 --- /dev/null +++ b/src/SQL.hs @@ -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) ++ ")" diff --git a/src/SQLType.hs b/src/SQLType.hs new file mode 100644 --- /dev/null +++ b/src/SQLType.hs @@ -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) diff --git a/test/FileSpec.hs b/test/FileSpec.hs new file mode 100644 --- /dev/null +++ b/test/FileSpec.hs @@ -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 diff --git a/test/MainSpec.hs b/test/MainSpec.hs new file mode 100644 --- /dev/null +++ b/test/MainSpec.hs @@ -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 diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/ParserSpec.hs @@ -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 diff --git a/test/SQLSpec.hs b/test/SQLSpec.hs new file mode 100644 --- /dev/null +++ b/test/SQLSpec.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}