`$fileName` -> `$id`, drop extension

7 files changed, 88 insertions, 58 deletions

diff --git a/backend/app/Main.hs b/backend/app/Main.hs
index 2b461e5..c9db2ea 100644
--- a/backend/app/Main.hs
+++ b/backend/app/Main.hs
@@ -177,7 +177,10 @@ initRepo root ref = 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
+              let schema =
+                    U.autoTypes'
+                      (fileNameToId value)
+                      (fileNameToId <$> values)
               pure $ Collection path files schema
             refMap <- liftIO . Q.withStore root ref . Q.withCommit cid $ do
               buildRefMap
@@ -262,7 +265,10 @@ instance Exception ReferenceViolation
 
 buildRefMap :: Q.StoreM RefMap
 buildRefMap = do
-  allFiles <- S.fromList <$> Q.listFiles ""
+  allIds <-
+    S.fromList
+      . map ((,) <$> takeDirectory <*> (dropExtension . takeBaseName))
+      <$> Q.listFiles ""
   refMap <-
     foldl'
       ( \refMap (referencee, reference) ->
@@ -274,12 +280,12 @@ buildRefMap = do
       (RefMap M.empty M.empty)
       . concat
       <$> mapM
-        ( \filePath -> do
-            v@(J.Object _) <- Q.readFile @J.Value filePath
-            pure (map (filePath,) (collectReferences v))
+        ( \(c, i) -> do
+            v@(J.Object _) <- head <$> Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE (T.pack i))))
+            pure (map (c </> i,) (collectReferences v))
         )
-        (S.toList allFiles)
-  checkRefMap allFiles refMap
+        (S.toList allIds)
+  checkRefMap allIds refMap
   pure refMap
   where
     collectReferences (J.Object kvs) =
@@ -289,10 +295,10 @@ buildRefMap = do
     collectReferences (J.Array vs) = concatMap collectReferences vs
     collectReferences _ = []
 
-    checkRefMap allFiles (RefMap {referencees}) = do
+    checkRefMap allIds (RefMap {referencees}) = do
       mapM_
         ( \(reference, referencees) ->
-            when (not (reference `S.member` allFiles)) do
+            when (not (reference `S.member` S.map (uncurry (</>)) allIds)) do
               liftIO (throwIO (ReferenceViolation reference referencees))
         )
         (M.toList referencees)
@@ -359,8 +365,8 @@ queryApi root ref repoT app req resp = do
           when (not (sameCommit lastCompatibleCommit lastCommit)) $
             error "not implemented"
           q <- fromString @Q.Query . LB.toString <$> W.lazyRequestBody req
-          resp . W.responseLBS W.status200 [] . J.encode
-            =<< Q.withStore root ref do Q.query q
+          resp . W.responseLBS W.status200 [] . J.encode . fileNameToId
+            =<< Q.withStore root ref do Q.query @J.Value q
         _ -> do
           error "not implemented"
     _ -> app req resp
@@ -402,14 +408,14 @@ restApi root ref repoT app req resp = do
             Q.commit
           resp $ W.responseLBS W.status200 [] "{}"
         ("GET", ["collection", c]) -> do
-          resp . W.responseLBS W.status200 [] . J.encode
+          resp . W.responseLBS W.status200 [] . J.encode . fileNameToId
             =<< ( Q.withStore root ref $ Q.withCommit rev do
-                    Q.query (fromString (printf "SELECT %s FROM %s" c c))
+                    Q.query @J.Value (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
+          resp . W.responseLBS W.status200 [] . J.encode . fileNameToId
             =<< ( Q.withStore root ref $ Q.withCommit rev do
-                    Q.query
+                    Q.query @J.Value
                       ( fromString
                           ( printf
                               "SELECT %s FROM %s%s%s"
@@ -421,37 +427,37 @@ restApi root ref repoT app req resp = do
                       )
                 )
         ("GET", ["collection", c, i]) -> do
-          resp . W.responseLBS W.status200 [] . J.encode . arrayHead
+          resp . W.responseLBS W.status200 [] . J.encode . fileNameToId . head
             =<< ( Q.withStore root ref $ Q.withCommit rev do
-                    Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i))
+                    Q.query @[J.Value] (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE 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 . arrayHead
+          resp . W.responseLBS W.status200 [] . J.encode . fileNameToId . head
             =<< ( 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.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))
+                    _ <- Q.query @J.Value (fromString (printf "UPDATE %s SET %s WHERE %s.$fileName =~ /^%s\\.json$/" c (LB.toString (J.encode o)) c (escapePCRE i)))
+                    J.Array (V.toList -> [J.Object r]) <- Q.query @J.Value (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE i)))
+                    _ <- Q.query @J.Value (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))
+                    Q.query @[J.Value] (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE i)))
                 )
         ("POST", ["collection", c]) -> do
           when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented"
-          i <- ((<> ".json") . U.toText) <$> getUUID
+          i <- U.toText <$> getUUID
           o <- fmap dropNulls . J.throwDecode @J.Object =<< W.lazyRequestBody req
-          resp . W.responseLBS W.status200 [] . J.encode . arrayHead
+          resp . W.responseLBS W.status200 [] . J.encode . fileNameToId . head
             =<< ( 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))
+                    _ <- Q.query @J.Value (fromString (printf "INSERT %s INTO %s" (LB.toString (J.encode (JM.insert "$fileName" (J.String (i <> ".json")) o))) c))
                     _ <- buildRefMap
-                    Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i))
+                    Q.query @[J.Value] (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE i)))
                 )
         ("DELETE", ["collection", c, i]) -> do
           when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented"
-          resp . W.responseLBS W.status200 [] . J.encode . arrayHead
+          resp . W.responseLBS W.status200 [] . J.encode . fileNameToId . head
             =<< ( 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))
+                    r <- Q.query @[J.Value] (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE i)))
+                    Q.query @J.Value (fromString (printf "DELETE FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c (escapePCRE i)))
                     _ <- buildRefMap
                     pure r
                 )
@@ -477,5 +483,28 @@ dropNulls =
           _ -> Just v
     )
 
-arrayHead :: J.Value -> J.Value
-arrayHead (J.Array v) = V.head v
+escapePCRE :: T.Text -> T.Text
+escapePCRE = T.pack . escapePCRE' . T.unpack
+
+escapePCRE' :: String -> String
+escapePCRE' [] = []
+escapePCRE' (c : cs) =
+  ((if c `elem` (".^$*+?()[{\\|" :: String) then ('\\' :) else id) [c])
+    <> escapePCRE' cs
+
+fileNameToId :: J.Value -> J.Value
+fileNameToId (J.Array xs) = J.Array (V.map fileNameToId xs)
+fileNameToId (J.Object kvs) =
+  J.Object
+    ( JM.foldrWithKey
+        ( \k v ->
+            case (k, v) of
+              ("$fileName", J.String v) ->
+                JM.insert "$id" (J.String (T.pack (dropExtension (T.unpack v))))
+              _ ->
+                JM.insert k (fileNameToId v)
+        )
+        JM.empty
+        $ kvs
+    )
+fileNameToId v = v
diff --git a/backend/backend.cabal b/backend/backend.cabal
index 5286cc8..335e8f3 100644
--- a/backend/backend.cabal
+++ b/backend/backend.cabal
@@ -66,6 +66,9 @@ executable backend
         non-empty,
         optparse-applicative,
         random,
+        regex,
+        regex-base,
+        regex-pcre,
         safe,
         split,
         stm,
diff --git a/common/src/Collection.hs b/common/src/Collection.hs
index 25cdec7..418278d 100644
--- a/common/src/Collection.hs
+++ b/common/src/Collection.hs
@@ -22,10 +22,7 @@ instance Read CollectionItem where
   readPrec = R.lift $ do
     (Collection . toMisoString -> collection) <- R.munch (/= '/')
     _ <- R.string "/"
-    itemFileName <- do
-      itemFileName <- R.munch (liftA2 (&&) (/= '.') (/= '/'))
-      fileExt <- R.string ".json"
-      pure (itemFileName <> fileExt)
+    itemFileName <- R.munch (const True)
     pure CollectionItem {..}
 
 instance Show CollectionItem where
diff --git a/default.nix b/default.nix
index 9e66c80..7712bd6 100644
--- a/default.nix
+++ b/default.nix
@@ -23,6 +23,7 @@ rec {
       haskellPackages.cabal-install
       haskellPackages.haskell-language-server
       haskellPackages.ormolu
+      pkgs.pkg-config
       pkgs.niv
       (pkgs.writeScriptBin "reload" ''
         set -efu
diff --git a/docs/api-reference.md b/docs/api-reference.md
index 248ab8c..fd09ecc 100644
--- a/docs/api-reference.md
+++ b/docs/api-reference.md
@@ -17,11 +17,11 @@ curl -X POST http://localhost:8081/api/rest/collection/entity --data @- <<'EOF'
 EOF
 ```
 
-Note that the created entity is returned, including the meta field `$fileName`.
+Note that the created entity is returned, including the meta field `$id`.
 
 ```json
 {
-  "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json",
+  "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508",
   "description": "Description of entity 1",
   "name": "Entity 1"
 }
@@ -40,7 +40,7 @@ EOF
 
 ```json
 {
-  "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json",
+  "$id": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b",
   "description": "Description of entity 2",
   "name": "Entity 2"
 }
@@ -61,7 +61,7 @@ As one would expect, the schema lists the fields `name`, `description` as requir
   "$id": "entity.schema.json",
   "$schema": "https://json-schema.org/draft/2020-12/schema",
   "properties": {
-    "$fileName": {
+    "$id": {
       "type": "string"
     },
     "description": {
@@ -72,7 +72,7 @@ As one would expect, the schema lists the fields `name`, `description` as requir
     }
   },
   "required": [
-    "$fileName",
+    "$id",
     "description",
     "name"
   ],
@@ -83,15 +83,15 @@ As one would expect, the schema lists the fields `name`, `description` as requir
 
 ### Retrieving a single collection entity
 
-Single collection entities can be retrieved using their unique `$fileName` identifier.
+Single collection entities can be retrieved using their unique `$id` identifier.
 
 ```console
-curl http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508.json | jq .
+curl http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508 | jq .
 ```
 
 ```json
 {
-  "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json",
+  "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508",
   "description": "Description of entity 1",
   "name": "Entity 1"
 }
@@ -108,12 +108,12 @@ curl http://localhost:8081/api/rest/collection/entity | jq .
 ```json
 [
   {
-    "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json",
+    "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508",
     "description": "Description of entity 1",
     "name": "Entity 1"
   },
   {
-    "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json",
+    "$id": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b",
     "description": "Description of entity 2",
     "name": "Entity 2"
   }
@@ -125,7 +125,7 @@ curl http://localhost:8081/api/rest/collection/entity | jq .
 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 .
+curl -X PUT http://localhost:8081/api/rest/collection/entity/ccccc18c-f3dc-4f98-b4d2-290ef76adb6b --data @- <<'EOF' | jq .
 {
     "description": "Entity 2 description"
 }
@@ -136,7 +136,7 @@ The endpoint returns the full, updated entity.
 
 ```json
 {
-  "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json",
+  "$id": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b",
   "description": "Entity 2 description",
   "name": "Entity 2"
 }
@@ -145,7 +145,7 @@ The endpoint returns the full, updated entity.
 Fields can be deleted setting them their values to `null`.
 
 ```console
-curl -X PUT http://localhost:8081/api/rest/collection/entity/ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json --data @- <<'EOF' | jq .
+curl -X PUT http://localhost:8081/api/rest/collection/entity/ccccc18c-f3dc-4f98-b4d2-290ef76adb6b --data @- <<'EOF' | jq .
 {
     "description": null
 }
@@ -156,7 +156,7 @@ Again, the response contains the full entity after the update.
 
 ```json
 {
-  "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json",
+  "$id": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b",
   "name": "Entity 2"
 }
 ```
@@ -176,7 +176,7 @@ curl http://localhost:8081/api/rest/collection/entity/schema | jq .
   "$id": "entity.schema.json",
   "$schema": "https://json-schema.org/draft/2020-12/schema",
   "properties": {
-    "$fileName": {
+    "$id": {
       "type": "string"
     },
     "description": {
@@ -187,7 +187,7 @@ curl http://localhost:8081/api/rest/collection/entity/schema | jq .
     }
   },
   "required": [
-    "$fileName",
+    "$id",
     "name"
   ],
   "title": "entity",
@@ -208,12 +208,12 @@ curl http://localhost:8081/api/rest/schemaVersion | jq .
 ### Deleting collection entities
 
 ```console
-curl -X DELETE http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508.json | jq .
+curl -X DELETE http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508 | jq .
 ```
 
 ```json
 {
-  "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json",
+  "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508",
   "description": "Description of entity 1",
   "name": "Entity 1"
 }
diff --git a/docs/get-started-cli.md b/docs/get-started-cli.md
index 22c0a0f..46ee2cb 100644
--- a/docs/get-started-cli.md
+++ b/docs/get-started-cli.md
@@ -25,7 +25,7 @@ Take note of the `$fileName` in the output. Note that it should be different for
 
 ```json
 {
-    "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json",
+    "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508",
     "description": "Welcome to Biscotte restaurant! Restaurant Biscotte offers a cuisine based on fresh, quality products, often local, organic when possible, and always produced by passionate producers.",
     "name": "Biscotte Restaurant"
 }
@@ -37,7 +37,7 @@ Take note of the `$fileName` in the output. Note that it should be different for
 acms collection add category <<'EOF'
 {
   "name": "French Food",
-  "restaurant": { "$ref": "restaurant/9474f0eb-06d7-4fd8-b89e-0ce996962508.json" }
+  "restaurant": { "$ref": "restaurant/9474f0eb-06d7-4fd8-b89e-0ce996962508" }
 }
 EOF
 ```
@@ -46,7 +46,7 @@ EOF
 acms collection add category <<'EOF'
 {
   "name": "Brunch",
-  "restaurant": { "$ref": "restaurant/9474f0eb-06d7-4fd8-b89e-0ce996962508.json" }
+  "restaurant": { "$ref": "restaurant/9474f0eb-06d7-4fd8-b89e-0ce996962508" }
 }
 EOF
 ```
@@ -68,7 +68,7 @@ curl 'http://localhost:8081/api/query' --data '
   LEFT JOIN
     category
   ON
-    category.restaurant == restaurant.$fileName
+    category.restaurant == restaurant.$id
 ' | jq .
 ```
 
diff --git a/frontend/app/Schema.hs b/frontend/app/Schema.hs
index cae9ed6..5f4ddae 100644
--- a/frontend/app/Schema.hs
+++ b/frontend/app/Schema.hs
@@ -108,7 +108,7 @@ schemaTable collection schema paginated =
             []
             [ td_ [] $
                 [ case (k, p, getO (AK.fromText (fromMisoString k)) value) of
-                    ("$fileName", _, A.String fn) ->
+                    ("$id", _, A.String fn) ->
                       a_
                         [ href_
                             (routeToMisoString (EditValue collection (toMisoString fn)))