improve REST API

7 files changed, 49 insertions, 42 deletions

diff --git a/backend/app/Main.hs b/backend/app/Main.hs
index 8070906..c31ea7d 100644
--- a/backend/app/Main.hs
+++ b/backend/app/Main.hs
@@ -285,6 +285,8 @@ queryApi root ref repoT app req resp = do
           q <- fromString @Q.Query . LB.toString <$> W.lazyRequestBody req
           resp . W.responseLBS W.status200 [] . J.encode
             =<< Q.withStore root ref do Q.query q
+        _ -> do
+          error "not implemented"
     _ -> app req resp
 
 restApi :: FilePath -> T.Text -> TMVar Repo -> W.Middleware
@@ -311,9 +313,11 @@ restApi root ref repoT app req resp = do
           resp . W.responseLBS W.status200 [] $
             J.encode (map (.path) lastCompatibleCommit.collections)
         ("GET", ["collection", T.unpack -> c, "schema"]) -> do
-          let [collection] = filter ((== c) . (.path)) lastCompatibleCommit.collections
-          resp . W.responseLBS W.status200 [] $
-            J.encode (fromAutoTypes c collection.schema)
+          case find ((== c) . (.path)) lastCompatibleCommit.collections of
+            Nothing -> error "not implemented"
+            Just collection ->
+              resp . W.responseLBS W.status200 [] $
+                J.encode (fromAutoTypes c collection.schema)
         ("POST", ["collection"]) -> do
           when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented"
           Right collection <- J.eitherDecode <$> W.lazyRequestBody req
@@ -327,16 +331,17 @@ restApi root ref repoT app req resp = do
                     Q.query (fromString (printf "SELECT %s FROM %s" c c))
                 )
         ("GET", ["collection", c, i]) -> do
-          resp . W.responseLBS W.status200 [] . J.encode
+          resp . W.responseLBS W.status200 [] . J.encode . headMay
             =<< ( 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
+          resp . W.responseLBS W.status200 [] . J.encode . headMay
             =<< ( 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))
+                    Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i))
                 )
         ("POST", ["collection", c]) -> do
           when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented"
@@ -349,9 +354,11 @@ restApi root ref repoT app req resp = do
                 )
         ("DELETE", ["collection", c, i]) -> do
           when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented"
-          resp . W.responseLBS W.status200 [] . J.encode
+          resp . W.responseLBS W.status200 [] . J.encode . headMay
             =<< ( 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))
+                    pure r
                 )
         (method, path) -> fail $ "Method " ++ show method ++ " on route " ++ show path ++ " not supported."
     _ -> app req resp
diff --git a/backend/lib/ACMS/API/REST.hs b/backend/lib/ACMS/API/REST.hs
index 64b47b7..ec72db9 100644
--- a/backend/lib/ACMS/API/REST.hs
+++ b/backend/lib/ACMS/API/REST.hs
@@ -13,19 +13,15 @@ import Miso.String qualified as J
 #endif
 import Control.Monad.Catch (MonadThrow)
 import Data.Aeson qualified as A
-import Data.ByteString.Char8 qualified as B
 import Data.ByteString.Lazy.Char8 qualified as LB
 import Data.Function ((&))
+import Data.String (IsString (fromString))
 import Miso (JSM)
 import Miso.String (MisoString)
 
 restRequest :: String -> Request
 restRequest endpoint =
-  defaultRequest
-    & setRequestSecure False
-    & setRequestHost "localhost"
-    & setRequestPort 8081
-    & setRequestPath ("/api/rest" <> B.pack endpoint)
+  fromString ("http://localhost:8081/api/rest/" <> endpoint)
 
 schemaVersion :: (APIMonad m, A.FromJSON a) => m a
 schemaVersion =
diff --git a/backend/lib/ACMS/API/REST/Collection.hs b/backend/lib/ACMS/API/REST/Collection.hs
index 3ca8ffd..b3faf19 100644
--- a/backend/lib/ACMS/API/REST/Collection.hs
+++ b/backend/lib/ACMS/API/REST/Collection.hs
@@ -11,12 +11,10 @@ import Data.Maybe
 import JavaScript.Web.XMLHttpRequest
 import Miso.String qualified as J
 #endif
-import Collection
 import ACMS.API.REST (APIMonad, fetch, restRequest)
+import Collection
 import Data.Aeson qualified as A
 import Data.Function ((&))
-import Debug.Trace
-import Miso.String (MisoString)
 import Text.Printf (printf)
 
 list :: (APIMonad m) => Collection -> m [A.Object]
@@ -25,7 +23,7 @@ list c =
     & fetch
     >>= A.throwDecode
 
-read :: (APIMonad m) => CollectionItem -> m [A.Object]
+read :: (APIMonad m) => CollectionItem -> m (Maybe A.Object)
 read ci =
   restRequest (printf "/collection/%s/%s" ci.collection.name ci.itemFileName)
     & fetch
@@ -47,7 +45,7 @@ create c o = do
     & fetch
     >>= A.throwDecode
 
-delete :: (APIMonad m) => CollectionItem -> m [A.Object]
+delete :: (APIMonad m) => CollectionItem -> m A.Object
 delete ci =
   restRequest (printf "/collection/%s/%s" ci.collection.name ci.itemFileName)
     & setRequestMethod "DELETE"
diff --git a/cli/app/Main.hs b/cli/app/Main.hs
index 991eaa5..961f54f 100644
--- a/cli/app/Main.hs
+++ b/cli/app/Main.hs
@@ -16,10 +16,6 @@ import Data.Aeson.Encode.Pretty qualified as J
 import Data.ByteString.Lazy qualified as LB
 import Data.Text qualified as T
 import Options.Applicative qualified as O
-import Text.ParserCombinators.ReadP qualified as R
-import Text.ParserCombinators.ReadPrec qualified as R
-import Text.Read (Read (..))
-import Debug.Trace
 
 newtype Args = Args
   { cmd :: Cmd
diff --git a/docs/api-reference.md b/docs/api-reference.md
index 7f7a465..064993e 100644
--- a/docs/api-reference.md
+++ b/docs/api-reference.md
@@ -89,16 +89,12 @@ Single collection entities can be retrieved using their unique `$fileName` ident
 curl http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508.json | jq .
 ```
 
-TODO do not return list
-
 ```json
-[
-  {
-    "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json",
-    "description": "Description of entity 1",
-    "name": "Entity 1"
-  }
-]
+{
+  "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json",
+  "description": "Description of entity 1",
+  "name": "Entity 1"
+}
 ```
 
 ### Retrieving all collection entities
@@ -131,17 +127,19 @@ Updating a collection entity is possible by send only select fields.
 ```console
 curl -X PUT http://localhost:8081/api/rest/collection/entity/ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json --data @- <<'EOF' | jq .
 {
-    "description": "Entity 2's description"
+    "description": "Entity 2 description"
 }
 EOF
 ```
 
 The endpoint returns the full, updated entity.
 
-TODO return full, updated entity, return single entity
-
 ```json
-[]
+{
+  "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json",
+  "description": "Entity 2 description",
+  "name": "Entity 2"
+}
 ```
 
 Fields can be deleted setting them their values to `null`.
@@ -156,10 +154,14 @@ EOF
 
 Again, the response contains the full entity after the update.
 
-TODO return full, updated entity, return single entity
+TODO sanitize `null` fields
 
 ```json
-[]
+{
+  "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json",
+  "description": null,
+  "name": "Entity 2"
+}
 ```
 
 ## Retrieving the global schema version
@@ -212,8 +214,10 @@ curl http://localhost:8081/api/rest/schemaVersion | jq .
 curl -X DELETE http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508.json | jq .
 ```
 
-TODO return deleted entity, only one entity
-
 ```json
-[]
+{
+  "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json",
+  "description": "Description of entity 1",
+  "name": "Entity 1"
+}
 ```
diff --git a/frontend/app/Page/EditValue.hs b/frontend/app/Page/EditValue.hs
index 7945874..942d9db 100644
--- a/frontend/app/Page/EditValue.hs
+++ b/frontend/app/Page/EditValue.hs
@@ -11,13 +11,11 @@ import ACMS.API.REST.Collection qualified as API.REST.Collection
 import Control.Monad.Catch (SomeException, try)
 import Data.Aeson qualified as A
 import Data.Aeson.KeyMap qualified as AM
-import Data.ByteString.Lazy.UTF8 qualified as LB
 import Data.Maybe
 import Effect (Eff)
 import Form qualified as F
 import Miso
 import Miso.String (toMisoString)
-import Safe (headMay)
 import Schema
 import Collection
 
@@ -31,7 +29,7 @@ data Model = Model
 initialModel :: CollectionItem -> JSM (Either SomeException Model)
 initialModel collectionItem = do
   schema' <- try (API.REST.Collection.schema collectionItem.collection)
-  input' <- try (headMay <$> API.REST.Collection.read collectionItem)
+  input' <- try (API.REST.Collection.read collectionItem)
   pure do
     schema <- schema'
     input <- input'
diff --git a/frontend/app/Schema.hs b/frontend/app/Schema.hs
index 8e49d47..c15e1d1 100644
--- a/frontend/app/Schema.hs
+++ b/frontend/app/Schema.hs
@@ -9,6 +9,9 @@ module Schema
   )
 where
 
+#ifdef ghcjs_HOST_OS
+import Data.Text qualified as T
+#endif
 import Control.Applicative ((<|>))
 import Data.Aeson qualified as A
 import Data.Aeson.Key qualified as AK
@@ -42,6 +45,11 @@ instance A.FromJSON Schema where
       <*> v A..: "title"
       <*> v A..: "type"
 
+#ifdef ghcjs_HOST_OS
+instance A.FromJSONKey MisoString where
+  parseJSON = fromMisoString @T.Text <$> parseJSON
+#endif
+
 data Property
   = Type MisoString
   | Reference MisoString