Update Formless to be Halogen 5 compatible (#46)

* initial commit for v5 -- library compiling * tweaks * rework to support queries and actions * update app helpers to latest Select * update most examples (todo: nested-array, real-world) * update nested array example * switch queries to allow access to public actions * examples building -- missing querying only * complete real world example * clean up real world example * update readme * tweak readme * fix demo examples * add warning to readme about versions * allow users to provide to generate initial form values * tweak readme * switch to Maybe for initial inputs fields * move internal functions from component to Internal module and add message to Slot' type * add raiseResult function to reduce boilerplate; adjust Slot' type to accept a message * update Slot' type * fix type signature of raiseResult * Remove extra whitespace * Change type parameter name: 'ps' (Halogen 4) to 'slots' (Halogen 5) * Expose Halogen's input type * Update examples to account for Halogen's `input` type * Renamed modules: 'Component' to 'Page' and 'FormSpec' to 'Form' * Remove unneeded `defaultEval`: already creating the full record * Rename Formless' `Message` type to `Event` * Update examples to use new `Event` type * Import & whitespace fixes for PureScript 0.13 (#51) * Fix mixed indentation * Update Row and RowList imports * Make examples compile again. (#54) * Add Formless component template file (#53) * Added Formless component template * Further cleanup template * Fix indentation for template * Fix typo in template example * Template file: convert MonadType to m with MonadAff constraint * Template file: document handleEvent function * Temlate file: document mkInput * Template file: more clearly document getInput and setValidate functions * Use comments to further document template file
thomashoneyman · Aug 19, 2019 · d7151f8 · d7151f8
1 parent 55e2453
commit d7151f8
Show file tree

Hide file tree

Showing 49 changed files with 2,985 additions and 3,019 deletions.
diff --git a/.gitignore b/.gitignore
@@ -13,3 +13,4 @@ dist/*
 !dist/cn-tailwind.min.css
 !dist/storybook.css
 *.lock
+*.swp
diff --git a/bower.json b/bower.json
@@ -19,17 +19,15 @@
     "tests"
   ],
   "dependencies": {
-    "purescript-halogen": "^4.0.0",
-    "purescript-halogen-renderless": "^0.0.3",
-    "purescript-variant": "^5.0.0",
-    "purescript-heterogeneous": "^0.3.0",
-    "purescript-generics-rep": "^6.1.0"
+    "purescript-halogen": "^5.0.0-rc.6",
+    "purescript-variant": "^6.0.0",
+    "purescript-heterogeneous": "^0.4.0",
+    "purescript-generics-rep": "^6.1.0",
+    "purescript-profunctor-lenses": "^6.2.0"
   },
   "devDependencies": {
-    "purescript-halogen-storybook": "^0.4.0",
     "purescript-debug": "^4.0.0",
-    "purescript-test-unit": "^14.0.0",
-    "purescript-read": "^1.0.1",
-    "purescript-halogen-select": "^2.0.0"
+    "purescript-halogen-select": "master",
+    "purescript-halogen-storybook": "master"
   }
 }
diff --git a/default.nix b/default.nix
@@ -0,0 +1,10 @@
+{ nixpkgs ? import <nixpkgs> {} }:
+
+nixpkgs.stdenv.mkDerivation {
+  name = "env";
+  buildInputs = [
+    nixpkgs.nodejs
+    nixpkgs.yarn 
+    nixpkgs.stack 
+  ];
+}
diff --git a/example/App/Home.purs b/example/App/Home.purs
@@ -2,7 +2,7 @@ module Example.App.Home where
 
 import Prelude
 
-import Data.Maybe (Maybe(..))
+import Data.Const (Const)
 import Effect.Aff (Aff)
 import Example.App.UI.Element as UI
 import Halogen as H
@@ -12,42 +12,28 @@ import Halogen.HTML.Properties as HP
 -----
 -- Render
 
-render :: H.ComponentHTML Box
+render :: forall i p. HH.HTML i p
 render =
   UI.section_
-  [ UI.h1_ [ HH.text "Formless" ]
-  , UI.h2_ [ HH.text "A renderless component for painless forms in Halogen" ]
-  , UI.content_
-    [ UI.p_ $
-      "Formless allows you to write a small, simple spec for your form and receive "
-      <> "state updates, validation, dirty states, submission handling, and more for "
-      <> "free. You are responsible for providing an initial value and a validation "
-      <> "function for every field in your form, but beyond that, Formless will take "
-      <> "care of things behind the scenes without ever imposing on how you'd like to "
-      <> "render and display your form. You can freely use external Halogen components, "
-      <> "add new form behaviors on top (like dependent validation or clearing sets of "
-      <> "fields), and more."
-      <> "\n"
-    , UI.a
-      [ HP.href "https://github.com/thomashoneyman/purescript-halogen-formless" ]
-      [ HH.text "purescript-halogen-formless" ]
-    ]
+    [ UI.h1_ [ HH.text "Formless" ]
+    , UI.h2_ [ HH.text "A renderless component for painless forms in Halogen" ]
+    , UI.content_
+        [ UI.p_
+            """
+            Formless allows you to write a small, simple spec for your form and receive state updates, validation, dirty states, submission handling, and more for free. You are responsible for providing an initial value and a validation function for every field in your form, but beyond that, Formless will take care of things behind the scenes without ever imposing on how you'd like to render and display your form. You can freely use external Halogen components, add new form behaviors on top (like dependent validation or clearing sets of fields), and more.
+            """
+        , UI.a
+            [ HP.href "https://github.com/thomashoneyman/purescript-halogen-formless" ]
+            [ HH.text "purescript-halogen-formless" ]
+      ]
   ]
 
------
 -- Component
 
-data Box a = Box a
-
-component :: H.Component HH.HTML Box Unit Void Aff
-component = H.component
+component :: H.Component HH.HTML (Const Void) Unit Void Aff
+component = H.mkComponent
   { initialState: const unit
   , render: const render
-  , eval
-  , receiver: const Nothing
+  , eval: H.mkEval H.defaultEval
   }
 
-  where
-
-  eval :: Box ~> H.ComponentDSL Unit Box Void Aff
-  eval (Box a) = pure a
diff --git a/example/App/UI/Dropdown.purs b/example/App/UI/Dropdown.purs
@@ -3,132 +3,132 @@ module Example.App.UI.Dropdown where
 import Prelude
 
 import DOM.HTML.Indexed (HTMLbutton)
-import Data.Array (difference, mapWithIndex)
+import Data.Array (difference, mapWithIndex, length, (!!))
 import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Symbol (SProxy(..))
+import Data.Traversable (for_)
 import Effect.Aff.Class (class MonadAff)
-import Example.App.UI.Element (css)
+import Example.App.UI.Element (class_)
 import Example.App.UI.Element as UI
 import Example.App.Validation (class ToText, toText)
 import Halogen as H
 import Halogen.HTML as HH
-import Halogen.HTML.Events as HE
 import Select as Select
-import Select.Utils.Setters as Setters
+import Select.Setters as Setters
 
-data Query item a
-  = HandleSelect (Select.Message (Query item) item) a
-  | Clear a
+type Slot item =
+  H.Slot (Select.Query Query ()) (Message item)
+
+_dropdown = SProxy :: SProxy "dropdown"
+
+data Query a 
+  = Clear a
+
+clear :: Select.Query Query () Unit
+clear = Select.Query (H.tell Clear)
 
 type State item =
-  { selected :: Maybe item
+  ( selected :: Maybe item
+  , available :: Array item
   , items :: Array item
   , placeholder :: String
-  }
+  )
 
 type Input item =
   { items :: Array item
   , placeholder :: String
   }
 
+input :: forall item. Input item -> Select.Input (State item)
+input { items, placeholder } =
+  { inputType: Select.Toggle
+  , search: Nothing
+  , debounceTime: Nothing
+  , getItemCount: length <<< _.items
+  , selected: Nothing
+  , available: items
+  , items
+  , placeholder
+  }
+
 data Message item
   = Selected item
   | Cleared
 
-type ChildSlot = Unit
-type ChildQuery item = Select.Query (Query item) item
-
-component
-  :: ∀ item m
-   . MonadAff m
+spec 
+  :: forall item m i
+   . MonadAff m 
   => ToText item
   => Eq item
-  => H.Component HH.HTML (Query item) (Input item) (Message item) m
-component =
-  H.parentComponent
-    { initialState
-    , render
-    , eval
-    , receiver: const Nothing
-    }
+  => Select.Spec (State item) Query Void () i (Message item) m
+spec = Select.defaultSpec
+  { render = render 
+  , handleQuery = handleQuery 
+  , handleEvent = handleEvent
+  }
   where
+  render st =
+    HH.div
+      [ if st.visibility == Select.On then class_ "dropdown is-active" else class_ "dropdown" ]
+      [ toggle [] st, menu st ]
 
-  initialState :: Input item -> State item
-  initialState { items, placeholder } =
-    { selected: Nothing
-    , items
-    , placeholder
-    }
-
-  render :: State item -> H.ParentHTML (Query item) (ChildQuery item) ChildSlot m
-  render parentState =
-    HH.slot unit Select.component selectInput (HE.input HandleSelect)
-    where
-      selectInput =
-        { inputType: Select.Toggle
-        , items: parentState.items
-        , initialSearch: Nothing
-        , debounceTime: Nothing
-        , render: dropdown
-        }
-
-      dropdown childState =
-        HH.div
-          [ if childState.visibility == Select.On then css "dropdown is-active" else css "dropdown" ]
-          [ toggle [] parentState
-          , menu childState
-          ]
-
-  eval :: Query item ~> H.ParentDSL (State item) (Query item) (ChildQuery item) ChildSlot (Message item) m
-  eval = case _ of
-    Clear next -> do
-      st <- H.modify _ { selected = Nothing }
-      _ <- H.query unit $ Select.replaceItems st.items
-      pure next
-
-    HandleSelect message next -> case message of
-      Select.Selected item -> do
-        st <- H.get
-        _ <- H.query unit $ Select.setVisibility Select.Off
-        _ <- H.query unit $ Select.replaceItems $ difference st.items [ item ]
-        H.modify_ _ { selected = Just item }
+  handleQuery :: forall a. Query a -> H.HalogenM _ _ _ _ _ (Maybe a)
+  handleQuery = case _ of
+    Clear a -> do
+      H.modify_ \st -> st { selected = Nothing, available = st.items }
+      H.raise Cleared
+      pure (Just a)
+
+  handleEvent = case _ of
+    Select.Selected ix -> do
+      st <- H.get
+      let mbItem = st.available !! ix
+      for_ mbItem \item -> do
+        H.modify_ _
+          { selected = Just item
+          , available = difference st.items [ item ]
+          , visibility = Select.Off 
+          }
         H.raise (Selected item)
-        pure next
-      _ -> pure next
+    _ -> pure unit
 
 toggle
-  :: ∀ item q r
+  :: forall item act ps m r
    . ToText item
-  => Array (HH.IProp HTMLbutton (Select.Query q item Unit))
+  => Array (HH.IProp HTMLbutton (Select.Action act))
   -> { placeholder :: String, selected :: Maybe item | r }
-  -> Select.ComponentHTML q item
-toggle props parentState =
+  -> H.ComponentHTML (Select.Action act) ps m
+toggle props st =
   HH.div
-  [ css "dropdown-trigger" ]
+  [ class_ "dropdown-trigger" ]
   [ UI.button
     ( Setters.setToggleProps props )
-    [ HH.text $ fromMaybe parentState.placeholder (toText <$> parentState.selected) ]
+    [ HH.text $ fromMaybe st.placeholder (toText <$> st.selected) ]
   ]
 
 menu
-  :: ∀ item q
+  :: forall item st act ps m
    . ToText item
-  => Select.State item
-  -> Select.ComponentHTML q item
-menu selectState =
+  => Select.State (available :: Array item | st)
+  -> H.ComponentHTML (Select.Action act) ps m
+menu st =
   HH.div
-  [ css "dropdown-menu" ]
-  [ if selectState.visibility == Select.Off then HH.text "" else
+  [ class_ "dropdown-menu" ]
+  [ if st.visibility == Select.Off then HH.text "" else
     HH.div
-    ( Setters.setContainerProps [ css "dropdown-content" ] )
-    ( mapWithIndex (\ix item ->
-        HH.span
-          ( Setters.setItemProps ix
-            $ case Just ix == selectState.highlightedIndex of
-                true -> [ css "dropdown-item has-background-link has-text-white-bis" ]
-                _ -> [ css "dropdown-item" ]
-          )
-          [ HH.text (toText item) ]
+      (Setters.setContainerProps [ class_ "dropdown-content" ])
+      (mapWithIndex 
+        (\ix item ->
+          HH.span
+            (Setters.setItemProps ix case Just ix == st.highlightedIndex of
+              true -> 
+                [ class_ "dropdown-item has-background-link has-text-white-bis" ]
+              _ -> 
+                [ class_ "dropdown-item" ]
+            )
+            [ HH.text (toText item) ]
         )
-      selectState.items
-    )
+        st.available
+      )
   ]
+