diff options
Diffstat (limited to 'backend/app/Main.hs')
| -rw-r--r-- | backend/app/Main.hs | 32 |
1 files changed, 25 insertions, 7 deletions
diff --git a/backend/app/Main.hs b/backend/app/Main.hs index 3f0072b..2b461e5 100644 --- a/backend/app/Main.hs +++ b/backend/app/Main.hs @@ -33,6 +33,7 @@ import Data.Tagged (Tagged (..), untag) import Data.Text qualified as T import Data.UUID qualified as U import Data.UUID.V4 qualified as U +import Data.Vector qualified as V import Git qualified as G import Git.Libgit2 qualified as GB import Network.HTTP.Types.Status qualified as W @@ -173,7 +174,7 @@ initRepo root ref = do M.toList . M.unionsWith (++) $ map (\f -> M.singleton (takeDirectory f) [f]) fs colls <- forM cls $ \(path, files) -> do - (value : values) <- do + J.Array (V.toList -> (value : values)) <- do liftIO . Q.withStore root ref . Q.withCommit cid $ do Q.query (fromString ("SELECT " <> path <> " FROM " <> path)) let schema = U.autoTypes' value values @@ -405,18 +406,32 @@ restApi root ref repoT app req resp = do =<< ( Q.withStore root ref $ Q.withCommit rev do Q.query (fromString (printf "SELECT %s FROM %s" c c)) ) + ("GET", ["collection", c, "paginated", read @Int . T.unpack -> limit, read @Int . T.unpack -> offset]) -> do + resp . W.responseLBS W.status200 [] . J.encode + =<< ( Q.withStore root ref $ Q.withCommit rev do + Q.query + ( fromString + ( printf + "SELECT %s FROM %s%s%s" + c + c + (printf " LIMIT %d" limit :: String) + (printf " OFFSET %d" offset :: String) + ) + ) + ) ("GET", ["collection", c, i]) -> do - resp . W.responseLBS W.status200 [] . J.encode . headMay + resp . W.responseLBS W.status200 [] . J.encode . arrayHead =<< ( Q.withStore root ref $ Q.withCommit rev do Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) ) ("PUT", ["collection", c, i]) -> do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" o <- J.throwDecode @J.Object =<< W.lazyRequestBody req - resp . W.responseLBS W.status200 [] . J.encode . headMay + resp . W.responseLBS W.status200 [] . J.encode . arrayHead =<< ( Q.withStore root ref do _ <- Q.query (fromString (printf "UPDATE %s SET %s WHERE %s.$fileName == \"%s\"" c (LB.toString (J.encode o)) c i)) - [J.Object r] <- Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) + J.Array (V.toList -> [J.Object r]) <- Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) _ <- Q.query (fromString (printf "INSERT %s INTO %s" (LB.toString (J.encode (dropNulls r))) c)) _ <- buildRefMap Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) @@ -425,15 +440,15 @@ restApi root ref repoT app req resp = do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" i <- ((<> ".json") . U.toText) <$> getUUID o <- fmap dropNulls . J.throwDecode @J.Object =<< W.lazyRequestBody req - resp . W.responseLBS W.status200 [] . J.encode + resp . W.responseLBS W.status200 [] . J.encode . arrayHead =<< ( Q.withStore root ref do _ <- Q.query (fromString (printf "INSERT %s INTO %s" (LB.toString (J.encode (JM.insert "$fileName" (J.String i) o))) c)) _ <- buildRefMap - headMay <$> Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) + Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) ) ("DELETE", ["collection", c, i]) -> do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" - resp . W.responseLBS W.status200 [] . J.encode . headMay + resp . W.responseLBS W.status200 [] . J.encode . arrayHead =<< ( Q.withStore root ref do r <- Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) Q.query (fromString (printf "DELETE FROM %s WHERE %s.$fileName == \"%s\"" c c i)) @@ -461,3 +476,6 @@ dropNulls = (J.Object v') -> Just (J.Object (dropNulls v')) _ -> Just v ) + +arrayHead :: J.Value -> J.Value +arrayHead (J.Array v) = V.head v |