From 9b0adc976101bc4f375b05cc475478187c595714 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 18 Dec 2024 19:11:03 +0100 Subject: add pagination to rest api --- backend/app/Main.hs | 32 ++++++++++++++++++----- backend/backend.cabal | 2 ++ backend/lib/ACMS/API/REST/Collection/Paginated.hs | 32 +++++++++++++++++++++++ 3 files changed, 59 insertions(+), 7 deletions(-) create mode 100644 backend/lib/ACMS/API/REST/Collection/Paginated.hs (limited to 'backend') 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 diff --git a/backend/backend.cabal b/backend/backend.cabal index fd0502a..5286cc8 100644 --- a/backend/backend.cabal +++ b/backend/backend.cabal @@ -11,6 +11,7 @@ library exposed-modules: ACMS.API.REST ACMS.API.REST.Collection + ACMS.API.REST.Collection.Paginated hs-source-dirs: lib default-language: GHC2021 @@ -72,6 +73,7 @@ executable backend text, utf8-string, uuid, + vector, wai, warp diff --git a/backend/lib/ACMS/API/REST/Collection/Paginated.hs b/backend/lib/ACMS/API/REST/Collection/Paginated.hs new file mode 100644 index 0000000..ad98888 --- /dev/null +++ b/backend/lib/ACMS/API/REST/Collection/Paginated.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module ACMS.API.REST.Collection.Paginated where + +import ACMS.API.REST (APIMonad, fetch, restRequest) +import Collection +import Data.Aeson qualified as A +import Data.Function ((&)) +import GHC.Generics (Generic) +import Text.Printf (printf) + +data Pagination = Pagination + { limit :: Int, + offset :: Int + } + +data Paginated a = Paginated + { count :: Int, + data_ :: [a] + } + deriving (Eq, Show, Generic) + +instance (A.FromJSON a) => A.FromJSON (Paginated a) + +instance (A.ToJSON a) => A.ToJSON (Paginated a) + +list :: (APIMonad m) => Pagination -> Collection -> m (Paginated A.Object) +list p c = + restRequest (printf "/collection/%s/paginated/%d/%d" c.name p.limit p.offset) + & fetch + >>= A.throwDecode -- cgit v1.2.3