use backend REST library for frontend

10 files changed, 117 insertions, 110 deletions

diff --git a/frontend/app/Form/Input.hs b/frontend/app/Form/Input.hs
index e43651c..99fd821 100644
--- a/frontend/app/Form/Input.hs
+++ b/frontend/app/Form/Input.hs
@@ -3,30 +3,29 @@ module Form.Input
   )
 where
 
-import Data.Text qualified as T
 import Form.Internal
 import Miso
-import Miso.String (fromMisoString, toMisoString)
+import Miso.String (MisoString, null, strip)
 
-input :: String -> Form T.Text T.Text
+input :: MisoString -> Form MisoString MisoString
 input label =
-  let parse :: T.Text -> Either String T.Text
+  let parse :: MisoString -> Either MisoString MisoString
       parse i =
-        let i' = T.strip i
-         in if T.null i' then Left "required" else Right i'
+        let i' = strip i
+         in if Miso.String.null i' then Left "required" else Right i'
    in Form
         { view = \i ->
             [ div_ [] $
                 [ label_ [] $
-                    [ text (toMisoString label),
+                    [ text label,
                       div_ [] $
                         [ input_
                             [ type_ "text",
-                              value_ (toMisoString i),
-                              onInput fromMisoString
+                              value_ i,
+                              onInput id
                             ],
                           div_ [] $
-                            [either (text . toMisoString) (\_ -> text "") (parse i)]
+                            [either text (\_ -> text "") (parse i)]
                         ]
                     ]
                 ]
diff --git a/frontend/app/Form/Internal.hs b/frontend/app/Form/Internal.hs
index 2274c63..35d59e7 100644
--- a/frontend/app/Form/Internal.hs
+++ b/frontend/app/Form/Internal.hs
@@ -6,12 +6,12 @@ module Form.Internal
   )
 where
 
-import Data.Text qualified as T
 import Miso
+import Miso.String (MisoString, null, strip)
 
 data Form i o = Form
   { view :: i -> [View i],
-    fill :: i -> Either String o
+    fill :: i -> Either MisoString o
   }
 
 instance Functor (Form i) where
@@ -63,8 +63,8 @@ runForm form i =
 class IsEmpty i where
   isEmpty :: i -> Bool
 
-instance IsEmpty T.Text where
-  isEmpty = T.null . T.strip
+instance IsEmpty MisoString where
+  isEmpty = Miso.String.null . strip
 
 optional :: (IsEmpty i) => Form i o -> Form i (Maybe o)
 optional form =
diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs
index f3d40c8..9f30708 100644
--- a/frontend/app/Main.hs
+++ b/frontend/app/Main.hs
@@ -1,10 +1,13 @@
+{-# LANGUAGE ViewPatterns #-}
+
 module Main where
 
 #ifndef ghcjs_HOST_OS
 import Language.Javascript.JSaddle.Warp as JSaddle
 #endif
 
-import Api
+import ACMS.API.REST as API.REST
+import Control.Monad.Catch
 import Control.Monad.Trans
 import Data.Bifunctor
 import Data.Default
@@ -12,7 +15,7 @@ import Data.Function
 import Effect (Eff)
 import Effect qualified as E
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (MisoString, toMisoString)
 import NeatInterpolation qualified as Q
 import Page (Page, initialPage, updatePage, viewPage)
 import Page qualified as Page
@@ -21,14 +24,14 @@ import Version
 
 data Model
   = Loading
-  | Failed String
+  | Failed MisoString
   | Loaded LoadedState
   deriving (Show, Eq)
 
 data LoadedState = LoadedState
-  { collections :: [String],
+  { collections :: [MisoString],
     schemaVersion :: Version,
-    page :: Maybe (Either String Page)
+    page :: Maybe (Either MisoString Page)
   }
   deriving (Show, Eq)
 
@@ -37,11 +40,6 @@ instance Default Model where
 
 newtype Action = Action (Model -> Effect Action Model)
 
--- TODO
-instance Show Action
-
-instance Eq Action
-
 #ifndef ghcjs_HOST_OS
 runApp :: JSM () -> IO ()
 runApp f = JSaddle.debugOr 8080 (f >> syncPoint) JSaddle.jsaddleApp
@@ -67,18 +65,20 @@ update__init :: URI -> Action
 update__init uri = Action $ \case
   Loading ->
     Loading <# do
-      page <- Just <$> initialPage (parseURI uri)
-      schemaVersion' <- fetchSchemaVersion
-      collections' <- fetchCollections
+      page <-
+        Just . first (toMisoString . displayException)
+          <$> initialPage (parseURI uri)
+      schemaVersion' <- try API.REST.schemaVersion
+      collections' <- try API.REST.listCollections
       pure $ update__setLoaded do
         schemaVersion <- schemaVersion'
         collections <- collections'
         pure LoadedState {..}
   m -> noEff m
 
-update__setLoaded :: Either String LoadedState -> Action
+update__setLoaded :: Either SomeException LoadedState -> Action
 update__setLoaded (Left e) = Action $ \case
-  Loading -> noEff (Failed e)
+  Loading -> noEff (Failed (toMisoString (displayException e)))
   m -> noEff m
 update__setLoaded (Right s) = Action $ \case
   Loading -> noEff (Loaded s)
@@ -95,10 +95,11 @@ update__handleURI uri = Action $ \case
       update__setPage <$> initialPage route
   m -> noEff m
 
-update__setPage :: Either String Page -> Action
-update__setPage (Just -> page) = Action $ \case
-  Loaded s -> noEff (Loaded s {page})
-  m -> noEff m
+update__setPage :: Either SomeException Page -> Action
+update__setPage
+  ((Just . first (toMisoString . displayException)) -> page) = Action $ \case
+    Loaded s -> noEff (Loaded s {page = page})
+    m -> noEff m
 
 update__handlePage :: Page.Action -> Action
 update__handlePage action = Action $ \case
@@ -121,18 +122,18 @@ update__handleEff eff = Action $ \case
   Loaded s -> Loaded s <# handleEff eff
   m -> noEff m
 
-update__setCollections :: Either String [String] -> Action
+update__setCollections :: Either SomeException [MisoString] -> Action
 update__setCollections (Left err) = Action $ \case
   Loaded s ->
     Loaded s <# do
-      pure update__noOp <* consoleLog (toMisoString err)
+      pure update__noOp <* consoleLog (toMisoString (displayException err))
   m -> noEff m
 update__setCollections (Right collections) = Action $ \case
   Loaded s -> noEff (Loaded s {collections})
   m -> noEff m
 
 handleEff :: Eff -> JSM Action
-handleEff E.ReloadCollections = update__setCollections <$> fetchCollections
+handleEff E.ReloadCollections = update__setCollections <$> try API.REST.listCollections
 
 viewModel :: Model -> View Action
 viewModel Loading = text ".."
@@ -234,8 +235,8 @@ th, td {
         )
     ]
 
-err :: String -> View action
-err = text . toMisoString . ("err! " <>)
+err :: MisoString -> View action
+err = text . ("err! " <>)
 
 viewHeader :: LoadedState -> View Action
 viewHeader s =
diff --git a/frontend/app/Page.hs b/frontend/app/Page.hs
index 3218ae6..c7b393f 100644
--- a/frontend/app/Page.hs
+++ b/frontend/app/Page.hs
@@ -7,6 +7,7 @@ module Page
   )
 where
 
+import Control.Monad.Catch (SomeException)
 import Data.Bifunctor
 import Data.Default
 import Data.Function
@@ -30,7 +31,7 @@ newtype Action = Action (Page -> (Effect Action Page, [Eff]))
 instance Default Page where
   def = Home
 
-initialPage :: Route -> JSM (Either String Page)
+initialPage :: Route -> JSM (Either SomeException Page)
 initialPage Route.Home = pure (Right Home)
 initialPage (Route.ListCollection c) =
   fmap ListCollection <$> ListCollection.initialModel c
diff --git a/frontend/app/Page/EditValue.hs b/frontend/app/Page/EditValue.hs
index cdb1dd0..cf8ef50 100644
--- a/frontend/app/Page/EditValue.hs
+++ b/frontend/app/Page/EditValue.hs
@@ -7,7 +7,8 @@ module Page.EditValue
   )
 where
 
-import Api
+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 as LB
@@ -15,21 +16,22 @@ import Data.Maybe
 import Effect (Eff)
 import Form qualified as F
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (MisoString, toMisoString)
+import Safe (headMay)
 import Schema
 
 data Model = Model
-  { collection :: String,
-    fileName :: String,
-    input :: Maybe A.Value,
+  { collection :: MisoString,
+    fileName :: MisoString,
+    input :: Maybe A.Object,
     schema :: Schema
   }
   deriving (Show, Eq)
 
-initialModel :: String -> String -> JSM (Either String Model)
+initialModel :: MisoString -> MisoString -> JSM (Either SomeException Model)
 initialModel collection fileName = do
-  schema' <- fetchSchema
-  input' <- fetchPost fileName
+  schema' <- try (API.REST.Collection.schema collection)
+  input' <- try (headMay <$> API.REST.Collection.read collection fileName)
   pure do
     schema <- schema'
     input <- input'
@@ -37,14 +39,14 @@ initialModel collection fileName = do
 
 newtype Action = Action (Model -> (Effect Action Model, [Eff]))
 
-update__formChanged :: A.Value -> Action
+update__formChanged :: A.Object -> Action
 update__formChanged (Just -> input) = Action $ \m -> (noEff m {input}, [])
 
-update__formSubmitted :: A.Value -> Action
+update__formSubmitted :: A.Object -> Action
 update__formSubmitted output = Action $ \m ->
-  (m <# do update__entityWritten <$> updatePost m.fileName output, [])
+  (m <# do update__entityWritten <$> try (API.REST.Collection.update m.collection m.fileName output), [])
 
-update__entityWritten :: Either String () -> Action
+update__entityWritten :: Either SomeException () -> Action
 update__entityWritten _ = Action $ \m -> (noEff m, [])
 
 updateModel :: Action -> Model -> (Effect Action Model, [Eff])
@@ -52,29 +54,27 @@ updateModel (Action f) m = f m
 
 viewModel :: Model -> View Action
 viewModel m = do
-  let input = (fromMaybe (A.Object AM.empty) m.input)
+  let input = (fromMaybe AM.empty m.input)
   div_ [] $
     [ viewForm input m.schema,
       viewInput input,
       viewOutput input m.schema
     ]
 
-viewForm :: A.Value -> Schema -> View Action
+viewForm :: A.Object -> Schema -> View Action
 viewForm input =
   fmap (either update__formChanged update__formSubmitted)
     . flip F.runForm input
     . schemaForm
 
-viewInput :: A.Value -> View Action
+viewInput :: A.Object -> View Action
 viewInput input =
   pre_ [] [text (toMisoString (A.encode input))]
 
-viewOutput :: A.Value -> Schema -> View Action
+viewOutput :: A.Object -> Schema -> View Action
 viewOutput input schema =
   pre_ [] $
     [ text $
-        toMisoString
-          ( either ("Left " <>) (("Right " <>) . LB.toString) $
-              (A.encode <$> ((schemaForm schema).fill input))
-          )
+        either ("Left " <>) (("Right " <>)) $
+          (toMisoString . A.encode <$> ((schemaForm schema).fill input))
     ]
diff --git a/frontend/app/Page/ListCollection.hs b/frontend/app/Page/ListCollection.hs
index 9acca3c..47a4649 100644
--- a/frontend/app/Page/ListCollection.hs
+++ b/frontend/app/Page/ListCollection.hs
@@ -7,29 +7,31 @@ module Page.ListCollection
   )
 where
 
-import Api
+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 Effect (Eff)
 import Miso
+import Miso.String (MisoString)
 import Schema
 
 data Model = Model
-  { collection :: String,
-    input :: A.Value,
+  { collection :: MisoString,
+    input :: A.Object,
     schema :: Schema,
-    posts :: [A.Value]
+    posts :: [A.Object]
   }
   deriving (Show, Eq)
 
-initialModel :: String -> JSM (Either String Model)
+initialModel :: MisoString -> JSM (Either SomeException Model)
 initialModel collection = do
-  schema' <- fetchSchema
-  posts' <- fetchPosts
+  schema' <- try (API.REST.Collection.schema collection)
+  posts' <- try (API.REST.Collection.list collection)
   pure do
     schema <- schema'
     posts <- posts'
-    pure $ Model {input = A.Object AM.empty, ..}
+    pure $ Model {input = AM.empty, ..}
 
 newtype Action = Action (Model -> (Effect Action Model, [Eff]))
 
diff --git a/frontend/app/Page/NewCollection.hs b/frontend/app/Page/NewCollection.hs
index 12b9cf1..a15d4a7 100644
--- a/frontend/app/Page/NewCollection.hs
+++ b/frontend/app/Page/NewCollection.hs
@@ -7,37 +7,38 @@ module Page.NewCollection
   )
 where
 
-import Api
+import ACMS.API.REST qualified as API.REST
+import Control.Monad.Catch (SomeException, try)
 import Data.Aeson qualified as A
 import Data.Text qualified as T
 import Effect (Eff)
 import Effect qualified as E
 import Form qualified as F
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (MisoString, toMisoString)
 
 data Model = Model
-  { input :: T.Text
+  { input :: MisoString
   }
   deriving (Show, Eq)
 
-initialModel :: JSM (Either String Model)
+initialModel :: JSM (Either SomeException Model)
 initialModel = do
   pure (Right (Model {input = ""}))
 
 newtype Action = Action (Model -> (Effect Action Model, [Eff]))
 
-update__formChanged :: T.Text -> Action
+update__formChanged :: MisoString -> Action
 update__formChanged input = Action $ \m -> (noEff m {input}, [])
 
-update__formSubmitted :: T.Text -> Action
+update__formSubmitted :: MisoString -> Action
 update__formSubmitted collection = Action $ \m ->
   ( m <# do
-      update__collectionCreated <$> createCollection (T.unpack collection),
+      update__collectionCreated <$> try (API.REST.createCollection collection),
     []
   )
 
-update__collectionCreated :: Either String () -> Action
+update__collectionCreated :: Either SomeException () -> Action
 update__collectionCreated _ = Action $ \m -> (noEff m, [E.ReloadCollections])
 
 updateModel :: Action -> Model -> (Effect Action Model, [Eff])
@@ -53,6 +54,6 @@ viewModel m = do
       pre_ [] [text (toMisoString (A.encode (collectionForm.fill m.input)))]
     ]
 
-collectionForm :: F.Form T.Text T.Text
+collectionForm :: F.Form MisoString MisoString
 collectionForm =
   F.input "name"
diff --git a/frontend/app/Route.hs b/frontend/app/Route.hs
index d683b76..e2d2838 100644
--- a/frontend/app/Route.hs
+++ b/frontend/app/Route.hs
@@ -1,7 +1,7 @@
 module Route
   ( Route (..),
     parseURI,
-    routeToString,
+    routeToMisoString,
   )
 where
 
@@ -9,11 +9,12 @@ import Data.Attoparsec.Text qualified as P
 import Data.Default
 import Data.Text qualified as T
 import Miso
+import Miso.String (MisoString, toMisoString)
 
 data Route
   = Home
-  | ListCollection String
-  | EditValue String String
+  | ListCollection MisoString
+  | EditValue MisoString MisoString
   | NewCollection
   deriving (Show, Eq)
 
@@ -26,18 +27,18 @@ parseURI uri =
     P.parseOnly
       ( P.choice
           [ EditValue
-              <$> (P.string "#collection/" *> P.manyTill P.anyChar (P.string "/"))
-              <*> (P.many1 P.anyChar),
-            pure NewCollection <* (P.string "#collection/new"),
-            ListCollection <$> (P.string "#collection/" *> P.many1 P.anyChar),
+              <$> (toMisoString <$> (P.string "#collection/" *> P.manyTill P.anyChar (P.string "/")))
+              <*> (toMisoString <$> (P.many1 P.anyChar)),
+            pure NewCollection <* (toMisoString <$> (P.string "#collection/new")),
+            ListCollection <$> (toMisoString <$> (P.string "#collection/" *> P.many1 P.anyChar)),
             pure Home
           ]
           <* P.endOfInput
       )
       (T.pack uri.uriFragment)
 
-routeToString :: Route -> String
-routeToString Home = "#"
-routeToString (ListCollection collection) = "#collection/" <> collection
-routeToString (EditValue collection fileName) = "#collection/" <> collection <> "/" <> fileName
-routeToString NewCollection = "#collection/new"
+routeToMisoString :: Route -> MisoString
+routeToMisoString Home = "#"
+routeToMisoString (ListCollection collection) = "#collection/" <> collection
+routeToMisoString (EditValue collection fileName) = "#collection/" <> collection <> "/" <> fileName
+routeToMisoString NewCollection = "#collection/new"
diff --git a/frontend/app/Schema.hs b/frontend/app/Schema.hs
index 1a52f52..bc504cc 100644
--- a/frontend/app/Schema.hs
+++ b/frontend/app/Schema.hs
@@ -18,7 +18,7 @@ import Data.Maybe
 import Data.Text qualified as T
 import Form qualified as F
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (MisoString, fromMisoString, toMisoString)
 import Route
 
 data Schema = Schema
@@ -67,7 +67,7 @@ viewSchema schema =
         )
           <$> (M.toList properties)
 
-schemaTable :: String -> Schema -> [A.Value] -> View action
+schemaTable :: MisoString -> Schema -> [A.Object] -> View action
 schemaTable collection schema values =
   table_ [] [thead, tbody]
   where
@@ -90,7 +90,7 @@ schemaTable collection schema values =
                       ("$fileName", A.String fn) ->
                         a_
                           [ href_
-                              (toMisoString (routeToString (EditValue collection (T.unpack fn))))
+                              (routeToMisoString (EditValue collection (toMisoString fn)))
                           ]
                           [ text (toMisoString fn)
                           ]
@@ -105,7 +105,7 @@ schemaTable collection schema values =
             | value <- values
           ]
 
-schemaForm :: Schema -> F.Form A.Value A.Value
+schemaForm :: Schema -> F.Form A.Object A.Object
 schemaForm schema =
   fmap mergeJson . sequence $
     case schema.type_ of
@@ -113,36 +113,36 @@ schemaForm schema =
         ( \(AK.fromString -> k, v) ->
             case v of
               "string" ->
-                A.Object . AM.singleton k
+                AM.singleton k
                   <$> ( F.mapValues (getO k) (setO k) $
-                          fmap A.String . F.mapValues fromJson toJson $
-                            F.input (AK.toString k)
+                          fmap (A.String . fromMisoString) . F.mapValues fromJson toJson $
+                            F.input (toMisoString (AK.toString k))
                       )
               "string?" ->
-                A.Object . AM.singleton k
+                AM.singleton k
                   <$> ( F.mapValues (getO k) (setO k)
-                          $ fmap (maybe A.Null A.String)
+                          $ fmap (maybe A.Null (A.String . fromMisoString))
                             . F.mapValues fromJson toJson
-                          $ F.optional (F.input (AK.toString k))
+                          $ F.optional (F.input (toMisoString (AK.toString k)))
                       )
         )
           <$> (M.toList properties)
 
-mergeJson :: [A.Value] -> A.Value
-mergeJson = foldl' mergeObject (A.Object AM.empty)
+mergeJson :: [A.Object] -> A.Object
+mergeJson = foldl' mergeObject AM.empty
 
-mergeObject :: A.Value -> A.Value -> A.Value
-mergeObject (A.Object kvs) (A.Object kvs') = A.Object (AM.union kvs kvs')
+mergeObject :: A.Object -> A.Object -> A.Object
+mergeObject kvs kvs' = AM.union kvs kvs'
 
-fromJson :: A.Value -> T.Text
-fromJson (A.String x) = x
+fromJson :: A.Value -> MisoString
+fromJson (A.String x) = toMisoString x
 fromJson _ = ""
 
-toJson :: T.Text -> A.Value -> A.Value
-toJson x _ = A.String x
+toJson :: MisoString -> A.Value -> A.Value
+toJson x _ = A.String (fromMisoString x)
 
-getO :: AK.Key -> A.Value -> A.Value
-getO k (A.Object kvs) = fromMaybe A.Null (AM.lookup k kvs)
+getO :: AK.Key -> A.Object -> A.Value
+getO k kvs = fromMaybe A.Null (AM.lookup k kvs)
 
-setO :: AK.Key -> A.Value -> A.Value -> A.Value
-setO k v (A.Object kvs) = A.Object (AM.insert k v kvs)
+setO :: AK.Key -> A.Value -> A.Object -> A.Object
+setO k v kvs = AM.insert k v kvs
diff --git a/frontend/frontend.cabal b/frontend/frontend.cabal
index 368049b..65b38f5 100644
--- a/frontend/frontend.cabal
+++ b/frontend/frontend.cabal
@@ -37,11 +37,13 @@ executable frontend
     build-depends:
         aeson,
         attoparsec,
+        backend,
         base,
         bytestring,
         common,
         containers,
         data-default,
+        exceptions,
         miso,
         mtl,
         neat-interpolation,