From 3add980b73b1ac75d1ad1dde85f6c782439914be Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Thu, 6 Jun 2024 22:52:33 +0200
Subject: list collections

---
 backend/app/Main.hs  |  9 ++++++++-
 frontend/app/Api.hs  | 13 +++++++++----
 frontend/app/Main.hs | 22 +++++++++++++++-------
 3 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/backend/app/Main.hs b/backend/app/Main.hs
index df5dee8..59eab03 100644
--- a/backend/app/Main.hs
+++ b/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 "/"
       ]
   )
diff --git a/frontend/app/Api.hs b/frontend/app/Api.hs
index f4e4599..2aa23c9 100644
--- a/frontend/app/Api.hs
+++ b/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)
-fetchSchema =
-  A.eitherDecode <$> fetch (fromString "http://localhost:8081/posts.schema.json")
+fetchCollections :: JSM (Either String [String])
+fetchCollections =
+  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
diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs
index 37230ad..f5ec4b6 100644
--- a/frontend/app/Main.hs
+++ b/frontend/app/Main.hs
@@ -23,8 +23,9 @@ data Model
   deriving (Show, Eq)
 
 data LoadedState = LoadedState
-  { page :: Maybe (Either String Page),
-    schemaVersion :: Version
+  { collections :: [String],
+    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 =
+viewCollections :: LoadedState -> View Action
+viewCollections s =
   section_ [] $
     [ span_ [] [text "collections"],
       ol_ [] $
-        [ li_ [] [a_ [href_ "#collection/posts"] [text "posts"]],
-          li_ [] [a_ [href_ "#collection/posts1"] [text "posts1"]]
+        [ li_
+            []
+            [ a_
+                [href_ (toMisoString ("#collection/" <> collection))]
+                [text (toMisoString collection)]
+            ]
+          | collection <- s.collections
         ]
     ]
-- 
cgit v1.2.3