From 9b0adc976101bc4f375b05cc475478187c595714 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Wed, 18 Dec 2024 19:11:03 +0100
Subject: add pagination to rest api

---
 backend/app/Main.hs | 32 +++++++++++++++++++++++++-------
 1 file changed, 25 insertions(+), 7 deletions(-)

(limited to 'backend/app')

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
-- 
cgit v1.2.3