diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2014 Daniel Choi + +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/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +module Main where +import Data.Aeson +import Data.Monoid +import qualified Data.Map.Strict as M +import Data.Text (Text) +import qualified Data.Text.Encoding as T (decodeUtf8) +import Data.List (intersperse) +import qualified Data.List +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy.IO as TL +import Data.Maybe (catMaybes) +import Control.Applicative +import Control.Monad (when) +import Data.ByteString.Lazy as BL hiding (map, intersperse) +import qualified Data.ByteString.Lazy.Char8 as BS +import qualified Data.Attoparsec.Lazy as LA hiding (Result, parseOnly) +import Data.Attoparsec.ByteString.Char8 (endOfLine, sepBy) +import Data.Attoparsec.Text +import qualified Data.HashMap.Lazy as HM +import qualified Data.Vector as V +import Data.Scientific +import System.Environment (getArgs) +import qualified Data.Text.Lazy.Builder as B +import qualified Data.Text.Lazy.Builder.Int as B +import qualified Data.Text.Lazy.Builder.RealFloat as B +import qualified Options.Applicative as O +import Data.String.QQ +import Test.HUnit + +data Options = Options { + template :: Template + } deriving Show + +data Template = TemplateFile FilePath | TemplateText Text deriving (Show) + +parseOpts :: O.Parser Options +parseOpts = Options <$> (tmplText <|> tmplFile) + +tmplText = TemplateText . T.pack <$> O.argument O.str (O.metavar "TEMPLATE") +tmplFile = TemplateFile + <$> O.strOption (O.metavar "FILE" <> O.short 'f' <> O.help "Template file") + +opts = O.info (O.helper <*> parseOpts) + (O.fullDesc + <> O.progDesc "Inject JSON into SQL template strings" + <> O.header "jsonsql") + +main = do + Options tmpl <- O.execParser opts + template <- case tmpl of + TemplateFile fp -> T.readFile fp + TemplateText t -> return t + x <- BL.getContents + let vs :: [Value] + vs = decodeStream x + chunks :: [Chunk] + chunks = parseText template + results = mconcat $ map (evalText chunks) vs + TL.putStrLn . B.toLazyText $ results + +decodeStream :: (FromJSON a) => BL.ByteString -> [a] +decodeStream bs = case decodeWith json bs of + (Just x, xs) | xs == mempty -> [x] + (Just x, xs) -> x:(decodeStream xs) + (Nothing, _) -> [] + +decodeWith :: (FromJSON a) => LA.Parser Value -> BL.ByteString -> (Maybe a, BL.ByteString) +decodeWith p s = + case LA.parse p s of + LA.Done r v -> f v r + LA.Fail _ _ _ -> (Nothing, mempty) + where f v' r = (\x -> case x of + Success a -> (Just a, r) + _ -> (Nothing, r)) $ fromJSON v' + + +data ArrayFormat = ArrayFormat { + arrDelimiter :: Text + , arrPrefixStr :: Text -- can me mempty + , arrPostFixStr :: Text + } deriving (Show, Eq) + +data Chunk = Pass Text | Expr KeyPath deriving (Show, Eq) +data KeyPath = KeyPath [Key] ArrayFormat deriving (Show, Eq) -- Text fields are array item prefix and postfix strings, which is given at end +data Key = Key Text | Index Int deriving (Eq, Show) + +evalText :: [Chunk] -> Value -> B.Builder +evalText xs v = mconcat $ map (B.fromText . evalChunk v) xs + +evalChunk :: Value -> Chunk -> Text +evalChunk v (Pass s) = s +evalChunk v (Expr k) = evalToText k v + +evalToText :: KeyPath -> Value -> Text +evalToText k v = valToText $ evalKeyPath k v + +evalToUnescapedText :: KeyPath -> Value -> Text +evalToUnescapedText k v = valToUnescapedText $ evalKeyPath k v + +-- evaluates the a JS key path against a Value context to a leaf Value +evalKeyPath :: KeyPath -> Value -> Value +evalKeyPath (KeyPath [] _) x@(String _) = x +evalKeyPath (KeyPath [] _) x@Null = x +evalKeyPath (KeyPath [] _) x@(Number _) = x +evalKeyPath (KeyPath [] _) x@(Bool _) = x +evalKeyPath (KeyPath [] _) x@(Object _) = x +evalKeyPath (KeyPath (Key key:ks) a) (Object s) = + case (HM.lookup key s) of + Just x -> evalKeyPath (KeyPath ks a) x + Nothing -> Null +evalKeyPath (KeyPath (Index idx:ks) a) (Array v) = + let e = (V.!?) v idx + in case e of + Just e' -> evalKeyPath (KeyPath ks a) e' + Nothing -> Null +evalKeyPath k@(KeyPath _ ArrayFormat {..}) (Array v) = + let vs = V.toList v + f = (\v' -> escapeText $ arrPrefixStr <> evalToUnescapedText k v' <> arrPostFixStr) + result = mconcat . intersperse arrDelimiter $ map f vs + in (String result) +evalKeyPath (KeyPath (Index _:_) _ ) _ = Null +evalKeyPath _ _ = Null + +valToUnescapedText :: Value -> Text +valToUnescapedText (String x) = x +valToUnescapedText x = valToText x + +escapeText = T.pack . escapeStringLiteral . T.unpack + +valToText :: Value -> Text +valToText (String x) = T.singleton '\'' + <> (escapeText x) + <> T.singleton '\'' +valToText Null = "NULL" +valToText (Bool True) = "TRUE" +valToText (Bool False) = "FALSE" +valToText (Number x) = + case floatingOrInteger x of + Left float -> T.pack . show $ float + Right int -> T.pack . show $ int +valToText x@(Object _) = error $ "Cannot interpolate " ++ show x + +escapeStringLiteral :: String -> String +escapeStringLiteral ('\'':xs) = '\'': ('\'' : escapeStringLiteral xs) +escapeStringLiteral (x:xs) = x : escapeStringLiteral xs +escapeStringLiteral [] = [] + +parseText :: Text -> [Chunk] +parseText = either error id . parseOnly (many textChunk) + +textChunk = exprChunk <|> passChunk + +identifierChar = inClass "a-zA-Z_.[]0-9" + +exprChunk :: Parser Chunk +exprChunk = do + try (char ':') + x <- notChar ':' + xs <- takeWhile1 identifierChar + arrFormat <- pArrayFormat + let kp = parseKeyPath (T.singleton x <> xs) arrFormat + return $ Expr kp + +passChunk :: Parser Chunk +passChunk = Pass <$> takeWhile1 (notInClass ":") + +parseKeyPath :: Text -> ArrayFormat -> KeyPath +parseKeyPath s a = case parseOnly pKeys s of + Left err -> error $ "Error parsing key path: " ++ T.unpack s ++ " error: " ++ err + Right res -> KeyPath res a + +pKeys :: Parser [Key] +pKeys = do + keys <- sepBy1 pKeyOrIndex (takeWhile1 $ inClass ".[") + return keys + +-- | syntax is {delimiter-string!prefix-string!postfix-string} +-- immediately after last key +-- e.g. {,!!} +pArrayFormat :: Parser ArrayFormat +pArrayFormat = do + try (do + char '{' + delimiter <- T.pack <$> manyTill anyChar (char '!') + pre <- T.pack <$> manyTill anyChar (char '!') + post <- T.pack <$> manyTill anyChar (char '}') + return $ ArrayFormat delimiter pre post) + <|> pure defArrayFormat + +defArrayFormat = ArrayFormat "," "" "" + +pKeyOrIndex = pIndex <|> pKey + +pKey = Key <$> takeWhile1 (notInClass " .[") + +pIndex = Index <$> decimal <* char ']' + +------------------------------------------------------------------------ +-- Tests + +runTests = runTestTT tests + +tests = test [ + "testOne" + ~: [] + @=? parseText "VALUES (:title, :year, :ratings.imdb)" + , "test complex key" + ~: [] + @=? parseText "values (:imdb, :versions.Rental.HD[0]);" + ] + diff --git a/NOTES b/NOTES new file mode 100644 --- /dev/null +++ b/NOTES @@ -0,0 +1,160 @@ + +String literals + +mysql +- http://dev.mysql.com/doc/refman/5.0/en/string-literals.html +postgres +- http://www.postgresql.org/docs/8.2/static/sql-syntax-lexical.html +sqlite3 +- https://www.sqlite.org/lang_expr.html + +------------------------------------------------------------------------ +Postgres + + +A string constant in SQL is an arbitrary sequence of characters bounded by +single quotes ('), for example 'This is a string'. To include a single-quote +character within a string constant, write two adjacent single quotes, e.g. +'Dianne''s horse'. Note that this is not the same as a double-quote character +("). + +Two string constants that are only separated by whitespace with at least one +newline are concatenated and effectively treated as if the string had been +written as one constant. For example: + +SELECT 'foo' +'bar'; +is equivalent to + +SELECT 'foobar'; + +but + +SELECT 'foo' 'bar'; + +is not valid syntax. (This slightly bizarre behavior is specified by SQL; +PostgreSQL is following the standard.) + +PostgreSQL also accepts "escape" string constants, which are an extension to +the SQL standard. An escape string constant is specified by writing the letter +E (upper or lower case) just before the opening single quote, e.g. E'foo'. +(When continuing an escape string constant across lines, write E only before +the first opening quote.) Within an escape string, a backslash character (\) +begins a C-like backslash escape sequence, in which the combination of +backslash and following character(s) represents a special byte value. \b is a +backspace, \f is a form feed, \n is a newline, \r is a carriage return, \t is a +tab. Also supported are \digits, where digits represents an octal byte value, +and \xhexdigits, where hexdigits represents a hexadecimal byte value. (It is +your responsibility that the byte sequences you create are valid characters in +the server character set encoding.) Any other character following a backslash +is taken literally. Thus, to include a backslash character, write two +backslashes (\\). Also, a single quote can be included in an escape string by +writing \', in addition to the normal way of ''. + + + +MySQL + +A string is a sequence of bytes or characters, enclosed within either single +quote (“'”) or double quote (“"”) characters. Examples: + +'a string' +"another string" + +Quoted strings placed next to each other are concatenated to a single string. +The following lines are equivalent: + +'a string' +'a' ' ' 'string' + +If the ANSI_QUOTES SQL mode is enabled, string literals can be quoted only +within single quotation marks because a string quoted within double quotation +marks is interpreted as an identifier. + +Within a string, certain sequences have special meaning unless the +NO_BACKSLASH_ESCAPES SQL mode is enabled. Each of these sequences begins with a +backslash (“\”), known as the escape character. MySQL recognizes the escape +sequences shown in Table 9.1, “Special Character Escape Sequences”. For all +other escape sequences, backslash is ignored. That is, the escaped character is +interpreted as if it was not escaped. For example, “\x” is just “x”. These +sequences are case sensitive. For example, “\b” is interpreted as a backspace, +but “\B” is interpreted as “B”. Escape processing is done according to the +character set indicated by the character_set_connection system variable. This +is true even for strings that are preceded by an introducer that indicates a +different character set, as discussed in Section 10.1.3.5, “Character String +Literal Character Set and Collation”. + +Table 9.1 Special Character Escape Sequences + +Escape Sequence Character Represented by Sequence +\0 An ASCII NUL (0x00) character. +\' A single quote (“'”) character. +\" A double quote (“"”) character. +\b A backspace character. +\n A newline (linefeed) character. +\r A carriage return character. +\t A tab character. +\Z ASCII 26 (Control+Z). See note following the table. +\\ A backslash (“\”) character. +\% A “%” character. See note following the table. +\_ A “_” character. See note following the table. + + + +Sqlite3: + +A string constant is formed by enclosing the string in single quotes ('). A +single quote within the string can be encoded by putting two single quotes in a +row - as in Pascal. C-style escapes using the backslash character are not +supported because they are not standard SQL. + +BLOB literals are string literals containing hexadecimal data and preceded by a +single "x" or "X" character. Example: X'53514C697465' + +A literal value can also be the token "NULL". + + + +Real World Haskell + +A second problem involves escaping characters. What if you wanted to insert the +string "I don't like 1"? SQL uses the single quote character to show the end of +the field. Most SQL databases would require you to write this as 'I don''t like +1'. But rules for other special characters such as backslashes differ between +databases. Rather than trying to code this yourself, HDBC can handle it all for +you. Let's look at an example. 4 comments + + + + +http://book.realworldhaskell.org/read/efficient-file-processing-regular-expressions-and-file-name-matching.html + +-- file: ch08/GlobRegex.hs +globToRegex' :: String -> String +globToRegex' "" = "" + +globToRegex' ('*':cs) = ".*" ++ globToRegex' cs + +globToRegex' ('?':cs) = '.' : globToRegex' cs + +globToRegex' ('[':'!':c:cs) = "[^" ++ c : charClass cs +globToRegex' ('[':c:cs) = '[' : c : charClass cs +globToRegex' ('[':_) = error "unterminated character class" + +globToRegex' (c:cs) = escape c ++ globToRegex' cs + + +-- file: ch08/GlobRegex.hs +escape :: Char -> String +escape c | c `elem` regexChars = '\\' : [c] + | otherwise = [c] + where regexChars = "\\+()^$.{}]|" + +-- file: ch08/GlobRegex.hs +charClass :: String -> String +charClass (']':cs) = ']' : globToRegex' cs +charClass (c:cs) = c : charClass cs +charClass [] = error "unterminated character class" + + +Dates? diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,114 @@ +# jsonsql + +Interpolates JSON data into SQL strings from the command line. For generating +SQL statements to pass to DB client programs like `psql`, `mysql`, and +`sqlite3` via Unix pipelines or shell scripts. A faster, lighter-weight +alternative to writing ad-hoc, monolithic programs with database and ORM +libraries. + +A template file with this interpolation syntax: + + INSERT into titles (title, year, rating, created) + VALUES (:title, :year, :ratings.imdb, DEFAULT); + +combined with this JSON stream on STDIN + +```json +{ + "title": "Terminator 2: 'Judgment Day'", + "year": 1991, + "stars": [ + {"name": "Arnold Schwarzenegger"}, + {"name": "Linda Hamilton"} + ], + "ratings": { + "imdb": 8.5 + }, + "created": "2014-12-04T10:10:10Z" + +} +{ + "title": "Interstellar", + "year": 2014, + "stars": [ + {"name":"Matthew McConaughey"}, + {"name":"Anne Hathaway"} + ], + "ratings": { + "imdb": 8.9 + } +} +``` + +generates this output: + + INSERT into titles (title, year, rating, created) + VALUES ('Terminator 2: ''Judgment Day''', 1991, 8.5, DEFAULT); + INSERT into titles (title, year, rating, created) + VALUES ('Interstellar', 2014, 8.9, DEFAULT); + +## Usage + + +``` +jsonsql + +Usage: jsonsql (TEMPLATE | -f FILE) + Inject JSON into SQL template strings + +Available options: + -h,--help Show this help text + -f FILE Template file +``` + +## Array joining + +If a key path evaluates to an array of values, the values are converted +into strings, joined by a delimiter, and then output as a string. The +default delimiter is a comma: + +``` +INSERT into titles (title, year, rating, stars, created) +VALUES (:title, :year, :ratings.imdb, :stars.name, DEFAULT); +``` + +``` +INSERT into titles (title, year, rating, stars, created) +VALUES ('Terminator 2: ''Judgment Day''', 1991, 8.5, 'Arnold Schwarzenegger,Linda Hamilton', DEFAULT); +INSERT into titles (title, year, rating, stars, created) +VALUES ('Interstellar', 2014, 8.9, 'Matthew McConaughey,Anne Hathaway', DEFAULT); +``` + +A key path that terminates in an array can be followed by an array formatting expression: + +``` +{delimiter-string!prefix-sring!postfix-string} +``` + + +template: +``` +INSERT into titles (title, year, rating, stars, created) +VALUES (:title, :year, :ratings.imdb, :stars.name{;!$!$}, DEFAULT); +``` + +output: +``` +INSERT into titles (title, year, rating, stars, created) +VALUES ('Terminator 2: ''Judgment Day''', 1991, 8.5, '$Arnold Schwarzenegger$;$Linda Hamilton$', DEFAULT); +INSERT into titles (title, year, rating, stars, created) +VALUES ('Interstellar', 2014, 8.9, '$Matthew McConaughey$;$Anne Hathaway$', DEFAULT); +``` + +Adding a prefix and postfix may be useful if you want to mark strings +for downstream pipeline processing with tools like `sed` before reaching +the database. + +The usefulness of this feature may be obscure. But the author needed it to +change an array of strings like `["apple","banana","pear"]` into a string field +containing a series of integer IDs like `'1,2,3'`. This type of field was then +indexed by the Sphinx search engine in a multi-valued attribute. + +## Author + +* Daniel Choi 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/jsonsql.cabal b/jsonsql.cabal new file mode 100644 --- /dev/null +++ b/jsonsql.cabal @@ -0,0 +1,34 @@ +-- Initial jsonsql.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: jsonsql +version: 0.1.0.1 +synopsis: Interpolate JSON object values into SQL strings +-- description: +homepage: https://github.com/danchoi/jsonsql +license: MIT +license-file: LICENSE +author: Daniel Choi +maintainer: dhchoi@gmail.com +copyright: (c) 2014 Daniel Choi +category: Text +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +executable jsonsql + main-is: Main.hs + build-depends: base >=4.6 && <4.8 + , aeson >= 0.8.0.1 + , unordered-containers + , containers + , text >= 1.1.0.0 + , bytestring + , attoparsec >= 0.10.4.0 + , vector >= 0.10.9.0 + , scientific + , optparse-applicative + , string-qq + , HUnit + + default-language: Haskell2010