feat: deleting tutorials

public/styles/pages/editTutorial.scss

@@ -19,10 +19,31 @@
   width: 800px;
 }
 
-.tutorial-editor__title {
+.tutorial-editor__header {
+  display: flex;
+  justify-content: space-between;
+  align-items: center;
   color: $on-primary;
 }
 
+.tutorial-editor__delete {
+  cursor: pointer;
+
+  outline: none;
+  border: none;
+
+  color: inherit;
+  background: none;
+
+  transition: filter $transition-time, transform $transition-time;
+  filter: brightness(0.8);
+}
+
+.tutorial-editor__delete:hover {
+  filter: brightness(1.3);
+  transform: scale(1.2);
+}
+
 .tutorial-editor .form__field.form__field--text {
   background: $very-dark;
 

src/AppM.purs

@@ -125,5 +125,7 @@ instance manageProjectsAppM :: ManageProjects AppM where
 instance manageTutorialsAppM :: ManageTutorials AppM where
   createTutorial = pure $ Right $ TutorialId 0
   deleteTutorial id = Right <$> printString ("Deleted id " <> show id)
-  saveTutorial _ = pure $ Right unit
+  saveTutorial id g = do
+    printString $ "Saving project " <> show id
+    pure $ Right unit
   getTutorial id = pure $ Left $ "Cannot find tutorial " <> show id

src/Capability/Resource/Tutorial.purs

@@ -10,12 +10,12 @@ class
   Monad m <= ManageTutorials m where
   createTutorial :: m (Either String TutorialId)
   deleteTutorial :: TutorialId -> m (Either String Unit)
-  saveTutorial :: Tutorial () -> m (Either String Unit)
+  saveTutorial :: TutorialId -> Tutorial () -> m (Either String Unit)
   getTutorial :: TutorialId -> m (Either String TutorialWithMetadata)
 
 -- | This instance lets us avoid having to use `lift` when we use these functions in a component.
 instance manageTutorialsHalogenM :: ManageTutorials m => ManageTutorials (HalogenM st act slots msg m) where
   createTutorial = lift createTutorial
   deleteTutorial = lift <<< deleteTutorial
-  saveTutorial = lift <<< saveTutorial
+  saveTutorial = (lift <<< _) <<< saveTutorial
   getTutorial = lift <<< getTutorial

src/Component/TutorialEditor.purs

@@ -1,4 +1,6 @@
-module Lunarbox.Component.TutorialEditor where
+module Lunarbox.Component.TutorialEditor
+  ( component
+  ) where
 
 import Prelude
 import Data.Const (Const)
@@ -8,15 +10,20 @@ import Data.Newtype (class Newtype)
 import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff)
 import Formless as F
-import Halogen (modify_)
+import Halogen (get, gets, modify_)
 import Halogen as H
 import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
+import Lunarbox.Capability.Navigate (class Navigate, navigate)
 import Lunarbox.Capability.Resource.Project (class ManageProjects, getProjects)
+import Lunarbox.Capability.Resource.Tutorial (class ManageTutorials, deleteTutorial, saveTutorial)
 import Lunarbox.Component.Error (error)
+import Lunarbox.Component.Icon (icon)
 import Lunarbox.Component.Loading (loading)
 import Lunarbox.Component.Typeahead as TA
 import Lunarbox.Component.Utils (className)
+import Lunarbox.Data.Route (Route(..))
 import Lunarbox.Data.Tutorial (TutorialId, TutorialSpec, UserProject(..))
 import Lunarbox.Form.Field (customFormField)
 import Lunarbox.Form.Field as Field
@@ -39,12 +46,15 @@ type State
 
 data HandleAction
   = HandleTutorial TutorialSpec
+  | Delete
   | Init
 
 component ::
   forall m.
   MonadAff m =>
   ManageProjects m =>
+  ManageTutorials m =>
+  Navigate m =>
   H.Component HH.HTML (Const Void) { | Input () } Void m
 component =
   H.mkComponent
@@ -62,7 +72,29 @@ component =
     }
   where
   handleAction = case _ of
-    HandleTutorial tut -> pure unit
+    HandleTutorial
+      { name
+    , base: UserProject (Tuple _ base)
+    , solution: UserProject (Tuple _ solution)
+    } -> do
+      { id } <- get
+      response <-
+        saveTutorial id
+          { name
+          , base
+          , solution
+          , steps: []
+          , hiddenElements: []
+          }
+      case response of
+        Left err -> modify_ _ { projects = Failure err }
+        _ -> pure unit
+    Delete -> do
+      id <- gets _.id
+      deleteTutorial id
+        >>= case _ of
+            Left err -> modify_ _ { projects = Failure err }
+            _ -> navigate Projects
     Init -> do
       result <- getProjects
       let
@@ -83,6 +115,12 @@ component =
                 [ HH.h1 [ className "tutorial-editor__title" ]
                     [ HH.text "Edit tutorial"
                     ]
+                , HH.button
+                    [ className "tutorial-editor__delete"
+                    , HE.onClick $ const $ Just Delete
+                    ]
+                    [ icon "delete"
+                    ]
                 ]
             , HH.slot F._formless unit formComponent
                 { projects: projects' }

src/Data/Tutorial.purs

@@ -4,13 +4,10 @@ import Prelude
 import Data.Argonaut (class DecodeJson, class EncodeJson)
 import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson)
 import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson)
-import Data.Foldable (fold)
 import Data.Generic.Rep (class Generic)
-import Data.List.Types (List(..), NonEmptyList, (:))
+import Data.List.Types (List)
 import Data.Tuple (Tuple(..))
-import Data.Validation.Semigroup (V, invalid)
-import Lunarbox.Data.Dataflow.Runtime (RuntimeValue(..))
-import Lunarbox.Data.Editor.Node.NodeId (NodeId)
+import Lunarbox.Data.Dataflow.Runtime (RuntimeValue)
 import Lunarbox.Data.ProjectId (ProjectId)
 import Lunarbox.Data.Tab (Tab)
 
@@ -61,45 +58,28 @@ derive newtype instance encodeJsonTutorialId :: EncodeJson TutorialId
 
 derive newtype instance decodeJsonTutorialId :: DecodeJson TutorialId
 
+-- | Type edited by the user visually
+type TutorialSpec
+  = { name :: String
+    , base :: UserProject
+    , solution :: UserProject
+    }
+
 -- | The actual data structure for the tutorials
 type Tutorial r
   = { name :: String
-    , id :: TutorialId
-    , base :: NodeId
-    , requires :: Array TutorialId
+    , base :: ProjectId
+    , solution :: ProjectId
     , steps :: Array TutorialStep
     , hiddenElements :: Array EditorElement
-    , tests :: Array TutorialTest
     | r
     }
 
 type TutorialFields
   = Tutorial ()
 
 type TutorialWithMetadata
-  = Tutorial ( completed :: Boolean )
-
--- | Possible errors we can get by validating a tutorial
-data TutorialValidationError
-  = NonEqual RuntimeValue RuntimeValue
-  | ExpectedFunction RuntimeValue RuntimeValue
-
--- | Validate a test
-validateTest :: RuntimeValue -> TutorialTest -> V (NonEmptyList TutorialValidationError) Unit
-validateTest result (Test { inputs: Nil, output })
-  | result == output = pure unit
-  | otherwise = invalid $ pure $ NonEqual result output
-
-validateTest (Function call) (Test { inputs: head : inputs, output }) =
-  validateTest
-    (call head)
-    (Test { inputs, output })
-
-validateTest nonFunction (Test { output }) = invalid $ pure $ ExpectedFunction nonFunction output
-
--- | Validate a tutorial
-validateTutorial :: forall r. RuntimeValue -> Tutorial r -> V (NonEmptyList TutorialValidationError) Unit
-validateTutorial main { tests } = fold $ validateTest main <$> tests
+  = Tutorial ( completed :: Boolean, id :: TutorialId )
 
 newtype UserProject
   = UserProject (Tuple String ProjectId)
@@ -111,10 +91,3 @@ instance showUserProject :: Show UserProject where
 
 instance semigroupUserProject :: Semigroup UserProject where
   append a b = b
-
--- | Type edited by the user visually
-type TutorialSpec
-  = { name :: String
-    , base :: UserProject
-    , solution :: UserProject
-    }