Merge pull request #45 from JordanMartinez/exposeInput

Expose `input` type in Select components and combine `spec` and `input` into `Select.component`

Author: davezuch

examples/Components/Dropdown.purs

@@ -2,7 +2,6 @@ module Components.Dropdown where
 
 import Prelude
 
-import Data.Const (Const)
 import Effect.Aff (Aff)
 import Data.Array ((!!), mapWithIndex, length)
 import Data.Maybe (Maybe(..), fromMaybe)
@@ -18,7 +17,7 @@ type Slot =
 
 type State =
   ( items :: Array String
-  , selection :: Maybe String 
+  , selection :: Maybe String
   , buttonLabel :: String
   )
 
@@ -32,30 +31,35 @@ type Input =
   , buttonLabel :: String
   }
 
-input :: Input -> S.Input State 
-input { items, buttonLabel } =
-  { inputType: S.Toggle
-  , search: Nothing
-  , debounceTime: Nothing
-  , getItemCount: length <<< _.items
-  , items
-  , buttonLabel
-  , selection: Nothing
+component :: H.Component HH.HTML S.Query' Input Message Aff
+component = S.component input $ S.defaultSpec
+  { render = render
+  , handleEvent = handleEvent
   }
-
-spec :: S.Spec State (Const Void) Void () Message Aff
-spec = S.defaultSpec { render = render, handleMessage = handleMessage }
   where
-  handleMessage = case _ of
+  input :: Input -> S.Input State
+  input { items, buttonLabel } =
+    { inputType: S.Toggle
+    , search: Nothing
+    , debounceTime: Nothing
+    , getItemCount: length <<< _.items
+    , items
+    , buttonLabel
+    , selection: Nothing
+    }
+
+  handleEvent :: S.Event -> H.HalogenM (S.State State) S.Action' () Message Aff Unit
+  handleEvent = case _ of
     S.Selected ix -> do
       st <- H.get
       let selection = st.items !! ix
       H.modify_ _ { selection = selection, visibility = S.Off }
       H.raise $ SelectionChanged st.selection selection
     _ -> pure unit
 
-  render st = 
-    HH.div 
+  render :: S.State State -> H.ComponentHTML S.Action' () Aff
+  render st =
+    HH.div
       [ class_ "Dropdown" ]
       [ renderToggle, renderContainer ]
     where
@@ -70,13 +74,12 @@ spec = S.defaultSpec { render = render, handleMessage = handleMessage }
         ( renderItem `mapWithIndex` st.items )
       where
       renderItem index item =
-        HH.div 
-          ( SS.setItemProps index 
-              [ classes_ 
+        HH.div
+          ( SS.setItemProps index
+              [ classes_
                   [ "Dropdown__item"
                   , "Dropdown__item--highlighted" # guard (st.highlightedIndex == Just index)
                   ]
               ]
-          ) 
+          )
           [ HH.text item ]
-

examples/Components/Typeahead.purs

@@ -24,11 +24,11 @@ import Internal.RemoteData as RD
 import Select as S
 import Select.Setters as SS
 
-type Slot = 
+type Slot =
   S.Slot Query ChildSlots Message
 
 type State =
-  ( selections :: Array Location 
+  ( selections :: Array Location
   , available :: RD.RemoteData String (Array Location)
   )
 
@@ -39,51 +39,51 @@ data Action
 data Query a
   = GetSelections (Array Location -> a)
 
-data Message 
-  = ItemRemoved Location 
+data Message
+  = ItemRemoved Location
   | SelectionsChanged (Array Location)
 
-type ChildSlots = 
+type ChildSlots =
   ( dropdown :: D.Slot Unit )
 
--- this typeahead will be opaque; users can just use this pre-built
--- input instead of the usual select one.
-input :: S.Input State
-input = 
-  { inputType: S.Text
-  , debounceTime: Just (Milliseconds 300.0)
-  , search: Nothing
-  , getItemCount: maybe 0 length <<< RD.toMaybe <<< _.available
-  , selections: []
-  , available: RD.NotAsked
-  }
-
-spec :: S.Spec State Query Action ChildSlots Message Aff
-spec = S.defaultSpec 
+component :: H.Component HH.HTML (S.Query Query ChildSlots) Unit Message Aff
+component = S.component (const input) $ S.defaultSpec
   { render = render
   , handleAction = handleAction
   , handleQuery = handleQuery
-  , handleMessage = handleMessage
+  , handleEvent = handleEvent
   }
   where
-  handleMessage 
-    :: S.Message 
+  -- this typeahead will be opaque; users can just use this pre-built
+  -- input instead of the usual select one.
+  input :: S.Input State
+  input =
+    { inputType: S.Text
+    , debounceTime: Just (Milliseconds 300.0)
+    , search: Nothing
+    , getItemCount: maybe 0 length <<< RD.toMaybe <<< _.available
+    , selections: []
+    , available: RD.NotAsked
+    }
+
+  handleEvent
+    :: S.Event
     -> H.HalogenM (S.State State) (S.Action Action) ChildSlots Message Aff Unit
-  handleMessage = case _ of
+  handleEvent = case _ of
     S.Selected ix -> do
       st <- H.get
       for_ st.available \arr ->
         for_ (arr !! ix) \item -> do
           let newSelections = item : st.selections
-          H.modify_ _ 
+          H.modify_ _
             { selections = item : st.selections
             , available = RD.Success (filter (_ /= item) arr)
             , search = ""
             }
           H.raise $ SelectionsChanged newSelections
     S.Searched str -> do
       st <- H.get
-      -- we'll use an external api to search locations 
+      -- we'll use an external api to search locations
       H.modify_ _ { available = RD.Loading }
       items <- H.liftAff $ searchLocations str
       H.modify_ _ { available = items <#> \xs -> difference xs st.selections }
@@ -92,13 +92,13 @@ spec = S.defaultSpec
   -- You can remove all type signatures except for this one; we need to tell the
   -- compiler about the `a` type variable. The minimal necessary signature is below.
   handleQuery :: forall a. Query a -> H.HalogenM _ _ _ _ _ (Maybe a)
-  handleQuery = case _ of  
+  handleQuery = case _ of
     GetSelections reply -> do
        st <- H.get
        pure $ Just $ reply st.selections
 
-  handleAction 
-    :: Action 
+  handleAction
+    :: Action
     -> H.HalogenM (S.State State) (S.Action Action) ChildSlots Message Aff Unit
   handleAction = case _ of
     Remove item -> do
@@ -109,23 +109,23 @@ spec = S.defaultSpec
     HandleDropdown msg -> case msg of
       D.SelectionChanged oldSelection newSelection -> do
         st <- H.get
-        let 
+        let
           mkLocation str = { name: "User Added: " <> str, population: "1" }
           newSelections = case oldSelection, newSelection of
-            Nothing, Nothing -> 
+            Nothing, Nothing ->
               Nothing
-            Nothing, Just str -> 
+            Nothing, Just str ->
               Just (mkLocation str : st.selections)
-            Just str, Nothing -> 
+            Just str, Nothing ->
               Just (filter (_ /= mkLocation str) st.selections)
-            Just old, Just new -> 
+            Just old, Just new ->
               Just (mkLocation new : (filter (_ /= mkLocation old) st.selections))
-        for_ newSelections \selections -> 
+        for_ newSelections \selections ->
           H.modify_ _ { selections = selections }
 
   render :: S.State State -> H.ComponentHTML (S.Action Action) ChildSlots Aff
-  render st = 
-    HH.div 
+  render st =
+    HH.div
       [ class_ "Typeahead" ]
       [ renderSelections, renderInput, renderDropdown, renderContainer ]
     where
@@ -139,40 +139,40 @@ spec = S.defaultSpec
       renderSelectedItem item =
         HH.div
           [ class_ "Typeahead__item--selected Location" ]
-          [ HH.span 
+          [ HH.span
               [ class_ "Location__name" ]
               [ HH.text item.name ]
           , closeButton item
           ]
 
       closeButton item =
         HH.span
-          [ class_ "Location__closeButton" 
+          [ class_ "Location__closeButton"
           , HE.onClick \_ -> Just $ S.Action $ Remove item
           ]
           [ HH.text "×" ]
 
     renderInput = HH.input $ SS.setInputProps
-      [ classes_ 
+      [ classes_
           [ "Typeahead__input"
           , "Typeahead__input--selections" # guard hasSelections
           , "Typeahead__input--active" # guard (st.visibility == S.On)
           ]
-      , HP.placeholder "Type to search..." 
+      , HP.placeholder "Type to search..."
       ]
 
     renderDropdown = whenElem (st.visibility == S.On) \_ ->
-      HH.slot _dropdown unit (S.component D.spec) (D.input dropdownInput) handler
+      HH.slot _dropdown unit D.component dropdownInput handler
       where
       _dropdown = SProxy :: SProxy "dropdown"
       handler msg = Just $ S.Action $ HandleDropdown msg
       dropdownInput = { items: [ "Earth", "Mars" ], buttonLabel: "Human Planets" }
 
     renderContainer = whenElem (st.visibility == S.On) \_ ->
-      HH.div 
-        (SS.setContainerProps 
-          [ classes_ 
-              [ "Typeahead__container" 
+      HH.div
+        (SS.setContainerProps
+          [ classes_
+              [ "Typeahead__container"
               , "Typeahead__container--hasItems" # guard hasItems
               ]
           ]
@@ -186,14 +186,14 @@ spec = S.defaultSpec
           RD.NotAsked -> renderMsg "No search performed..."
           RD.Loading -> renderMsg "Loading..."
           RD.Failure e -> renderMsg e
-          RD.Success available 
+          RD.Success available
             | hasItems -> renderItem `mapWithIndex` available
             | otherwise -> renderMsg "No results found"
 
       renderItem index { name, population } =
-        HH.div 
-          (SS.setItemProps index [ classes_ [ base, highlight, "Location" ] ]) 
-          [ HH.span 
+        HH.div
+          (SS.setItemProps index [ classes_ [ base, highlight, "Location" ] ])
+          [ HH.span
               [ class_ "Location__name" ]
               [ HH.text name ]
           , HH.span
@@ -214,7 +214,6 @@ type Location =
 
 searchLocations :: String -> Aff (RD.RemoteData String (Array Location))
 searchLocations search = do
-  res <- AX.get AR.json ("https://swapi.co/api/planets/?search=" <> search) 
+  res <- AX.get AR.json ("https://swapi.co/api/planets/?search=" <> search)
   let body = lmap AR.printResponseFormatError res.body
   pure $ RD.fromEither $ traverse decodeJson =<< (_ .: "results") =<< decodeJson =<< body
-

examples/Internal/CSS.purs

@@ -13,4 +13,3 @@ classes_ = HP.classes <<< map HH.ClassName
 
 whenElem :: forall p i. Boolean -> (Unit -> HH.HTML i p) -> HH.HTML i p
 whenElem cond render = if cond then render unit else HH.text ""
-

examples/Internal/RemoteData.purs

@@ -1,4 +1,4 @@
--- | Copied over from 
+-- | Copied over from
 -- | https://github.com/krisajenkins/purescript-remotedata
 -- |
 -- | due to dependency conflicts
@@ -42,4 +42,3 @@ fromMaybe (Just value) = Success value
 fromEither :: forall e a. Either e a -> RemoteData e a
 fromEither (Left err) = Failure err
 fromEither (Right value) = Success value
-

examples/Main.purs

@@ -19,7 +19,6 @@ import Halogen.Aff as HA
 import Halogen.HTML as HH
 import Halogen.VDom.Driver (runUI)
 import Internal.Proxy (ProxyS, proxy)
-import Select as Select
 import Web.DOM.Element (getAttribute)
 import Web.DOM.NodeList (toArray)
 import Web.DOM.ParentNode (QuerySelector(..), querySelectorAll)
@@ -48,7 +47,7 @@ type Components
 routes :: Components
 routes = M.fromFoldable
   [ Tuple "typeahead" $ proxy typeahead
-  , Tuple "dropdown" $ proxy dropdown 
+  , Tuple "dropdown" $ proxy dropdown
   ]
 
 app :: H.Component HH.HTML (Const Void) String Void Aff
@@ -74,9 +73,9 @@ selectElements
   :: { query :: QuerySelector, attr :: String }
   -> Aff (Array { element :: HTMLElement, attr :: String })
 selectElements { query, attr } = do
-  nodeArray <- liftEffect do 
+  nodeArray <- liftEffect do
     toArray =<< querySelectorAll query <<< toParentNode =<< document =<< window
-  let 
+  let
     elems = fromMaybe [] <<< sequence $ fromNode <$> nodeArray
   attrs <- liftEffect $ traverse (getAttribute attr <<< toElement) elems
   pure $ zipWith ({ element: _, attr: _ }) elems (fromMaybe "" <$> attrs)
@@ -88,7 +87,7 @@ dropdown :: forall t0 t1 t2. H.Component HH.HTML t0 t1 t2 Aff
 dropdown = H.mkComponent
   { initialState: const unit
   , render: \_ ->
-      HH.slot label unit (Select.component Dropdown.spec) (Dropdown.input input) \_ -> Nothing
+      HH.slot label unit Dropdown.component input \_ -> Nothing
   , eval: H.mkEval H.defaultEval
   }
   where
@@ -99,9 +98,8 @@ typeahead :: forall t0 t1 t2. H.Component HH.HTML t0 t1 t2 Aff
 typeahead = H.mkComponent
   { initialState: const unit
   , render: \_ ->
-      HH.slot label unit (Select.component Typeahead.spec) Typeahead.input \_ -> Nothing
+      HH.slot label unit Typeahead.component unit \_ -> Nothing
   , eval: H.mkEval H.defaultEval
   }
   where
   label = SProxy :: SProxy "typeahead"
-