feat: not only editing, but also creating tutorials

src/AppM.purs

@@ -27,7 +27,7 @@ import Lunarbox.Capability.Resource.User (class ManageUser)
 import Lunarbox.Config (Config, _changeRoute, _currentUser, _userBus)
 import Lunarbox.Control.Monad.Effect (printString)
 import Lunarbox.Data.Editor.Save (jsonToState, stateToJson)
-import Lunarbox.Data.ProjectId (ProjectId)
+import Lunarbox.Data.ProjectId (ProjectId(..))
 import Lunarbox.Data.ProjectList (ProjectOverview, TutorialOverview)
 import Lunarbox.Data.Route (routingCodec)
 import Lunarbox.Data.Route as Route
@@ -132,7 +132,19 @@ instance manageTutorialsAppM :: ManageTutorials AppM where
   saveTutorial id g = do
     printString $ "Saving project " <> show id
     pure $ Right unit
-  getTutorial id = pure $ Left $ "Cannot find tutorial " <> show id
+  getTutorial id
+    -- We mock this until bg makes the api
+    | id == TutorialId 7 =
+      pure $ Right
+        $ { name: "My super duper awesome tutorial"
+          , base: ProjectId 74
+          , solution: ProjectId 80
+          , hiddenElements: []
+          , id
+          , steps: []
+          , completed: false
+          }
+    | otherwise = pure $ Left $ "Cannot find tutorial " <> show id
 
 instance manageGistsAppM :: ManageGists AppM where
   fetchGist id = do

src/Component/Projects.purs

@@ -240,7 +240,7 @@ component =
     where
     go { tutorials } =
       HH.div [ className "projects__list" ]
-        $ [ newProject CreateProject ]
+        $ [ newProject CreateTutorial ]
         <> (mkItem <$> tutorials)
       where
       mkItem { name, completed, id } =

src/Component/TutorialEditor.purs

@@ -5,30 +5,32 @@ module Lunarbox.Component.TutorialEditor
 import Prelude
 import Data.Const (Const)
 import Data.Either (Either(..))
+import Data.Foldable (find)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
 import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff)
+import Formless (InputField(..))
 import Formless as F
-import Halogen (get, gets, modify_)
+import Halogen (fork, 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.Capability.Resource.Tutorial (class ManageTutorials, deleteTutorial, getTutorial, 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.Data.Tutorial (TutorialFields, TutorialId, TutorialSpec, UserProject(..))
 import Lunarbox.Form.Field (customFormField)
 import Lunarbox.Form.Field as Field
 import Lunarbox.Form.Validation as V
-import Network.RemoteData (RemoteData(..))
+import Network.RemoteData (RemoteData(..), fromEither)
 import Record as Record
 import Select as Select
 
@@ -41,6 +43,7 @@ type State
   = { 
     | Input
       ( projects :: RemoteData String (Array UserProject)
+      , tutorial :: RemoteData String TutorialFields
       )
     }
 
@@ -61,6 +64,7 @@ component =
     { initialState:
       Record.merge
         { projects: NotAsked
+        , tutorial: NotAsked
         }
     , render
     , eval:
@@ -96,18 +100,26 @@ component =
             Left err -> modify_ _ { projects = Failure err }
             _ -> navigate Projects
     Init -> do
-      result <- getProjects
-      let
-        projects = case result of
-          Right { userProjects } -> Success $ mkProject <$> userProjects
-            where
-            mkProject { id, name } = UserProject $ Tuple name id
-          Left err -> Failure err
-      modify_ _ { projects = projects }
-
-  render { projects } = case projects of
-    Failure err -> error err
-    Success projects' ->
+      void $ fork fetchTutorial
+      void $ fork fetchProjects
+
+  fetchTutorial = do
+    id <- gets _.id
+    tutorial <- getTutorial id
+    modify_ _ { tutorial = fromEither tutorial }
+
+  fetchProjects = do
+    result <- getProjects
+    let
+      projects = case result of
+        Right { userProjects } -> Success $ mkProject <$> userProjects
+          where
+          mkProject { id, name } = UserProject $ Tuple name id
+        Left err -> Failure err
+    modify_ _ { projects = projects }
+
+  render { projects, tutorial } = case projects, tutorial of
+    Success projects', Success tutorial' ->
       HH.div [ className "tutorial-editor" ]
         [ HH.div
             [ className "tutorial-editor__main" ]
@@ -123,11 +135,24 @@ component =
                     ]
                 ]
             , HH.slot F._formless unit formComponent
-                { projects: projects' }
+                { projects: projects'
+                , spec:
+                  TutorialForm
+                    { name: InputField tutorial'.name
+                    , base: InputField $ mkUserProject tutorial'.base
+                    , solution: InputField $ mkUserProject tutorial'.solution
+                    }
+                }
                 (Just <<< HandleTutorial)
             ]
         ]
-    _ -> loading
+      where
+      mkUserProject target = find go projects'
+        where
+        go (UserProject (Tuple _ id)) = id == target
+    Failure err, _ -> error err
+    _, Failure err -> error err
+    _, _ -> loading
 
 -- Formless form for tutorials
 newtype TutorialForm r f
@@ -143,7 +168,9 @@ derive instance newtypeTutorialForm :: Newtype (TutorialForm r f) _
 
 -- | Input to describe what options the typeahead in the form has
 type FormInput
-  = { projects :: Array UserProject }
+  = { projects :: Array UserProject
+    , spec :: TutorialForm Record F.InputField
+    }
 
 data FormAction
   = HandleTypeahead UserProjectTypeahead (TA.Message Maybe UserProject)
@@ -175,16 +202,16 @@ formComponent =
   where
   handleEvent = F.raiseResult
 
-  formInput =
-    Record.merge
-      { validators:
-        TutorialForm
-          { name: F.noValidation
-          , base: V.exists
-          , solution: V.exists
-          }
-      , initialInputs: Nothing
-      }
+  formInput { spec, projects } =
+    { validators:
+      TutorialForm
+        { name: F.noValidation
+        , base: V.exists
+        , solution: V.exists
+        }
+    , projects
+    , initialInputs: Just spec
+    }
 
   handleAction = case _ of
     HandleTypeahead slot (TA.SelectionsChanged new) -> case slot of
@@ -206,11 +233,13 @@ formComponent =
               $ singleTypeahead Base
                   { placeholder: "My awesome base project"
                   , items: projects
+                  , selected: F.getInput proxies.base form
                   }
-          , customFormField proxies.base form
+          , customFormField proxies.solution form
               $ singleTypeahead Solution
                   { placeholder: "My awesome solution"
                   , items: projects
+                  , selected: F.getInput proxies.solution form
                   }
           , Field.submit "Save"
           ]

src/Component/Typeahead.purs

@@ -61,14 +61,20 @@ type State f item
     , placeholder :: String
     )
 
+type Input f item
+  = { items :: Array item
+    , placeholder :: String
+    , selected :: f item
+    }
+
 -- Generates the select input from the dropdown input
-input :: forall f item. Monoid (f item) => Dropdown.Input item -> Select.Input (State f item)
-input { items, placeholder } =
+input :: forall f item. Monoid (f item) => Input f item -> Select.Input (State f item)
+input { items, placeholder, selected } =
   { inputType: Select.Text
   , search: Nothing
   , debounceTime: Nothing
   , getItemCount: length <<< _.items
-  , selected: mempty
+  , selected
   , available: items
   , items
   , placeholder