diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ # qhs -[![CI Status](https://github.com/itchyny/qhs/actions/workflows/ci.yaml/badge.svg?branch=main)](https://github.com/itchyny/qhs/actions?query=branch:main) +[![CI Status](https://github.com/itchyny/qhs/actions/workflows/ci.yaml/badge.svg?branch=main)](https://github.com/itchyny/qhs/actions/workflows/ci.yaml?query=branch:main) ### SQL queries on CSV and TSV files This is a Haskell implementation of [q](https://github.com/harelba/q) command. @@ -81,7 +81,9 @@ [-t|--tab-delimited] [-p|--pipe-delimited] [-D|--output-delimiter OUTPUT_DELIMITER] [-T|--tab-delimited-output] [-P|--pipe-delimited-output] [-k|--keep-leading-whitespace] - [-z|--gzipped] [-q|--query-filename QUERY_FILENAME] [QUERY] + [-z|--gzipped] [--disable-double-double-quoting] + [--disable-escaped-double-quoting] + [-q|--query-filename QUERY_FILENAME] [QUERY] Available options: -h,--help Show this help text @@ -104,6 +106,16 @@ Keep leading whitespace in values. The leading whitespaces are stripped off by default. -z,--gzipped Assuming the gzipped input. + --disable-double-double-quoting + Disable support for double double-quoting for + escaping the double quote character. By default, you + can use "" inside double quoted fields to escape + double quotes. + --disable-escaped-double-quoting + Disable support for escaped double-quoting for + escaping the double quote character. By default, you + can use \" inside double quoted fields to escape + double quotes. -q,--query-filename QUERY_FILENAME Read query from the provided filename. ``` diff --git a/_qhs b/_qhs --- a/_qhs +++ b/_qhs @@ -5,12 +5,16 @@ _arguments -s -S \ '(-H --skip-header)'{-H,--skip-header}'[use the first row for column names]' \ '(-O --output-header)'{-O,--output-header}'[output the header line]' \ - '(-d --delimiter -t --tab-delimited)'{-d,--delimiter=}'[field delimiter]:DELIMITER' \ - '(-d --delimiter -t --tab-delimited)'{-t,--tab-delimited}'[use tab for field delimiter]' \ - '(-D --output-delimiter -T --tab-delimited-output)'{-D,--output-delimiter=}'[field delimiter of output]:OUTPUT_DELIMITER' \ - '(-D --output-delimiter -T --tab-delimited-output)'{-T,--tab-delimited-output}'[use tab for field delimiter of output]' \ + '(-d --delimiter -t --tab-delimited -p --pipe-delimited)'{-d,--delimiter=}'[field delimiter]:DELIMITER' \ + '(-d --delimiter -t --tab-delimited -p --pipe-delimited)'{-t,--tab-delimited}'[use tab for field delimiter]' \ + '(-d --delimiter -t --tab-delimited -p --pipe-delimited)'{-p,--pipe-delimited}'[use pipe for field delimiter]' \ + '(-D --output-delimiter -T --tab-delimited-output -P --pipe-delimited-output)'{-D,--output-delimiter=}'[field delimiter of output]:OUTPUT_DELIMITER' \ + '(-D --output-delimiter -T --tab-delimited-output -P --pipe-delimited-output)'{-T,--tab-delimited-output}'[use tab for field delimiter of output]' \ + '(-D --output-delimiter -T --tab-delimited-output -P --pipe-delimited-output)'{-P,--pipe-delimited-output}'[use pipe for field delimiter of output]' \ '(-k --keep-leading-whitespace)'{-k,--keep-leading-whitespace}'[keep leading whitespace in values]' \ '(-z --gzipped)'{-z,--gzipped}'[assuming the gzipped input]' \ + '(--disable-double-double-quoting)--disable-double-double-quoting[disable double double-quoting for escaping the double quote]' \ + '(--disable-escaped-double-quoting)--disable-escaped-double-quoting[disable escaped double-quoting for escaping the double quote]' \ '(-q --query-filename 1)'{-q,--query-filename=}'[read query from file]:QUERY_FILENAME:_files' \ '(- 1)'{-v,--version}'[print version]' \ '(- 1)'{-h,--help}'[print help]' \ diff --git a/qhs.cabal b/qhs.cabal --- a/qhs.cabal +++ b/qhs.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: qhs -version: 0.4.3 +version: 0.4.4 category: Console synopsis: Command line tool qhs, SQL queries on CSV and TSV files. description: This is a Haskell port of . diff --git a/src/Qhs/CLI.hs b/src/Qhs/CLI.hs --- a/src/Qhs/CLI.hs +++ b/src/Qhs/CLI.hs @@ -54,7 +54,7 @@ putStrLn $ intercalate outputDelimiter (map escapeField cs) mapM_ (putStrLn . intercalate outputDelimiter . map (escapeField . show)) rs Left err -> do - hPrint stderr err + hPutStrLn stderr $ Parser.replaceBackTableNamesInText tableMap $ show err exitFailure fetchQuery :: Option -> IO String @@ -114,7 +114,7 @@ createTable conn name path columns body = do let probablyNumberColumn = [ all isJust [ readMaybe x :: Maybe Double | x <- xs, not (all isSpace x) ] - | xs <- transpose body ] + | xs <- take (length columns) (transpose body ++ repeat []) ] let types = [ if b then SQLInt else SQLChar | b <- probablyNumberColumn ] SQL.createTable conn name columns types >>= \case Left err -> do diff --git a/src/Qhs/File.hs b/src/Qhs/File.hs --- a/src/Qhs/File.hs +++ b/src/Qhs/File.hs @@ -1,4 +1,5 @@ -module Qhs.File (readFromFile, detectSplitter, splitFixedSize) where +module Qhs.File (readFromFile, detectSplitter, splitFixedSize, + QuoteEscapes(..), defaultQuoteEscapes) where import Codec.Compression.GZip qualified as GZip import Control.Applicative ((<|>)) @@ -16,6 +17,21 @@ import Qhs.Option +-- | The escapes of the double quote character accepted inside a quoted field +data QuoteEscapes = + QuoteEscapes { + doubleDoubleQuoting :: Bool, -- ^ @""@ escapes a double quote + escapedDoubleQuoting :: Bool -- ^ @\\"@ escapes a double quote + } + +-- | Both escapes enabled, the default of the command +defaultQuoteEscapes :: QuoteEscapes +defaultQuoteEscapes = QuoteEscapes { doubleDoubleQuoting = True, escapedDoubleQuoting = True } + +quoteEscapes :: Option -> QuoteEscapes +quoteEscapes opts = QuoteEscapes { doubleDoubleQuoting = not opts.disableDoubleDoubleQuoting, + escapedDoubleQuoting = not opts.disableEscapedDoubleQuoting } + readFromFile :: Option -> Handle -> IO ([String], [[String]]) readFromFile opts handle = do contents <- joinMultiLines . map stripCR . lines <$> @@ -32,17 +48,18 @@ Just [c] -> (==) c _ -> detectSplitter headLine secondLine where (headLine, secondLine) = second (maybe "" head) (uncons contents) - let headColumns = splitFixedSize splitter 0 $ head contents + let headColumns = splitFixedSize escapes splitter 0 $ head contents let size = length headColumns let columns = if opts.skipHeader then headColumns else [ 'c' : show i | i <- [1..size] ] let skipLine = if opts.skipHeader then tail else toList let stripSpaces = if opts.keepLeadingWhiteSpace then id else dropWhile isSpace - let body = filter (not . null) $ map (map stripSpaces . splitFixedSize splitter size) (skipLine contents) + let body = filter (not . null) $ map (map stripSpaces . splitFixedSize escapes splitter size) (skipLine contents) return (columns, body) - where joinMultiLines (cs:ds:css) | valid True cs = cs <| joinMultiLines (ds:css) + where escapes = quoteEscapes opts + 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 + where valid False ('"':'"':xs) | escapes.doubleDoubleQuoting = valid False xs + valid False ('\\':'"':xs) | escapes.escapedDoubleQuoting = valid False xs valid b ('"':xs) = valid (not b) xs valid b (_:xs) = valid b xs valid b "" = b @@ -53,11 +70,12 @@ detectSplitter :: String -> String -> Char -> Bool detectSplitter xs ys = head $ [ s | (x, y, s) <- map splitLines $ toList splitters , 1 < length x && length x <= length y ] `prependList` splitters - where splitLines f = (splitFixedSize f 0 xs, splitFixedSize f 0 ys, f) + where splitLines f = (splitFixedSize defaultQuoteEscapes f 0 xs, + splitFixedSize defaultQuoteEscapes f 0 ys, f) splitters = (==',') :| [isSpace] -splitFixedSize :: (Char -> Bool) -> Int -> String -> [String] -splitFixedSize f n = fill . go n +splitFixedSize :: QuoteEscapes -> (Char -> Bool) -> Int -> String -> [String] +splitFixedSize escapes f n = fill . go n where go _ "" = [] go k (c:cs) | f c = case cs of @@ -65,8 +83,8 @@ [] -> [""] _ -> 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) + where takeQuotedString ('"':'"':xs) | escapes.doubleDoubleQuoting = fmap ('"':) (takeQuotedString xs) + takeQuotedString ('\\':'"':xs) | escapes.escapedDoubleQuoting = fmap ('"':) (takeQuotedString xs) takeQuotedString ('"':xs) = (xs, "") takeQuotedString (x:xs) = fmap (x:) (takeQuotedString xs) takeQuotedString "" = ("", "") diff --git a/src/Qhs/Option.hs b/src/Qhs/Option.hs --- a/src/Qhs/Option.hs +++ b/src/Qhs/Option.hs @@ -6,18 +6,20 @@ -- | Command options data Option = Option { - skipHeader :: Bool, - outputHeader :: Bool, - delimiter :: Maybe String, - tabDelimited :: Bool, - pipeDelimited :: Bool, - outputDelimiter :: Maybe String, - tabDelimitedOutput :: Bool, - pipeDelimitedOutput :: Bool, - keepLeadingWhiteSpace :: Bool, - gzipped :: Bool, - queryFile :: Maybe String, - query :: Maybe String + skipHeader :: Bool, + outputHeader :: Bool, + delimiter :: Maybe String, + tabDelimited :: Bool, + pipeDelimited :: Bool, + outputDelimiter :: Maybe String, + tabDelimitedOutput :: Bool, + pipeDelimitedOutput :: Bool, + keepLeadingWhiteSpace :: Bool, + gzipped :: Bool, + disableDoubleDoubleQuoting :: Bool, + disableEscapedDoubleQuoting :: Bool, + queryFile :: Maybe String, + query :: Maybe String } -- | Option parser @@ -55,6 +57,10 @@ <*> switch (long "gzipped" <> short 'z' <> help "Assuming the gzipped input.") + <*> switch (long "disable-double-double-quoting" + <> help "Disable support for double double-quoting for escaping the double quote character. By default, you can use \"\" inside double quoted fields to escape double quotes.") + <*> switch (long "disable-escaped-double-quoting" + <> help "Disable support for escaped double-quoting for escaping the double quote character. By default, you can use \\\" inside double quoted fields to escape double quotes.") <*> optional (strOption (long "query-filename" <> short 'q' <> metavar "QUERY_FILENAME" diff --git a/src/Qhs/Parser.hs b/src/Qhs/Parser.hs --- a/src/Qhs/Parser.hs +++ b/src/Qhs/Parser.hs @@ -3,6 +3,7 @@ replaceTableNames, roughlyExtractTableNames, replaceBackTableNames, + replaceBackTableNamesInText, extractTableNames, errorString, TableNameMap @@ -69,6 +70,16 @@ replaceBackTableNames :: TableNameMap -> String -> String replaceBackTableNames tableMap = replaceQueryWithTableMap reverseMap where reverseMap = Map.fromList $ map swap $ Map.toList tableMap + +-- | Replace the generated table names back into the original file names, by +-- plain substring substitution. Unlike 'replaceBackTableNames', this does not +-- assume the input is a well-formed query; use it for arbitrary text such as +-- SQLite error messages, where the query is embedded (e.g. inside quotes) and +-- cannot be reliably tokenized. +replaceBackTableNamesInText :: TableNameMap -> String -> String +replaceBackTableNamesInText tableMap text = + Text.unpack $ foldr replace (Text.pack text) (Map.toList tableMap) + where replace (name, gen) = Text.replace (Text.pack gen) (Text.pack name) -- | Extracts the table names using the rigid SQL parser. extractTableNames :: String -> FilePath -> Either Parse.ParseError [String] diff --git a/src/Qhs/SQL.hs b/src/Qhs/SQL.hs --- a/src/Qhs/SQL.hs +++ b/src/Qhs/SQL.hs @@ -34,16 +34,17 @@ -- | Executes a SQL statement. execute :: SQLite.Connection -> String -> IO (Either SomeException ([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 -> - Text.unpack <$> SQLite.columnName stmt (fromInteger i) - return $ (columns,) <$> e +execute conn query = try $ + SQLite.withStatement conn (fromString query) \stmt -> do + cnt <- SQLite.columnCount stmt + columns <- forM [0..cnt-1] (fmap Text.unpack . SQLite.columnName stmt) + let rows = SQLite.nextRow stmt >>= maybe (return []) \row -> (row :) <$> rows + (,) columns <$> rows sqlQuote :: String -> String -sqlQuote xs = "`" ++ xs ++ "`" +sqlQuote xs = "`" ++ concatMap escape xs ++ "`" + where escape '`' = "``" + escape c = [c] tupled :: [String] -> String tupled xs = "(" ++ intercalate ", " xs ++ ")" diff --git a/src/Qhs/SQLType.hs b/src/Qhs/SQLType.hs --- a/src/Qhs/SQLType.hs +++ b/src/Qhs/SQLType.hs @@ -1,6 +1,7 @@ module Qhs.SQLType (SQLType(..), Any, fromColumnsAndEntries) where import Control.Applicative ((<|>)) +import Data.Bits (toIntegralSized) import Data.Maybe (fromMaybe) import Data.String (IsString(..)) import Data.Text qualified as Text @@ -20,7 +21,9 @@ instance ToField (SQLType, String) where toField (SQLChar, cs) = SQLText $ Text.pack cs - toField (SQLInt, cs) = maybe SQLNull SQLFloat $ readMaybe cs + toField (SQLInt, cs) = case toIntegralSized =<< (readMaybe cs :: Maybe Integer) of + Just i -> SQLInteger i + Nothing -> maybe SQLNull SQLFloat $ readMaybe cs data Any = AnyDouble Double | AnyInt Int | AnyString String | AnyNull deriving Eq diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -resolver: lts-24.42 +resolver: lts-24.55 extra-deps: - simple-sql-parser-0.8.0 diff --git a/stack.yaml.lock b/stack.yaml.lock --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -13,7 +13,7 @@ hackage: simple-sql-parser-0.8.0 snapshots: - completed: - sha256: 85363ca92602ef9c8c3f6cfdb188efd3db3209ca3280eea4aad3b38b12a208a1 - size: 729011 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/42.yaml - original: lts-24.42 + sha256: 1c2140555bdf61c30a893b3ec1033987d01eda75ce82a1dda033e8fb6f8b322c + size: 732456 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/55.yaml + original: lts-24.55 diff --git a/test/FileSpec.hs b/test/FileSpec.hs --- a/test/FileSpec.hs +++ b/test/FileSpec.hs @@ -26,6 +26,8 @@ pipeDelimitedOutput = False, keepLeadingWhiteSpace = False, gzipped = False, + disableDoubleDoubleQuoting = False, + disableEscapedDoubleQuoting = False, queryFile = Nothing, query = Nothing } @@ -47,6 +49,12 @@ readFromFile opts handle `shouldReturn` expected hClose handle + it "should treat a backslash as a literal when escaped double-quoting is disabled" do + handle <- openFile "test/tests/escape_backslash_quote.csv" ReadMode + let expected = (["a", "b", "c"], [["1", "x\\\"y\nz", "2"]]) + readFromFile (opts { disableEscapedDoubleQuoting = True }) handle `shouldReturn` expected + hClose handle + detectSplitterSpec :: Spec detectSplitterSpec = describe "detectSplitter" do @@ -67,14 +75,16 @@ splitFixedSizeSpec :: Spec splitFixedSizeSpec = describe "splitFixedSize" do + let noDoubleDoubleQuoting = defaultQuoteEscapes { doubleDoubleQuoting = False } + let noEscapedDoubleQuoting = defaultQuoteEscapes { escapedDoubleQuoting = False } it "should split the String with isSpace" do let (input, expected) = ("c0 c1 c2", [ "c0", "c1", "c2" ]) - splitFixedSize isSpace 0 input `shouldBe` expected + splitFixedSize defaultQuoteEscapes 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 + splitFixedSize defaultQuoteEscapes 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)) @@ -83,24 +93,24 @@ (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 + splitFixedSize defaultQuoteEscapes isSpace n1 input `shouldBe` expected1 + splitFixedSize defaultQuoteEscapes isSpace n2 input `shouldBe` expected2 + splitFixedSize defaultQuoteEscapes isSpace n3 input `shouldBe` expected3 + splitFixedSize defaultQuoteEscapes 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 + splitFixedSize defaultQuoteEscapes (==',') 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 + splitFixedSize defaultQuoteEscapes (==',') 0 input `shouldBe` expected it "should handle trailing delimiters" do - splitFixedSize (=='\t') 0 "foo\t" `shouldBe` [ "foo", "" ] - splitFixedSize (=='\t') 0 "foo\t\t" `shouldBe` [ "foo", "", "" ] - splitFixedSize (==',') 0 "a,b," `shouldBe` [ "a", "b", "" ] - splitFixedSize (==',') 0 "a,," `shouldBe` [ "a", "", "" ] + splitFixedSize defaultQuoteEscapes (=='\t') 0 "foo\t" `shouldBe` [ "foo", "" ] + splitFixedSize defaultQuoteEscapes (=='\t') 0 "foo\t\t" `shouldBe` [ "foo", "", "" ] + splitFixedSize defaultQuoteEscapes (==',') 0 "a,b," `shouldBe` [ "a", "b", "" ] + splitFixedSize defaultQuoteEscapes (==',') 0 "a,," `shouldBe` [ "a", "", "" ] it "should take the column size into account when splitting with (==',')" do let (input, (n1, expected1), (n2, expected2), (n3, expected3), (n4, expected4)) @@ -109,7 +119,34 @@ (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 + splitFixedSize defaultQuoteEscapes (==',') n1 input `shouldBe` expected1 + splitFixedSize defaultQuoteEscapes (==',') n2 input `shouldBe` expected2 + splitFixedSize defaultQuoteEscapes (==',') n3 input `shouldBe` expected3 + splitFixedSize defaultQuoteEscapes (==',') n4 input `shouldBe` expected4 + + it "should accept a backslash-escaped quote inside quotes by default" do + -- 1,"x\"y",2 -- the \" escape yields a literal quote (enabled by default) + splitFixedSize defaultQuoteEscapes (==',') 0 "1,\"x\\\"y\",2" `shouldBe` [ "1", "x\"y", "2" ] + + it "should treat a backslash as a literal when escaped double-quoting is disabled" do + -- 1,"x\""y",2 -- \ is literal and the standard "" escape yields a literal quote + splitFixedSize noEscapedDoubleQuoting (==',') 0 "1,\"x\\\"\"y\",2" `shouldBe` [ "1", "x\\\"y", "2" ] + -- the same input misparses while the \" escape is enabled (the default) + splitFixedSize defaultQuoteEscapes (==',') 0 "1,\"x\\\"\"y\",2" `shouldBe` [ "1", "x\"", "y\"", "2" ] + + it "should accept a doubled quote inside quotes by default" do + -- 1,"x""y",2 -- the "" escape yields a literal quote (enabled by default) + splitFixedSize defaultQuoteEscapes (==',') 0 "1,\"x\"\"y\",2" `shouldBe` [ "1", "x\"y", "2" ] + + it "should end the field at the first quote when double double-quoting is disabled" do + -- 1,"x""y",2 -- "" is no longer an escape, so the field ends at the first quote + splitFixedSize noDoubleDoubleQuoting (==',') 0 "1,\"x\"\"y\",2" `shouldBe` [ "1", "x", "y", "2" ] + -- 1,"x\"y",2 -- the \" escape is still enabled + splitFixedSize noDoubleDoubleQuoting (==',') 0 "1,\"x\\\"y\",2" `shouldBe` [ "1", "x\"y", "2" ] + + it "should have no quote escape when both are disabled" do + let noEscapes = QuoteEscapes { doubleDoubleQuoting = False, escapedDoubleQuoting = False } + -- 1,"x\y",2 -- a backslash is literal and no escape is left + splitFixedSize noEscapes (==',') 0 "1,\"x\\y\",2" `shouldBe` [ "1", "x\\y", "2" ] + -- 1,"x""y",2 -- the field ends at the first quote + splitFixedSize noEscapes (==',') 0 "1,\"x\"\"y\",2" `shouldBe` [ "1", "x", "y", "2" ] diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs --- a/test/ParserSpec.hs +++ b/test/ParserSpec.hs @@ -12,6 +12,7 @@ replaceTableNamesSpec roughlyExtractTableNamesSpec replaceBackTableNamesSpec + replaceBackTableNamesInTextSpec extractTableNamesSpec replaceTableNamesSpec :: Spec @@ -108,6 +109,29 @@ let query = "SELECT * FROM `foo/bar baz qux/quux.csv`" let (query', tableMap) = replaceTableNames query replaceBackTableNames tableMap query' `shouldBe` query + +replaceBackTableNamesInTextSpec :: Spec +replaceBackTableNamesInTextSpec = + describe "replaceBackTableNamesInText" do + + it "should replace a generated table name embedded in error-like text" do + let (query', tableMap) = replaceTableNames "SELECT * FROM ./table0 WHERE c0 > 0" + -- The query is wrapped in quotes, as in a SQLite error message; the + -- query tokenizer of replaceBackTableNames cannot handle this case. + let message = "prepare \"" ++ query' ++ "\": no such column: c1" + replaceBackTableNamesInText tableMap message + `shouldBe` "prepare \"SELECT * FROM ./table0 WHERE c0 > 0\": no such column: c1" + + it "should replace multiple generated table names embedded in text" do + let (query', tableMap) = replaceTableNames "SELECT * FROM ./table0 JOIN ./table1" + let message = "prepare \"" ++ query' ++ "\" failed" + replaceBackTableNamesInText tableMap message + `shouldBe` "prepare \"SELECT * FROM ./table0 JOIN ./table1\" failed" + + it "should leave text without generated names unchanged" do + let (_, tableMap) = replaceTableNames "SELECT * FROM ./table0" + replaceBackTableNamesInText tableMap "no table names here" + `shouldBe` "no table names here" extractTableNamesSpec :: Spec extractTableNamesSpec = diff --git a/test/QhsSpec.hs b/test/QhsSpec.hs --- a/test/QhsSpec.hs +++ b/test/QhsSpec.hs @@ -20,9 +20,10 @@ "pipe_delimited", "pipe_delimited_output", "delimiters", "query_file", "empty_query", "empty_query_file", "file_spaces", "gzip", "gzip_stdin", "avg", "sum", "avg_sum", "seq", - "group", "group_sum", "concat", "join", "invalid", + "group", "group_sum", "concat", "join", "invalid", "invalid_column", "multiline_output", "escape_delimiter", "escape_custom_delimiter", - "escape_quotes", "escape_carriage_return" + "escape_quotes", "escape_carriage_return", "backtick", "header_only", + "escape_backslash_quote", "escape_double_double_quote", "large_integer" ] forM_ tests \test -> do diff --git a/test/SQLSpec.hs b/test/SQLSpec.hs --- a/test/SQLSpec.hs +++ b/test/SQLSpec.hs @@ -1,6 +1,7 @@ module SQLSpec (spec) where import Control.Monad +import Data.Either (isLeft) import Data.Either.Extra (fromRight') import Test.Hspec (Spec, describe, it, shouldBe) @@ -70,4 +71,19 @@ fromRight' ret0 `shouldBe` fromColumnsAndEntries columns entries ret1 <- SQL.execute conn "SELECT `foo bar` FROM `test table`" fromRight' ret1 `shouldBe` fromColumnsAndEntries ["foo bar"] (map (take 1) entries) + SQL.close conn + + it "should return Left instead of throwing on an invalid query" do + conn <- SQL.open ":memory:" + let columns = ["foo", "bar"] + let types = repeat SQLChar + _ <- SQL.createTable conn "test_table" columns types + _ <- SQL.insertRow conn "test_table" columns types ["a", "b"] + retBadColumn <- SQL.execute conn "SELECT nonexistent FROM test_table" + isLeft retBadColumn `shouldBe` True + retSyntaxError <- SQL.execute conn "SELECT * FROM" + isLeft retSyntaxError `shouldBe` True + -- The connection is still usable after a failed query. + retValid <- SQL.execute conn "SELECT foo FROM test_table" + fromRight' retValid `shouldBe` fromColumnsAndEntries ["foo"] [["a"]] SQL.close conn diff --git a/test/tests/backtick.csv b/test/tests/backtick.csv new file mode 100644 --- /dev/null +++ b/test/tests/backtick.csv @@ -0,0 +1,4 @@ +foo`bar,baz +a0,a2 +b0,b2 +c0,c2 diff --git a/test/tests/backtick.out b/test/tests/backtick.out new file mode 100644 --- /dev/null +++ b/test/tests/backtick.out @@ -0,0 +1,4 @@ +foo`bar +a0 +b0 +c0 diff --git a/test/tests/backtick.sh b/test/tests/backtick.sh new file mode 100644 --- /dev/null +++ b/test/tests/backtick.sh @@ -0,0 +1,1 @@ +qhs -H -O 'SELECT `foo``bar` FROM backtick.csv' diff --git a/test/tests/escape_backslash_quote.csv b/test/tests/escape_backslash_quote.csv new file mode 100644 --- /dev/null +++ b/test/tests/escape_backslash_quote.csv @@ -0,0 +1,3 @@ +a,b,c +1,"x\""y +z",2 diff --git a/test/tests/escape_backslash_quote.out b/test/tests/escape_backslash_quote.out new file mode 100644 --- /dev/null +++ b/test/tests/escape_backslash_quote.out @@ -0,0 +1,2 @@ +1 "x\""y +z" 2 diff --git a/test/tests/escape_backslash_quote.sh b/test/tests/escape_backslash_quote.sh new file mode 100644 --- /dev/null +++ b/test/tests/escape_backslash_quote.sh @@ -0,0 +1,1 @@ +qhs -H --disable-escaped-double-quoting "SELECT * FROM escape_backslash_quote.csv" diff --git a/test/tests/escape_double_double_quote.csv b/test/tests/escape_double_double_quote.csv new file mode 100644 --- /dev/null +++ b/test/tests/escape_double_double_quote.csv @@ -0,0 +1,2 @@ +a,b,c,d +1,"x""y",2 diff --git a/test/tests/escape_double_double_quote.out b/test/tests/escape_double_double_quote.out new file mode 100644 --- /dev/null +++ b/test/tests/escape_double_double_quote.out @@ -0,0 +1,1 @@ +1 x y 2 diff --git a/test/tests/escape_double_double_quote.sh b/test/tests/escape_double_double_quote.sh new file mode 100644 --- /dev/null +++ b/test/tests/escape_double_double_quote.sh @@ -0,0 +1,1 @@ +qhs -H --disable-double-double-quoting "SELECT * FROM escape_double_double_quote.csv" diff --git a/test/tests/header_only.csv b/test/tests/header_only.csv new file mode 100644 --- /dev/null +++ b/test/tests/header_only.csv @@ -0,0 +1,1 @@ +foo,bar,baz diff --git a/test/tests/header_only.out b/test/tests/header_only.out new file mode 100644 --- /dev/null +++ b/test/tests/header_only.out @@ -0,0 +1,1 @@ +foo bar baz diff --git a/test/tests/header_only.sh b/test/tests/header_only.sh new file mode 100644 --- /dev/null +++ b/test/tests/header_only.sh @@ -0,0 +1,1 @@ +qhs -H -O "SELECT * FROM header_only.csv" diff --git a/test/tests/invalid_column.out b/test/tests/invalid_column.out new file mode 100644 --- /dev/null +++ b/test/tests/invalid_column.out @@ -0,0 +1,1 @@ +SQLite3 returned ErrorError while attempting to perform prepare "SELECT c1, nonexistent FROM basic.csv": no such column: nonexistent diff --git a/test/tests/invalid_column.sh b/test/tests/invalid_column.sh new file mode 100644 --- /dev/null +++ b/test/tests/invalid_column.sh @@ -0,0 +1,1 @@ +qhs "SELECT c1, nonexistent FROM basic.csv" diff --git a/test/tests/large_integer.csv b/test/tests/large_integer.csv new file mode 100644 --- /dev/null +++ b/test/tests/large_integer.csv @@ -0,0 +1,3 @@ +id,label +9007199254740993,a +12345678901234567,b diff --git a/test/tests/large_integer.out b/test/tests/large_integer.out new file mode 100644 --- /dev/null +++ b/test/tests/large_integer.out @@ -0,0 +1,3 @@ +id label +9007199254740993 a +12345678901234567 b diff --git a/test/tests/large_integer.sh b/test/tests/large_integer.sh new file mode 100644 --- /dev/null +++ b/test/tests/large_integer.sh @@ -0,0 +1,1 @@ +qhs -H -O "SELECT * FROM large_integer.csv"