list collections

backend/app/Main.hs

@@ -221,6 +221,11 @@ main = do
             respond $
               W.responseLBS W.status200 [] $
                 J.encode (last repo.commits).schemaVersion
+          Right ListCollections -> do
+            repo <- atomically (readTMVar repoT)
+            respond $
+              W.responseLBS W.status200 [] $
+                J.encode (map (.path) (last repo.commits).collections)
           (traceShowId -> !_) ->
             respond $ W.responseLBS W.status200 [] "not implemented"
 
@@ -228,13 +233,15 @@ data Route
   = SchemaJson String
   | Query
   | SchemaVersion
+  | ListCollections
   deriving (Show)
 
 routeP :: P.Parser Route
 routeP =
   ( P.choice
-      [ SchemaJson <$> (P.string "/" *> P.manyTill P.anyChar (P.string ".schema.json")),
+      [ pure ListCollections <* P.string "/collections",
         pure SchemaVersion <* P.string "/schemaVersion",
+        SchemaJson <$> (P.string "/" *> P.manyTill P.anyChar (P.string ".schema.json")),
         pure Query <* P.string "/"
       ]
   )

frontend/app/Api.hs

@@ -1,7 +1,8 @@
 {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
 
 module Api
-  ( fetchSchema,
+  ( fetchCollections,
+    fetchSchema,
     fetchSchemaVersion,
     fetchPosts,
     fetchPost,
@@ -28,14 +29,18 @@ import Safe
 import Schema
 import Version
 
-fetchSchema :: JSM (Either String Schema)
+fetchCollections :: JSM (Either String [String])
-fetchSchema =
+fetchCollections =
-  A.eitherDecode <$> fetch (fromString "http://localhost:8081/posts.schema.json")
+  A.eitherDecode <$> fetch (fromString "http://localhost:8081/collections")
 
 fetchSchemaVersion :: JSM (Either String Version)
 fetchSchemaVersion =
   A.eitherDecode <$> fetch (fromString "http://localhost:8081/schemaVersion")
 
+fetchSchema :: JSM (Either String Schema)
+fetchSchema =
+  A.eitherDecode <$> fetch (fromString "http://localhost:8081/posts.schema.json")
+
 fetchPosts :: JSM (Either String [A.Value])
 fetchPosts =
   A.eitherDecode

frontend/app/Main.hs

@@ -23,8 +23,9 @@ data Model
   deriving (Show, Eq)
 
 data LoadedState = LoadedState
-  { page :: Maybe (Either String Page),
+  { collections :: [String],
-    schemaVersion :: Version
+    schemaVersion :: Version,
+    page :: Maybe (Either String Page)
   }
   deriving (Show, Eq)
 
@@ -69,8 +70,10 @@ updateModel (Init uri) Loading =
   Loading <# do
     page <- Just <$> initialPage (parseURI uri)
     schemaVersion' <- fetchSchemaVersion
+    collections' <- fetchCollections
     pure $ SetLoaded do
       schemaVersion <- schemaVersion'
+      collections <- collections'
       pure LoadedState {..}
 updateModel (Init _) m = noEff m
 updateModel (SetLoaded (Left err)) Loading = noEff (Failed err)
@@ -98,7 +101,7 @@ viewModel (Loaded s) =
   div_ [] $
     [ viewCss,
       viewHeader s,
-      nav_ [] [viewCollections],
+      nav_ [] [viewCollections s],
       main_ [] $
         [ HandlePage <$> maybe (text "..") (either err viewPage) s.page
         ]
@@ -208,12 +211,17 @@ viewBranch s =
     select_ [] [option_ [] [text "main"]]
   ]
 
-viewCollections :: View Action
+viewCollections :: LoadedState -> View Action
-viewCollections =
+viewCollections s =
   section_ [] $
     [ span_ [] [text "collections"],
       ol_ [] $
-        [ li_ [] [a_ [href_ "#collection/posts"] [text "posts"]],
+        [ li_
-          li_ [] [a_ [href_ "#collection/posts1"] [text "posts1"]]
+            []
+            [ a_
+                [href_ (toMisoString ("#collection/" <> collection))]
+                [text (toMisoString collection)]
+            ]
+          | collection <- s.collections
         ]
     ]