From dcd0a7a9b2612f383c1f627c72c27868c367058d Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Fri, 21 Jul 2023 00:01:02 +0200
Subject: [haskell] abstracted away common database access patterns

---
 haskell/src/SpaceTraders/APIClient/Contracts.hs | 30 +++++++++++++++++++++++++
 1 file changed, 30 insertions(+)
 create mode 100644 haskell/src/SpaceTraders/APIClient/Contracts.hs

(limited to 'haskell/src/SpaceTraders/APIClient/Contracts.hs')

diff --git a/haskell/src/SpaceTraders/APIClient/Contracts.hs b/haskell/src/SpaceTraders/APIClient/Contracts.hs
new file mode 100644
index 0000000..a62eb26
--- /dev/null
+++ b/haskell/src/SpaceTraders/APIClient/Contracts.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module SpaceTraders.APIClient.Contracts
+  ( myContracts
+  ) where
+
+import Network.HTTP.Simple
+
+import SpaceTraders
+import SpaceTraders.APIClient.Client
+import SpaceTraders.APIClient.Pagination
+import SpaceTraders.Database.Contracts
+import SpaceTraders.Model.Contract(Contract)
+
+myContracts :: SpaceTradersT (APIResponse [Contract])
+myContracts = do
+  listContracts' Pagination{limit=20, page=1, total=0}
+  where
+    listContracts' :: Pagination -> SpaceTradersT (APIResponse [Contract])
+    listContracts' p = do
+      resp <- sendPaginated (Just p) $ setRequestPath "/v2/my/contracts" :: SpaceTradersT (APIPaginatedResponse [Contract])
+      case resp of
+        Left e -> return $ Left e
+        Right (APIMessage r (Just p')) -> do
+          mapM_ setContract r
+          if (limit p' * page p' < total p') then listContracts' (nextPage p')
+                                             else Right <$> getContracts
+        _ -> undefined
-- 
cgit v1.2.3