WIP: parsing csv

postgrest.cabal

@@ -42,6 +42,7 @@ executable postgrest
                      , blaze-builder
                      , vector
                      , mtl
+                     , cassava
   Other-Modules:       App
                      , Auth
                      , Config
@@ -98,4 +99,5 @@ Test-Suite spec
                      , blaze-builder
                      , vector
                      , mtl
+                     , cassava
                      , process

src/App.hs

@@ -10,12 +10,14 @@ import Data.Maybe (fromMaybe)
 import Text.Regex.TDFA ((=~))
 import Data.Ord (comparing)
 import Data.Ranged.Ranges (emptyRange)
-import Data.HashMap.Strict (keys, elems, filterWithKey, toList)
+import Data.HashMap.Strict (HashMap, keys, elems, filterWithKey, toList, fromList)
 import Data.String.Conversions (cs)
 import Data.List (sortBy)
 import Data.Functor.Identity
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString as BS
+import qualified Data.Csv as CSV
 
 import Network.HTTP.Types.Status
 import Network.HTTP.Types.Header
@@ -98,26 +100,38 @@ app v1schema reqBody req =
             , (hLocation, "/postgrest/users?id=eq." <> cs (userId u))
             ] ""
 
-    ([table], "POST") ->
+    ([table], "POST") -> do
-      handleJsonObj reqBody $ \obj -> do
+      let qt = QualifiedTable schema (cs table)
-        let qt = QualifiedTable schema (cs table)
+          echoRequested = lookup "Prefer" hdrs == Just "return=representation"
-            query = insertInto qt (map cs $ keys obj) [(elems obj)]
+          records :: Either String (CSV.Header, V.Vector (HashMap BS.ByteString BS.ByteString))
-            echoRequested = lookup "Prefer" hdrs == Just "return=representation"
+          records = if lookup "Content-Type" hdrs == Just "text/csv"
-        row <- H.maybeEx query
+                    then CSV.decodeByName reqBody
-        let (Identity insertedJson) = fromMaybe (Identity "{}" :: Identity Text) row
+                    else eitherDecode reqBody >>= \val ->
-            Just inserted = decode (cs insertedJson) :: Maybe Object
+                      case val of
+                        Object obj -> Right (
+                            V.fromList $ map cs $ keys obj
+                          , V.singleton . fromList . map (\(k,v) -> (cs k, cs $ unquoted v)) $ toList obj
+                          )
+                        _ -> Left "Expecting single JSON object or CSV rows"
+          rows = insertInto qt records
+      undefined
+      -- else  do
+      --       query = insertInto qt (map cs $ keys obj) [(elems obj)]
+      --   row <- H.maybeEx query
+      --   let (Identity insertedJson) = fromMaybe (Identity "{}" :: Identity Text) row
+      --       Just inserted = decode (cs insertedJson) :: Maybe Object
 
-        primaryKeys <- map cs <$> primaryKeyColumns qt
+      --   primaryKeys <- map cs <$> primaryKeyColumns qt
-        let primaries = if Prelude.null primaryKeys
+      --   let primaries = if Prelude.null primaryKeys
-            then inserted
+      --       then inserted
-            else filterWithKey (const . (`elem` primaryKeys)) inserted
+      --       else filterWithKey (const . (`elem` primaryKeys)) inserted
-        let params = urlEncodeVars
+      --   let params = urlEncodeVars
-              $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
+      --         $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
-              $ sortBy (comparing fst) $ toList primaries
+      --         $ sortBy (comparing fst) $ toList primaries
-        return $ responseLBS status201
+      --   return $ responseLBS status201
-          [ jsonH
+      --     [ jsonH
-          , (hLocation, "/" <> cs table <> "?" <> cs params)
+      --     , (hLocation, "/" <> cs table <> "?" <> cs params)
-          ] $ if echoRequested then cs insertedJson else ""
+      --     ] $ if echoRequested then cs insertedJson else ""
 
     ([table], "PUT") ->
       handleJsonObj reqBody $ \obj -> do

src/PgQuery.hs

@@ -22,6 +22,7 @@ import Control.Monad (join)
 import Data.String.Conversions (cs)
 import qualified Data.Aeson as JSON
 import qualified Data.List as L
+import qualified Data.Vector as V
 import Data.Scientific (isInteger, formatScientific, FPFormat(..))
 
 type PStmt = H.Stmt P.Postgres
@@ -108,21 +109,24 @@ returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
 deleteFrom :: QualifiedTable -> PStmt
 deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True
 
-insertInto :: QualifiedTable -> [T.Text] -> [[JSON.Value]] -> PStmt
+insertInto :: QualifiedTable
-insertInto t [] _ = B.Stmt
+              -> V.Vector T.Text
-  ("insert into " <> fromQt t <> " default values returning *") empty True
+              -> V.Vector (V.Vector T.Text)
-insertInto t cols vals = B.Stmt
+              -> PStmt
-  ("insert into " <> fromQt t <> " (" <>
+insertInto t cols vals
-    T.intercalate ", " (map pgFmtIdent cols) <>
+  | V.null cols = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True
-    ") values "
+  | otherwise   = B.Stmt
-    <> T.intercalate ", "
+    ("insert into " <> fromQt t <> " (" <>
-      (map (\v -> "("
+      T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
-          <> T.intercalate ", " (map insertableValue v)
+      ") values "
-          <> ")"
+      <> T.intercalate ", "
-        ) vals
+        (V.toList $ V.map (\v -> "("
-      )
+            <> T.intercalate ", " (V.toList $ V.map insertableText v)
-    <> " returning row_to_json(" <> fromQt t <> ".*)")
+            <> ")"
-  empty True
+          ) vals
+        )
+      <> " returning row_to_json(" <> fromQt t <> ".*)")
+    empty True
 
 insertSelect :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
 insertSelect t [] _ = B.Stmt
@@ -264,11 +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 JSON.Null = "null"
+insertableValue = insertableText . unquoted
-insertableValue v = ((<> "::unknown") . pgFmtLit . unquoted) v
 
 paramFilter :: JSON.Value -> T.Text
 paramFilter JSON.Null = "is.null"