WIP: Convert to row slots

citizennet · Apr 26, 2018 · 653ce4bce2cd5dc17892830fb9917fe4f81e2c21 · 653ce4b
1 parent bde6a56
commit 653ce4bce2cd5dc17892830fb9917fe4f81e2c21
diff --git a/bower.json b/bower.json
@@ -53,5 +53,8 @@
    "purescript-coroutines": "^4.0.0",
    "purescript-aff-coroutines": "^6.0.0",
    "purescript-affjax": "^5.0.0"
+  
+  },
+  
+  "resolutions": {
+  
+    "purescript-halogen": "^3.1.1"
  }
 }
diff --git a/docs/src/App/Component.purs b/docs/src/App/Component.purs
@@ -4,6 +4,7 @@ module Docs.App.Component where
 import Prelude
+  
+import Data.Symbol (SProxy(..))
 import Control.Monad.Aff.Class (class MonadAff)
 import Control.Monad.Eff.AVar (AVAR)
 import Control.Monad.Eff.Console (CONSOLE)
@@ -26,29 +27,43 @@ type Message = Void
 data Query a = NoOp a
-  
-type Component m = H.Component HH.HTML Query Unit Void m
-  
-type DSL q m = H.ParentDSL State Query q Unit Void m
-  
-type HTML q m = H.ParentHTML Query q Unit m
+  
+type Component slot m = H.Component HH.HTML Query slot Void m
+  
+type DSL m = H.HalogenM State Query Slots Void m
+  
+type HTML m = H.ComponentHTML Query Slots m
-  
-type Effects eff = ( console :: CONSOLE, dom :: DOM, now :: NOW, avar :: AVAR, timer :: TIMER | eff )
+  
+type Slots =
+  
+  ( dropdown :: H.Slot Dropdown.Query Void Unit
+  
+  , typeahead :: H.Slot Typeahead.Query Typeahead.Message Unit
+  
+  )
+  
+
+  
+type Effects eff =
+  
+  ( console :: CONSOLE, dom :: DOM, now :: NOW, avar :: AVAR, timer :: TIMER | eff )
 ----------
 -- Built components
-  
-typeahead :: ∀ eff m. MonadAff ( Effects eff ) m => Component m
+  
+typeahead :: ∀ eff slot m. MonadAff ( Effects eff ) m => Component slot m
 typeahead =
-  
-  H.parentComponent
+  
+  H.component
    { initialState: const unit
    , render
    , eval
    , receiver: const Nothing
+  
+    , initializer: Nothing
+  
+    , finalizer: Nothing
    }
  where
-  
-    eval :: Query ~> DSL Typeahead.Query m
+  
+    eval :: Query ~> DSL m
    eval (NoOp a) = pure a
-  
-    render :: Unit -> HTML Typeahead.Query m
-  
-    render _ = HH.slot unit Typeahead.component { items: users, keepOpen: false } (const Nothing)
+  
+    render :: Unit -> HTML m
+  
+    render _ =
+  
+      HH.slot
+  
+        (SProxy :: SProxy "typeahead")
+  
+        unit
+  
+        Typeahead.component
+  
+        { items: users, keepOpen: false }
+  
+        (const Nothing)
    users :: Array String
    users =
@@ -60,20 +75,23 @@ typeahead =
      , "Rico Suave"
      ]
-  
-dropdown :: ∀ eff m. MonadAff ( Effects eff ) m => Component m
+  
+dropdown :: ∀ slot eff m. MonadAff ( Effects eff ) m => Component slot m
 dropdown =
-  
-  H.parentComponent
+  
+  H.component
    { initialState: const unit
    , render
    , eval
    , receiver: const Nothing
+  
+    , initializer: Nothing
+  
+    , finalizer: Nothing
    }
  where
-  
-    eval :: Query ~> DSL Dropdown.Query m
+  
+    eval :: Query ~> DSL m
    eval (NoOp a) = pure a
-  
-    render :: Unit -> HTML Dropdown.Query m
-  
-    render _ = HH.slot unit Dropdown.component { items: users } (const Nothing)
+  
+    render :: Unit -> HTML m
+  
+    render _ =
+  
+      HH.slot (SProxy :: SProxy "dropdown") unit Dropdown.component { items: users } (const Nothing)
    users :: Array String
    users =
diff --git a/docs/src/App/Proxy.purs b/docs/src/App/Proxy.purs
@@ -8,6 +8,7 @@ module Docs.App.Proxy
 import Prelude
+  
+import Data.Symbol (class IsSymbol, SProxy(..))
 import Data.Const (Const(..))
 import Data.Coyoneda (Coyoneda, unCoyoneda)
 import Data.Maybe (Maybe(..))
@@ -19,27 +20,27 @@ data ProxyS f i a
  = Query (Coyoneda f a)
 -- | A proxy that hides both the Query and Message of wrapped component.
-  
-proxy
-  
-  :: forall f i o m
-  
-  . H.Component HH.HTML f i o m
+  
+proxy :: ∀ f i o m
+  
+   . H.Component HH.HTML f i o m
  -> H.Component HH.HTML (ProxyS (Const Void) i) i Void m
 proxy = proxyEval (const (absurd <<< un Const))
-  
-proxyEval
-  
-  :: forall f g i o m
-  
-   . (forall a b. (b -> a) -> g b -> H.ParentDSL i (ProxyS g i) f Unit Void m a)
-  
-  -> H.Component HH.HTML f i o m
-  
-  -> H.Component HH.HTML (ProxyS g i) i Void m
-  
-proxyEval evalQuery component =
-  
-  H.parentComponent
+  
+proxyEval :: ∀ f g i o m sym
+  
+   . IsSymbol sym
+  
+  => SProxy sym
+  
+  -> _ -- (∀ a b. (b -> a) -> g b -> H.HalogenM i (ProxyS g i) f Void m a)
+  
+  -> _ -- H.Component HH.HTML f i o m
+  
+  -> _ -- H.Component HH.HTML (ProxyS g i) i Void m
+  
+proxyEval sym evalQuery component =
+  
+  H.component
    { initialState: id
    , render
    , eval
    , receiver: const Nothing
    }
  where
-  
-    render :: i -> H.ParentHTML (ProxyS g i) f Unit m
-  
-    render i = HH.slot unit component i (const Nothing)
+  
+    render :: i -> H.ComponentHTML (ProxyS g i) f m
+  
+    render i = HH.slot sym unit component i (const Nothing)
-  
-    eval :: ProxyS g i ~> H.ParentDSL i (ProxyS g i) f Unit Void m
+  
+    eval :: ProxyS g i ~> H.HalogenM i (ProxyS g i) f Void m
    eval (Query iq) = unCoyoneda evalQuery iq
diff --git a/docs/src/Components/Dropdown/Dropdown.purs b/docs/src/Components/Dropdown/Dropdown.purs
@@ -2,36 +2,38 @@ module Docs.Components.Dropdown where
 import Prelude
+  
+import Control.Monad.Aff.AVar (AVAR)
 import Control.Monad.Aff.Class (class MonadAff)
 import Control.Monad.Aff.Console (CONSOLE)
-  
-import Control.Monad.Aff.AVar (AVAR)
 import DOM (DOM)
 import Data.Array (difference, mapWithIndex)
 import Data.Maybe (Maybe(..))
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
-  
-import Select.Utils.Setters as Setters
+  
+import Select (_select)
 import Select as Select
+  
+import Select.Utils.Setters as Setters
 type Effects eff = ( avar :: AVAR, dom :: DOM, console :: CONSOLE | eff )
 type State = { items :: Array String, text :: String }
 type Input = { items :: Array String }
 data Query a = HandleSelect (Select.Message Query String) a
-  
-data Message = Void
-  
-type ChildSlot = Unit
-  
-type ChildQuery eff = Select.Query Query String eff
+  
+type ChildSlots eff m =
+  
+  ( select :: Select.Slot Query String eff m Unit )
-  
-component :: ∀ m e
+  
+component :: ∀ e m
  . MonadAff ( Effects e ) m
-  
- => H.Component HH.HTML Query Input Message m
+  
+ => H.Component HH.HTML Query Input Void m
 component =
-  
-  H.parentComponent
+  
+  H.component
    { initialState
    , render
    , eval
+  
+    , initializer: Nothing
+  
+    , finalizer: Nothing
    , receiver: const Nothing
    }
  where
@@ -40,24 +42,24 @@ component =
    eval
      :: Query
-  
-      ~> H.ParentDSL State Query (ChildQuery (Effects e)) ChildSlot Message m
+  
+      ~> H.HalogenM State Query (ChildSlots (Effects e) m) Void m
    eval = case _ of
      HandleSelect (Select.Selected item) a -> do
        st <- H.get
-  
-        _ <- H.query unit $ H.action $ Select.SetVisibility Select.Off
-  
-        _ <- H.query unit $ H.action $ Select.ReplaceItems (difference st.items [ item ])
+  
+        _ <- H.query _select unit $ H.action $ Select.SetVisibility Select.Off
+  
+        _ <- H.query _select unit $ H.action $ Select.ReplaceItems (difference st.items [ item ])
        H.modify _ { text = item }
        pure a
      HandleSelect other a -> pure a
    render
      :: State
-  
-      -> H.ParentHTML Query (ChildQuery (Effects e)) ChildSlot m
+  
+      -> H.ComponentHTML Query (ChildSlots (Effects e) m) m
    render st =
      HH.div
        [ class_ "w-full" ]
-  
-        [ HH.slot unit Select.component input (HE.input HandleSelect) ]
+  
+        [ Select.select unit input (HE.input HandleSelect) ]
      where
        input =
          { initialSearch: Nothing
@@ -70,15 +72,18 @@ component =
        class_ :: ∀ p i. String -> H.IProp ( "class" :: String | i ) p
        class_ = HP.class_ <<< HH.ClassName
-  
-        renderDropdown :: Select.State String (Effects e) -> Select.ComponentHTML Query String (Effects e)
+  
+        renderDropdown
+  
+          :: Select.State String (Effects e)
+  
+          -> Select.ComponentHTML Query String (Effects e) m
        renderDropdown state = HH.div_ [ renderToggle, renderContainer ]
          where
            renderToggle =
              HH.button
                ( Setters.setToggleProps props )
                [ HH.text st.text ]
                where
-  
-                  props = [ class_ "bg-blue hover:bg-blue-dark text-white font-bold py-2 px-4 rounded-sm w-full flex" ]
+  
+                  props = [ class_ $ "bg-blue hover:bg-blue-dark text-white "
+  
+                                  <> "font-bold py-2 px-4 rounded-sm w-full flex" ]
            renderContainer =
              HH.div [ class_ "relative z-50" ]
diff --git a/docs/src/Components/Typeahead/Typeahead.purs b/docs/src/Components/Typeahead/Typeahead.purs
@@ -2,9 +2,9 @@ module Docs.Components.Typeahead where
 import Prelude
+  
+import Control.Monad.Aff.AVar (AVAR)
 import Control.Monad.Aff.Class (class MonadAff)
 import Control.Monad.Aff.Console (CONSOLE, log)
-  
-import Control.Monad.Aff.AVar (AVAR)
 import DOM (DOM)
 import Data.Array (elemIndex, mapWithIndex, difference, filter, (:))
 import Data.Foldable (length, traverse_)
@@ -14,7 +14,7 @@ import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
-  
-
+  
+import Select (_select)
 import Select as Select
 import Select.Utils.Setters as Setters
@@ -35,17 +35,19 @@ type State =
 type Input = { items :: Array String, keepOpen :: Boolean }
 data Message = Void
-  
-type ChildSlot = Unit
-  
-type ChildQuery eff = Select.Query Query TypeaheadItem eff
+  
+type ChildSlots eff (m :: Type -> Type) =
+  
+  ( select :: Select.Slot Query TypeaheadItem eff m Unit )
 component :: ∀ m e
  . MonadAff ( Effects e ) m
 => H.Component HH.HTML Query Input Message m
 component =
-  
-  H.parentComponent
+  
+  H.component
    { initialState
    , render
    , eval
+  
+    , initializer: Nothing
+  
+    , finalizer: Nothing
    , receiver: const Nothing
    }
  where
@@ -54,12 +56,12 @@ component =
    render
      :: State
-  
-      -> H.ParentHTML Query (ChildQuery (Effects e)) ChildSlot m
+  
+      -> H.ComponentHTML Query (ChildSlots (Effects e) m) m
    render st =
      HH.div
        [ class_ "w-full" ]
        [ renderSelections st.selected
-  
-        , HH.slot unit Select.component input (HE.input HandleInputContainer)
+  
+        , Select.select unit input (HE.input HandleInputContainer)
        ]
      where
        input =
@@ -72,7 +74,7 @@ component =
    eval
      :: Query
-  
-      ~> H.ParentDSL State Query (ChildQuery (Effects e)) ChildSlot Message m
+  
+      ~> H.HalogenM State Query (ChildSlots (Effects e) m) Message m
    eval = case _ of
      Log str a -> a <$ do
        H.liftAff $ log str
@@ -84,8 +86,8 @@ component =
          st <- H.get
          let newItems = difference (filterItems search st.items) st.selected
              index = elemIndex search st.items
-  
-          _ <- H.query unit $ H.action $ Select.ReplaceItems newItems
-  
-          traverse_ (H.query unit <<< H.action <<< Select.Highlight <<< Select.Index) index
+  
+          _ <- H.query _select unit $ H.action $ Select.ReplaceItems newItems
+  
+          traverse_ (H.query _select unit <<< H.action <<< Select.Highlight <<< Select.Index) index
          H.liftAff $ log $ "New search: " <> search
        Select.Selected item -> do
@@ -94,7 +96,7 @@ component =
          _ <- if st.keepOpen
            then pure unit
            else do
-  
-              _ <- H.query unit $ H.action $ Select.SetVisibility Select.Off
+  
+              _ <- H.query _select unit $ H.action $ Select.SetVisibility Select.Off
              pure unit
          if length (filter ((==) item) st.items) > 0
@@ -105,7 +107,7 @@ component =
          newSt <- H.get
          let newItems = difference newSt.items newSt.selected
-  
-          _ <- H.query unit $ H.action $ Select.ReplaceItems newItems
+  
+          _ <- H.query _select unit $ H.action $ Select.ReplaceItems newItems
          H.liftAff $ log $ "New item selected: " <> item
        otherwise -> pure unit
@@ -115,7 +117,7 @@ component =
        H.modify _ { selected = filter ((/=) item) st.selected }
        newSt <- H.get
        let newItems = difference newSt.items newSt.selected
-  
-        _ <- H.query unit $ H.action $ Select.ReplaceItems newItems
+  
+        _ <- H.query _select unit $ H.action $ Select.ReplaceItems newItems
        pure a
@@ -128,9 +130,9 @@ class_ = HP.class_ <<< HH.ClassName
 filterItems :: TypeaheadItem -> Array TypeaheadItem -> Array TypeaheadItem
 filterItems str = filter (\i -> contains (Pattern str) i)
-  
-renderInputContainer :: ∀ e
+  
+renderInputContainer :: ∀ e m
  . Select.State TypeaheadItem e
-  
- -> Select.ComponentHTML Query TypeaheadItem e
+  
+ -> Select.ComponentHTML Query TypeaheadItem e m
 renderInputContainer state = HH.div_ [ renderInput, renderContainer ]
  where
    renderInput = HH.input $ Setters.setInputProps
diff --git a/docs/src/Main.purs b/docs/src/Main.purs
@@ -55,7 +55,7 @@ data Query a = NoOp a
 app :: ∀ eff m. MonadAff ( Component.Effects eff ) m => H.Component HH.HTML Query String Void m
 app =
-  
-  H.parentComponent
+  
+  H.component
    { initialState: id
    , render
    , eval
@@ -68,7 +68,7 @@ app =
        Nothing -> HH.div_ []
        Just component -> HH.slot unit component unit absurd
-  
-    eval :: Query ~> H.ParentDSL String Query ComponentQuery Unit Void m
+  
+    eval :: Query ~> H.HalogenM String Query ComponentQuery Unit Void m
    eval (NoOp a) = pure a