studio: Generalize CRUDAction a bit more. #381

halogen-grid-kit/src/View/CRUDAction.purs

@@ -12,30 +12,35 @@ import Data.String (drop)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Random (random)
 
-data CRUDAction a
+data CRUDAction k a
   = CreateAction a
-  | UpdateAction (a -> a) String
-  | DeleteAction String
+  | UpdateAction (a -> a) k
+  | DeleteAction k
 
+-- TODO: remove next 2 lines if a new version of purescript-profunctor-lenses is published
 type Affine s t a b = forall p. Strong p => Choice p => Optic p s t a b
 type Affine' s a = Affine s s a a
 
 handleCRUDAction
-  :: ∀ m s t a. MonadEffect m => MonadState s m => At t String a
-  => Affine' s t -> CRUDAction a -> (String -> Maybe a -> m Unit) -> m Unit
-handleCRUDAction l action eventHandler =
+  :: ∀ m s t k a. MonadState s m => At t k a
+  => m k -> Affine' s t -> CRUDAction k a -> (k -> Maybe a -> m Unit) -> m Unit
+handleCRUDAction genId l action eventHandler =
   case action of
     CreateAction a -> do
-      rnd <- liftEffect random
-      let id = "id" <> drop 2 (show rnd)
+      id <- genId
       handle id $ Just a
     UpdateAction f id -> do
       s <- get
       handle id (map f (join (preview (l <<< at id) s)))
     DeleteAction id -> do
       handle id Nothing
   where
-    handle :: String -> Maybe a -> m Unit
+    handle :: k -> Maybe a -> m Unit
     handle id mValue = do
       l <<< at id .= mValue
       eventHandler id mValue
+
+getRandomId :: ∀ m. MonadEffect m => String -> m String
+getRandomId prefix = do
+  rnd <- liftEffect random
+  pure $ prefix <> drop 2 (show rnd)

halogen-tree-menu/src/TreeMenu.purs

@@ -45,7 +45,7 @@ type MenuTree act r = RoseTree (Item act r)
 
 type RoseTree a = Cofree Array a
 
-data WrapAction = WrapAction (forall t. String -> CRUDAction { name :: String | t })
+data WrapAction = WrapAction (forall t. String -> CRUDAction String { name :: String | t })
 type Edit act = Maybe (WrapAction -> act)
 type Item act r = { label :: String, route :: Maybe r, onEdit :: Edit act }
 

studio/src/View/Studio.purs

@@ -137,7 +137,7 @@ handleAction = case _ of
              (\pnproDoc -> handleAction $ CRUDProject $ CreateAction $ fromPNPROProject pnproDoc.project)
       )
 
-  CRUDProject action -> handleCRUDAction _projects action \id mProject -> H.raise $ ProjectChanged id mProject
+  CRUDProject action -> handleCRUDAction (getRandomId "p") _projects action \id mProject -> H.raise $ ProjectChanged id mProject
 
   CRUDKDMonCat action -> handleCRUDActionInProject _kdmoncats action
 
@@ -179,12 +179,12 @@ handleAction = case _ of
     H.liftEffect $ Event.stopPropagation event
     for_ mAction handleAction
 
-handleCRUDActionInProject :: ∀ m t a. MonadAff m => At t String a => Affine' Project t -> CRUDAction a -> HalogenM State Action ChildSlots Output m Unit
+handleCRUDActionInProject :: ∀ m t a. MonadAff m => At t String a => Affine' Project t -> CRUDAction String a -> HalogenM State Action ChildSlots Output m Unit
 handleCRUDActionInProject l action = do
   state <- H.get
   case state.route of
     ProjectRoute pid proute -> do
-      handleCRUDAction (_projects <<< at pid <<< _Just <<< l) action
+      handleCRUDAction (getRandomId "id") (_projects <<< at pid <<< _Just <<< l) action
         \_ _ -> do
           state' <- H.get
           for_ (Map.lookup pid state'.projects) (Just >>> ProjectChanged pid >>> H.raise)

studio/src/View/Studio/Model.purs

@@ -47,8 +47,8 @@ data Action
   | HandleKDMonCatAppMsg String KDMonCat.App.Output
   | ToggleEditMode
 
-  | CRUDProject (CRUDAction Project)
-  | CRUDKDMonCat (CRUDAction KDMonCatData)
+  | CRUDProject (CRUDAction String Project)
+  | CRUDKDMonCat (CRUDAction String KDMonCatData)
 
   | StopEvent (Maybe Action) Event