diff --git a/src/App.hs b/src/App.hs index 6a4d2aa76..888fd0412 100644 --- a/src/App.hs +++ b/src/App.hs @@ -104,16 +104,16 @@ app v1schema reqBody req = ([table], "POST") -> do let qt = QualifiedTable schema (cs table) echoRequested = lookup "Prefer" hdrs == Just "return=representation" - parsed :: Either String (V.Vector Text, V.Vector (V.Vector Text)) + parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value)) parsed = if lookup "Content-Type" hdrs == Just "text/csv" then do rows <- CSV.decode CSV.NoHeader reqBody if V.null rows then Left "CSV requires header" - else Right (V.head rows, V.tail rows) + else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows)) else eitherDecode reqBody >>= \val -> case val of Object obj -> Right . second V.singleton . V.unzip . V.fromList $ - M.toList (M.map unquoted obj) + M.toList obj _ -> Left "Expecting single JSON object or CSV rows" case parsed of Left err -> return $ responseLBS status400 [] $ @@ -244,6 +244,10 @@ handleJsonObj reqBody handler = do jErr = encode . object $ [("message", String "Expecting a JSON object")] +parseCsvCell :: BL.ByteString -> Value +parseCsvCell s = + either (const $ String "") id (eitherDecode s) + multipart :: Status -> [Response] -> Response multipart _ [] = responseLBS status204 [] "" multipart _ [r] = r diff --git a/src/PgQuery.hs b/src/PgQuery.hs index 76009c98f..9e97decfe 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -111,7 +111,7 @@ deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True insertInto :: QualifiedTable -> V.Vector T.Text - -> V.Vector (V.Vector T.Text) + -> V.Vector (V.Vector JSON.Value) -> PStmt insertInto t cols vals | V.null cols = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True @@ -121,7 +121,7 @@ insertInto t cols vals ") values " <> T.intercalate ", " (V.toList $ V.map (\v -> "(" - <> T.intercalate ", " (V.toList $ V.map insertableText v) + <> T.intercalate ", " (V.toList $ V.map insertableValue v) <> ")" ) vals ) @@ -268,14 +268,14 @@ unquoted (JSON.String t) = t unquoted (JSON.Number n) = cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n unquoted (JSON.Bool b) = cs . show $ b -unquoted JSON.Null = "null" unquoted _ = "" insertableText :: T.Text -> T.Text insertableText = (<> "::unknown") . pgFmtLit insertableValue :: JSON.Value -> T.Text -insertableValue = insertableText . unquoted +insertableValue JSON.Null = "null" +insertableValue v = insertableText $ unquoted v paramFilter :: JSON.Value -> T.Text paramFilter JSON.Null = "is.null"