Update for Halogen 5 (#39)

* Remove QueryF from Select in preparation for v5 changes, as there is no longer the ability to leverage a query within ComponentHTML. Add the npm-check-updates package to dev dependencies.

* switch to variants

* Complete switch to Halogen 5

* switch examples to v5

* switch to extensible state, no comonad

* now that state can be embedded, take as an argument

* cleanup

* switch to handling messages, which addresses lingering concerns with extensibility in the components

* uncomment

* cleanup

* add default.nix file containing mkdocs

* update dependencies

* fix infinite recursion (compiler bug?)

* eta-expand instead of removing helper

* remove unused css

* Add type synonyms for simple cases

* rename RunQuery to AsAction

* allow external initialization, merge state fields

* simplify examples

* Simplify a little more

* formatting

* add finalizer to default spec

* extensible actions

* update item counts on attempted highlight

* cleanup

* polish up CSS for examples to test behavior

* switch to void

.circleci/config.yml

@@ -48,21 +48,6 @@ jobs:
           paths:
             - js
 
-  css:
-    <<: *defaults
-    steps:
-      - checkout
-
-      - run:
-          name: Fetch and persist CSS
-          command: |
-            yarn fetch-css && yarn move-css
-
-      - persist_to_workspace:
-          root: docs
-          paths:
-            - css
-
   site:
     working_directory: ~/select
     docker:
@@ -139,16 +124,6 @@ workflows:
               ignore: gh-pages
 
       # On master branch, rebuild docs
-      - css:
-          filters:
-            branches:
-              only:
-                - master
-                - docs
-
-          requires:
-            - test
-
       - site:
           filters:
             branches:
@@ -168,4 +143,4 @@ workflows:
 
           requires:
             - site
-            - css
+

bower.json

@@ -31,10 +31,12 @@
     "generated-docs"
   ],
   "dependencies": {
-    "purescript-halogen": "^4.0.0",
+    "purescript-halogen": "^5.0.0-rc.3",
-    "purescript-halogen-renderless": "^0.0.3"
+    "purescript-record": "^2.0.0"
   },
   "devDependencies": {
-    "purescript-debug": "^4.0.0"
+    "purescript-debug": "^4.0.0",
+    "purescript-affjax": "^9.0.0",
+    "purescript-argonaut": "^6.0.0"
   }
 }

default.nix

@@ -0,0 +1,97 @@
+{ nixpkgs ? import <nixpkgs> {} }:
+with nixpkgs;
+
+let
+  livereload = python27Packages.buildPythonPackage {
+    name = "livereload-2.5.1";
+    src = fetchurl {
+      url = https://pypi.python.org/packages/e9/2e/c4972828cf526a2e5f5571d647fb2740df68f17e8084a9a1092f4d209f4c/livereload-2.5.1.tar.gz;
+      sha256 = "0b2yyfnpddmrwjfqsndidzchkf3l9jlgzfkwl8dplim9gq6y2ba2";
+    };
+
+    propagatedBuildInputs = with python27Packages; [ six tornado ];
+
+    meta = {
+      homepage = https://github.com/lepture/python-livereload;
+      description = "Python LiveReload is an awesome tool for web developers";
+      license = stdenv.lib.licenses.bsd3;
+    };
+  };
+
+  mkdocs = python27Packages.buildPythonApplication rec {
+    name="mkdocs-0.17.2";
+    src = fetchurl {
+      url = https://pypi.python.org/packages/27/0a/bb42cda3b298ffb4b30375b7538a4d57803ff8be418ee3e00460188c4332/mkdocs-0.17.2.tar.gz;
+      sha256 = "18d3m9iws5shlbg0yj5xwiy68bliiz70v32y5pa8wi274c36nssa";
+    };
+
+    propagatedBuildInputs = with python27Packages;
+    [ tornado livereload click pyyaml markdown jinja2 ];
+
+    meta = {
+      homepage = http://www.mkdocs.org/;
+      description = "MkDocs is a fast, simple and downright gorgeous static site generator that’s geared towards building project documentation. Documentation source files are written in Markdown, and configured with a single YAML configuration file.";
+      license = stdenv.lib.licenses.bsd3;
+    };
+  };
+
+  pymdown-extensions = python27Packages.buildPythonPackage {
+    name = "pymdown-extensions-4.8";
+    src = fetchurl {
+      url = https://pypi.python.org/packages/f5/9f/74d8a85458e831f3b161956b30bc60d31c6a507ed72ac4f4cb2ca08d8042/pymdown-extensions-4.8.tar.gz;
+      sha256 = "1zvi8d44v758vbhi9fl5x5gqs098ajamilfz53jzid0v0fad88nj";
+    };
+
+    propagatedBuildInputs = with python27Packages; [ markdown ];
+    doCheck = false;
+
+    meta = {
+      homepage = https://github.com/facelessuser/pymdown-extensions;
+      description = "Extension pack for Python Markdown.";
+      license = stdenv.lib.licenses.mit;
+    };
+  };
+
+  mkdocs-material = python27Packages.buildPythonPackage {
+    name = "mkdocs-material-2.6.0";
+    src = fetchurl {
+      url = https://pypi.python.org/packages/e3/85/f42493d453d9b6f51912b818134a4a555c597807ba96b40eae12017ede35/mkdocs-material-2.6.0.tar.gz;
+      sha256 = "1xq5nkj0g6gg4lm8nhcwc30g9drq1i4p4pky8s5c0rfa1s9s7sla";
+    };
+
+    propagatedBuildInputs = with python27Packages; [ pymdown-extensions pygments mkdocs ];
+
+    meta = {
+      homepage = https://squidfunk.github.io/mkdocs-material/;
+      description = "A Material Design theme for MkDocs";
+      license = stdenv.lib.licenses.mit;
+    };
+  };
+
+  markdown-fenced-code-tabs = python27Packages.buildPythonPackage {
+    name = "markdown-fenced-code-tabs-0.2.0";
+    src = fetchurl {
+      url = https://pypi.python.org/packages/21/7a/0cee39060c5173cbd80930b720fb18f5cb788477c03214ccdef44ec91d85/markdown-fenced-code-tabs-0.2.0.tar.gz;
+      sha256 = "05k5v9wlxgghw2k18savznxc1xgg60gqz60mka4gnp8nsxpz99zs";
+    };
+
+    propagatedBuildInputs = with python27Packages; [ markdown ];
+
+    meta = {
+      homepage = https://github.com/yacir/markdown-fenced-code-tabs;
+      description = "Generates Bootstrap HTML Tabs for Consecutive Fenced Code Blocks";
+      license = stdenv.lib.licenses.mit;
+    };
+  };
+
+in
+  nixpkgs.stdenv.mkDerivation {
+    name = "env";
+    buildInputs = [ 
+      mkdocs 
+      mkdocs-material 
+      nixpkgs.nodejs
+      nixpkgs.yarn
+      nixpkgs.stack
+    ];
+  }

docs/examples.md

@@ -11,9 +11,9 @@ You can play around with a few example components here. However, for a much rich
 
 Dropdowns are a common button-driven input type, especially for navigation. But most custom dropdowns sacrifice usability: unlike browser default dropdowns, you can't type on most custom dropdowns, nor are many built with accessibility in mind. With `Select` you can easily create rich, usable dropdowns with little code.
 
-<div data-component="dropdown" class="ocelot-scoped"></div>
+<div data-component="dropdown"></div>
 
-Curious how to build a dropdown with `Select`? Check out [the dropdown tutorial](https://citizennet.github.io/tutorials/build-a-dropdown).
+Curious how to build a dropdown with `Select`? Check out [the dropdown tutorial](https://citizennet.github.io/tutorials/dropdown).
 
 ### Typeahead / Autocomplete
 
@@ -23,6 +23,6 @@ Building typeaheads with `Select` is only a little more complex than building dr
 
 The typeahead below is quite simple; to see examples of more sophisticated typeaheads -- including ones that fetch and display data asynchronously -- check out the [Ocelot component library](https://citizennet.github.io/purescript-ocelot/#typeaheads).
 
-<div data-component="typeahead" class="ocelot-scoped"></div>
+<div data-component="typeahead"></div>
 
-Curious how to build a typeahead with `Select`? Check out [the typeahead tutorial](https://citizennet.github.io/tutorials/build-a-typehead).
+Curious how to build a typeahead with `Select`? Check out [the typeahead tutorial](https://citizennet.github.io/tutorials/typeahead).

examples/Components/CSS.purs

@@ -1,88 +0,0 @@
-module Docs.CSS where
-
-import Prelude
-import Halogen.HTML as HH
-
-baseContainer :: Array HH.ClassName
-baseContainer = HH.ClassName <$>
-  [ "bg-white"
-  , "border-grey-80"
-  , "border-l-2"
-  , "border-r-2"
-  , "w-full"
-  ]
-
-selectionContainer :: Array HH.ClassName
-selectionContainer = baseContainer <>
-  ( HH.ClassName <$>
-    [ "border-t-2"
-    ]
-  )
-
-itemContainer :: Array HH.ClassName
-itemContainer = baseContainer <>
-  ( HH.ClassName <$>
-    [ "absolute"
-    , "shadow"
-    , "max-h-80"
-    , "overflow-y-scroll"
-    , "pin-t"
-    , "pin-l"
-    , "z-50"
-    , "border-b-2"
-    ]
-  )
-
-menu :: Array HH.ClassName
-menu = HH.ClassName <$> [ "relative z-50" ]
-
-ul :: Array HH.ClassName
-ul = HH.ClassName <$> [ "list-reset" ]
-
-li :: Array HH.ClassName
-li = HH.ClassName <$>
-  [ "px-3"
-  , "rounded-sm"
-  , "text-black-20"
-  , "group"
-  , "hover:bg-grey-97"
-  , "cursor-pointer"
-]
-
-button :: Array HH.ClassName
-button = HH.ClassName <$>
-  [ "no-outline"
-  , "px-4"
-  , "py-2"
-  , "!active:border-b"
-  , "active:border-t"
-  , "disabled:opacity-50"
-  , "disabled:cursor-default"
-  , "bg-blue-88"
-  , "border-blue-88"
-  , "hover:!disabled:bg-blue-82"
-  , "focus:bg-blue-82"
-  , "text-white"
-  , "rounded"
-  ]
-
-input :: Array HH.ClassName
-input = HH.ClassName <$>
-  [ "bg-white"
-  , "border-t-2"
-  , "border-b-2"
-  , "font-light"
-  , "cc-blue-88"
-  , "border-grey-80"
-  , "disabled:bg-grey-95"
-  , "disabled:text-grey-70"
-  , "focus:no-outline"
-  , "py-2"
-  , "transition-1/4-bounce"
-  , "border-l-2"
-  , "border-r-2"
-  , "w-full"
-  , "px-3"
-  , "focus:border-blue-88"
-  , "!focus:!disabled:hover:border-grey-70"
-  ]

examples/Components/Dropdown.purs

@@ -0,0 +1,82 @@
+module Components.Dropdown where
+
+import Prelude
+
+import Data.Const (Const)
+import Effect.Aff (Aff)
+import Data.Array ((!!), mapWithIndex, length)
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Monoid (guard)
+import Halogen as H
+import Halogen.HTML as HH
+import Internal.CSS (class_, classes_, whenElem)
+import Select as S
+import Select.Setters as SS
+
+type Slot =
+  H.Slot S.Query' Message
+
+type State =
+  ( items :: Array String
+  , selection :: Maybe String 
+  , buttonLabel :: String
+  )
+
+data Message
+  = SelectionChanged (Maybe String) (Maybe String)
+
+-- it is unnecessary to export your own input type, but doing so helps if you
+-- would like to set some sensible defaults behind the scenes.
+type Input =
+  { items :: Array String
+  , buttonLabel :: String
+  }
+
+input :: Input -> S.Input State 
+input { items, buttonLabel } =
+  { inputType: S.Toggle
+  , search: Nothing
+  , debounceTime: Nothing
+  , getItemCount: length <<< _.items
+  , items
+  , buttonLabel
+  , selection: Nothing
+  }
+
+spec :: S.Spec State (Const Void) Void () Message Aff
+spec = S.defaultSpec { render = render, handleMessage = handleMessage }
+  where
+  handleMessage = 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 
+      [ class_ "Dropdown" ]
+      [ renderToggle, renderContainer ]
+    where
+    renderToggle =
+      HH.button
+        ( SS.setToggleProps st [ class_ "Dropdown__toggle" ] )
+        [ HH.text (fromMaybe st.buttonLabel st.selection) ]
+
+    renderContainer = whenElem (st.visibility == S.On) \_ ->
+      HH.div
+        ( SS.setContainerProps [ class_ "Dropdown__container" ] )
+        ( renderItem `mapWithIndex` st.items )
+      where
+      renderItem index item =
+        HH.div 
+          ( SS.setItemProps index 
+              [ classes_ 
+                  [ "Dropdown__item"
+                  , "Dropdown__item--highlighted" # guard (st.highlightedIndex == Just index)
+                  ]
+              ]
+          ) 
+          [ HH.text item ]
+

examples/Components/Dropdown/Dropdown.purs

@@ -1,101 +0,0 @@
-module Docs.Components.Dropdown where
-
-import Prelude
-
-import Effect.Aff.Class (class MonadAff)
-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 as Select
-import Select.Setters as Setters
-import Docs.CSS as CSS
-
-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 = Select.Query Query String
-
-component :: ∀ m. MonadAff m => H.Component HH.HTML Query Input Message m
-component =
-  H.parentComponent
-    { initialState
-    , render
-    , eval
-    , receiver: const Nothing
-    }
-  where
-    initialState :: Input -> State
-    initialState i = { items: i.items, text: "Select an option" }
-
-    eval :: Query ~> H.ParentDSL State Query ChildQuery ChildSlot Message m
-    eval = case _ of
-      HandleSelect (Select.Selected item) a -> do
-        st <- H.get
-        _ <- H.query unit $ Select.setVisibility Select.Off
-        _ <- H.query unit $ Select.replaceItems $ difference st.items [ item ]
-        H.modify_ _ { text = item }
-        pure a
-
-      HandleSelect other a -> pure a
-
-    render :: State -> H.ParentHTML Query ChildQuery ChildSlot m
-    render st =
-      HH.div
-        [ HP.class_ $ HH.ClassName "w-full" ]
-        [ HH.slot unit Select.component input (HE.input HandleSelect) ]
-      where
-        input =
-          { initialSearch: Nothing
-          , debounceTime: Nothing
-          , inputType: Select.Toggle
-          , items: difference st.items [ st.text ]
-          , render: renderDropdown
-          }
-
-        renderDropdown :: Select.State String -> Select.ComponentHTML Query String
-        renderDropdown state = HH.div_ [ renderToggle, renderMenu ]
-          where
-            renderToggle =
-              HH.button
-                ( Setters.setToggleProps [ HP.classes CSS.button ] )
-                [ HH.text st.text ]
-
-            renderMenu =
-              HH.div [ HP.classes CSS.menu ]
-              $ if state.visibility == Select.Off
-                then []
-                else [ renderContainer $ renderItem `mapWithIndex` state.items ]
-              where
-                renderContainer html =
-                  HH.div
-                    ( Setters.setContainerProps [ HP.classes CSS.itemContainer ] )
-                    [ HH.ul [ HP.classes CSS.ul ] html ]
-
-                renderItem index item =
-                  HH.li
-                    ( Setters.setItemProps index props )
-                    [ HH.text item ]
-                  where
-                    props =
-                      [ HP.classes
-                        ( CSS.li <>
-                          if state.highlightedIndex == Just index
-                            then [ HH.ClassName "bg-grey-lighter" ]
-                            else []
-                        )
-                      ]
-

examples/Components/Typeahead.purs

@@ -0,0 +1,220 @@
+module Components.Typeahead where
+
+import Prelude
+
+import Affjax as AX
+import Affjax.ResponseFormat as AR
+import Components.Dropdown as D
+import Data.Argonaut.Decode ((.:), decodeJson)
+import Data.Array (mapWithIndex, filter, (:), (!!), length, null, difference)
+import Data.Foldable (for_)
+import Data.Bifunctor (lmap)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Monoid (guard)
+import Data.Symbol (SProxy(..))
+import Data.Time.Duration (Milliseconds(..))
+import Data.Traversable (traverse)
+import Effect.Aff (Aff)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
+import Internal.CSS (class_, classes_, whenElem)
+import Internal.RemoteData as RD
+import Select as S
+import Select.Setters as SS
+
+type Slot = 
+  S.Slot Query ChildSlots Message
+
+type State =
+  ( selections :: Array Location 
+  , available :: RD.RemoteData String (Array Location)
+  )
+
+data Action
+  = Remove Location
+  | HandleDropdown D.Message
+
+data Query a
+  = GetSelections (Array Location -> a)
+
+data Message 
+  = ItemRemoved Location 
+  | SelectionsChanged (Array Location)
+
+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 
+  { render = render
+  , handleAction = handleAction
+  , handleQuery = handleQuery
+  , handleMessage = handleMessage
+  }
+  where
+  handleMessage 
+    :: S.Message 
+    -> H.HalogenM (S.State State) (S.Action Action) ChildSlots Message Aff Unit
+  handleMessage = 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_ _ 
+            { 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 
+      H.modify_ _ { available = RD.Loading }
+      items <- H.liftAff $ searchLocations str
+      H.modify_ _ { available = items <#> \xs -> difference xs st.selections }
+    _ -> pure unit
+
+  -- 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  
+    GetSelections reply -> do
+       st <- H.get
+       pure $ Just $ reply st.selections
+
+  handleAction 
+    :: Action 
+    -> H.HalogenM (S.State State) (S.Action Action) ChildSlots Message Aff Unit
+  handleAction = case _ of
+    Remove item -> do
+      st <- H.get
+      let newSelections = filter (_ /= item) st.selections
+      H.modify_ _ { selections = newSelections }
+      H.raise $ ItemRemoved item
+    HandleDropdown msg -> case msg of
+      D.SelectionChanged oldSelection newSelection -> do
+        st <- H.get
+        let 
+          mkLocation str = { name: "User Added: " <> str, population: "1" }
+          newSelections = case oldSelection, newSelection of
+            Nothing, Nothing -> 
+              Nothing
+            Nothing, Just str -> 
+              Just (mkLocation str : st.selections)
+            Just str, Nothing -> 
+              Just (filter (_ /= mkLocation str) st.selections)
+            Just old, Just new -> 
+              Just (mkLocation new : (filter (_ /= mkLocation old) st.selections))
+        for_ newSelections \selections -> 
+          H.modify_ _ { selections = selections }
+
+  render :: S.State State -> H.ComponentHTML (S.Action Action) ChildSlots Aff
+  render st = 
+    HH.div 
+      [ class_ "Typeahead" ]
+      [ renderSelections, renderInput, renderDropdown, renderContainer ]
+    where
+    hasSelections = length st.selections > 0
+
+    renderSelections = whenElem hasSelections \_ ->
+      HH.div
+        [ class_ "Typeahead__selections" ]
+        (renderSelectedItem <$> st.selections)
+      where
+      renderSelectedItem item =
+        HH.div
+          [ class_ "Typeahead__item--selected Location" ]
+          [ HH.span 
+              [ class_ "Location__name" ]
+              [ HH.text item.name ]
+          , closeButton item
+          ]
+
+      closeButton item =
+        HH.span
+          [ class_ "Location__closeButton" 
+          , HE.onClick \_ -> Just $ S.Action $ Remove item
+          ]
+          [ HH.text "×" ]
+
+    renderInput = HH.input $ SS.setInputProps
+      [ classes_ 
+          [ "Typeahead__input"
+          , "Typeahead__input--selections" # guard hasSelections
+          , "Typeahead__input--active" # guard (st.visibility == S.On)
+          ]
+      , HP.placeholder "Type to search..." 
+      ]
+
+    renderDropdown = whenElem (st.visibility == S.On) \_ ->
+      HH.slot _dropdown unit (S.component D.spec) (D.input 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" 
+              , "Typeahead__container--hasItems" # guard hasItems
+              ]
+          ]
+        )
+        renderItems
+      where
+      hasItems = maybe false (not <<< null) (RD.toMaybe st.available)
+      renderItems = do
+        let renderMsg msg = [ HH.span_ [ HH.text msg ] ]
+        case st.available of
+          RD.NotAsked -> renderMsg "No search performed..."
+          RD.Loading -> renderMsg "Loading..."
+          RD.Failure e -> renderMsg e
+          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 
+              [ class_ "Location__name" ]
+              [ HH.text name ]
+          , HH.span
+              [ class_ "Location__population" ]
+              [ HH.text population ]
+          ]
+        where
+        base = "Typeahead__item"
+        highlight = "Typeahead__item--highlighted" # guard (st.highlightedIndex == Just index)
+
+
+-- Let's make this typeahead async.
+
+type Location =
+  { name :: String
+  , population :: String
+  }
+
+searchLocations :: String -> Aff (RD.RemoteData String (Array Location))
+searchLocations search = do
+  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/Components/Typeahead/Typeahead.purs

@@ -1,179 +0,0 @@
-module Docs.Components.Typeahead where
-
-import Prelude
-
-import Effect.Aff.Class (class MonadAff)
-import Data.Array (elemIndex, mapWithIndex, difference, filter, (:))
-import Data.Foldable (length, traverse_)
-import Data.Maybe (Maybe(..))
-import Data.String (Pattern(..), contains)
-import Halogen as H
-import Halogen.HTML as HH
-import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
-import Select as Select
-import Select.Setters as Setters
-
-import Docs.CSS as CSS
-
-type TypeaheadItem = String
-
-data Query a
-  = Log String a
-  | HandleInputContainer (Select.Message Query TypeaheadItem) a
-  | Removed TypeaheadItem a
-
-type State =
-  { items    :: Array TypeaheadItem
-  , selected :: Array TypeaheadItem
-  , keepOpen :: Boolean }
-
-type Input = { items :: Array String, keepOpen :: Boolean }
-data Message = Void
-
-type ChildSlot = Unit
-type ChildQuery = Select.Query Query TypeaheadItem
-
-component :: ∀ m. MonadAff m => H.Component HH.HTML Query Input Message m
-component =
-  H.parentComponent
-    { initialState
-    , render
-    , eval
-    , receiver: const Nothing
-    }
-  where
-    initialState :: Input -> State
-    initialState i = { items: i.items, selected: [], keepOpen: i.keepOpen }
-
-    render :: State -> H.ParentHTML Query ChildQuery ChildSlot m
-    render st =
-      HH.div
-        [ class_ "w-full" ]
-        [ renderSelections st.selected
-        , HH.slot unit Select.component input (HE.input HandleInputContainer)
-        ]
-      where
-        input =
-          { initialSearch: Nothing
-          , debounceTime: Nothing
-          , inputType: Select.TextInput
-          , items: difference st.items st.selected
-          , render: renderInputContainer
-          }
-
-    eval :: Query ~> H.ParentDSL State Query ChildQuery ChildSlot Message m
-    eval = case _ of
-      Log str a -> pure a
-
-      HandleInputContainer m a -> a <$ case m of
-        Select.Emit q -> eval q
-
-        Select.Searched search -> do
-          st <- H.get
-          let newItems = difference (filterItems search st.items) st.selected
-              index = elemIndex search st.items
-          _ <- H.query unit $ Select.replaceItems newItems
-          traverse_ (H.query unit <<< Select.highlight <<< Select.Index) index
-
-        Select.Selected item -> do
-          st <- H.get
-
-          _ <- if st.keepOpen
-            then pure unit
-            else do
-              _ <- H.query unit $ Select.setVisibility Select.Off
-              pure unit
-
-          if length (filter ((==) item) st.items) > 0
-            then H.modify_ _ { selected = ( item : st.selected ) }
-            else H.modify_ _
-                  { items = ( item : st.items )
-                  , selected = ( item : st.selected ) }
-
-          newSt <- H.get
-          let newItems = difference newSt.items newSt.selected
-          _ <- H.query unit $ Select.replaceItems newItems
-          pure unit
-
-        otherwise -> pure unit
-
-      Removed item a -> do
-        st <- H.get
-        H.modify_ _ { selected = filter ((/=) item) st.selected }
-        newSt <- H.get
-        let newItems = difference newSt.items newSt.selected
-        _ <- H.query unit $ Select.replaceItems newItems
-        pure a
-
-
-----------
--- Helpers
-
-class_ :: ∀ p i. String -> H.IProp ( "class" :: String | i ) p
-class_ = HP.class_ <<< HH.ClassName
-
-filterItems :: TypeaheadItem -> Array TypeaheadItem -> Array TypeaheadItem
-filterItems str = filter (\i -> contains (Pattern str) i)
-
-renderInputContainer :: Select.State TypeaheadItem -> Select.ComponentHTML Query TypeaheadItem
-renderInputContainer state = HH.div_ [ renderInput, renderContainer ]
-  where
-    renderInput = HH.input $ Setters.setInputProps
-      [ HP.classes CSS.input
-      , HP.placeholder "Type to search..." ]
-
-    renderContainer =
-      HH.div [ class_ "relative z-50" ]
-      $ if state.visibility == Select.Off
-        then []
-        else [ renderItems $ renderItem `mapWithIndex` state.items ]
-      where
-        renderChild =
-          HH.div
-          [ HE.onClick $ Select.always $ Select.raise $ H.action $ Log "I was clicked" ]
-          [ HH.text "CLICK ME I'M FROM THE PARENT" ]
-
-        renderItems html =
-          HH.div
-          ( Setters.setContainerProps
-            [ class_ "absolute bg-white shadow rounded-sm pin-t pin-l w-full" ]
-          )
-          [ renderChild, HH.ul [ class_ "list-reset" ] html ]
-
-        renderItem index item =
-          HH.li ( Setters.setItemProps index props ) [ HH.text item ]
-          where
-            props = [ class_
-              $ "px-4 py-1 text-grey-darkest"
-              <> if state.highlightedIndex == Just index
-                   then " bg-grey-lighter"
-                   else "" ]
-
-renderSelections
-  :: ∀ p
-   . Array TypeaheadItem
-  -> H.HTML p Query
-renderSelections items =
-  if length items == 0
-    then HH.div_ []
-    else
-    HH.div
-    [ class_ "bg-white rounded-sm w-full border-b border-grey-lighter" ]
-    [ HH.ul
-      [ class_ "list-reset" ]
-      ( renderSelectedItem <$> items )
-    ]
-  where
-    renderSelectedItem item =
-      HH.li
-      [ class_ "px-4 py-1 text-grey-darkest hover:bg-grey-lighter relative" ]
-      [ HH.span_ [ HH.text item ]
-      , closeButton item
-      ]
-
-    closeButton item =
-      HH.span
-      [ HE.onClick $ HE.input_ (Removed item)
-      , class_ "absolute pin-t pin-b pin-r p-1 mx-3 cursor-pointer" ]
-        [ HH.text "×" ]

examples/Internal/CSS.purs

@@ -0,0 +1,16 @@
+module Internal.CSS where
+
+import Prelude
+
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+
+class_ :: forall p i. String -> HH.IProp (class :: String | i) p
+class_ = HP.class_ <<< HH.ClassName
+
+classes_ :: forall p i. Array String -> HH.IProp (class :: String | i) p
+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/Component.purs

@@ -1,79 +0,0 @@
--- | A centralized module ready for use to mount components into documentation pages.
-
-module Docs.Internal.Component where
-
-import Prelude
-
-import Effect.Aff.Class (class MonadAff)
-import Data.Maybe (Maybe(..))
-import Halogen as H
-import Halogen.HTML as HH
-
-import Docs.Components.Typeahead as Typeahead
-import Docs.Components.Dropdown as Dropdown
-
-----------
--- Component Types
-
-type State = Unit
-type Input = Unit
-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
-
-----------
--- Built components
-
-typeahead :: ∀ m. MonadAff m => Component m
-typeahead =
-  H.parentComponent
-    { initialState: const unit
-    , render
-    , eval
-    , receiver: const Nothing
-    }
-  where
-    eval :: Query ~> DSL Typeahead.Query m
-    eval (NoOp a) = pure a
-
-    render :: Unit -> HTML Typeahead.Query m
-    render _ = HH.slot unit Typeahead.component { items: users, keepOpen: false } (const Nothing)
-
-    users :: Array String
-    users =
-      [ "Lyndsey Duffield"
-      , "Chris Pine"
-      , "Kevin Hart"
-      , "Dave Chappelle"
-      , "Hannibal Buress"
-      , "Rico Suave"
-      ]
-
-dropdown :: ∀ m. MonadAff m => Component m
-dropdown =
-  H.parentComponent
-    { initialState: const unit
-    , render
-    , eval
-    , receiver: const Nothing
-    }
-  where
-    eval :: Query ~> DSL Dropdown.Query m
-    eval (NoOp a) = pure a
-
-    render :: Unit -> HTML Dropdown.Query m
-    render _ = HH.slot unit Dropdown.component { items: users } (const Nothing)
-
-    users :: Array String
-    users =
-      [ "Lyndsey Duffield"
-      , "Chris Pine"
-      , "Kevin Hart"
-      , "Dave Chappelle"
-      , "Hannibal Buress"
-      , "Rico Suave"
-      ]

examples/Internal/Proxy.purs

@@ -1,7 +1,7 @@
 -- | A proxy that hides both the Query and Message of wrapped component.
 -- | Adapted from `Halogen.Component.Proxy` and `Halogen.Storybook.Proxy`.
 
-module Docs.Internal.Proxy
+module Internal.Proxy
   ( ProxyS
   , proxy
   ) where
@@ -12,6 +12,7 @@ import Data.Const (Const(..))
 import Data.Coyoneda (Coyoneda, unCoyoneda)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (un)
+import Data.Symbol (SProxy(..))
 import Halogen as H
 import Halogen.HTML as HH
 
@@ -21,25 +22,23 @@ data ProxyS f i 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
+   . 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)
+   . (forall a b. (b -> a) -> g b -> H.HalogenM i Void (child :: H.Slot f o 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 =
+proxyEval evalQuery component = H.mkComponent
-  H.parentComponent
+  { initialState: identity
-    { initialState: identity
+  , render
-    , render
+  , eval: H.mkEval $ H.defaultEval { handleQuery = handleQuery }
-    , eval
+  }
-    , receiver: const Nothing
-    }
   where
-    render :: i -> H.ParentHTML (ProxyS g i) f Unit m
+  render :: i -> H.ComponentHTML Void (child :: H.Slot f o Unit) m
-    render i = HH.slot unit component i (const Nothing)
+  render i = HH.slot (SProxy :: SProxy "child") unit component i (const Nothing)
 
-    eval :: ProxyS g i ~> H.ParentDSL i (ProxyS g i) f Unit Void m
+  handleQuery :: forall a. ProxyS g i a -> H.HalogenM i Void (child :: H.Slot f o Unit) Void m (Maybe a)
-    eval (Query iq) = unCoyoneda evalQuery iq
+  handleQuery (Query iq) = Just <$> unCoyoneda evalQuery iq

examples/Internal/RemoteData.purs

@@ -0,0 +1,45 @@
+-- | Copied over from 
+-- | https://github.com/krisajenkins/purescript-remotedata
+-- |
+-- | due to dependency conflicts
+module Internal.RemoteData where
+
+import Prelude
+
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Foldable (class Foldable, foldrDefault, foldlDefault)
+
+-- | A datatype representing fetched data.
+data RemoteData e a
+  = NotAsked
+  | Loading
+  | Failure e
+  | Success a
+
+derive instance eqRemoteData :: (Eq e, Eq a) => Eq (RemoteData e a)
+derive instance functorRemoteData :: Functor (RemoteData e)
+
+instance foldableRemoteData :: Foldable (RemoteData e) where
+  foldMap f (Success a) = f a
+  foldMap _ (Failure e) = mempty
+  foldMap _ NotAsked = mempty
+  foldMap _ Loading = mempty
+  foldr f = foldrDefault f
+  foldl f = foldlDefault f
+
+-- | Convert a `RemoteData` to a `Maybe`.
+toMaybe :: forall e a. RemoteData e a -> Maybe a
+toMaybe (Success value) = Just value
+toMaybe _ = Nothing
+
+-- | Convert a `Maybe` to `RemoteData`.
+fromMaybe :: forall e a. Maybe a -> RemoteData e a
+fromMaybe Nothing = NotAsked
+fromMaybe (Just value) = Success value
+
+-- | Convert an `Either` to `RemoteData`
+fromEither :: forall e a. Either e a -> RemoteData e a
+fromEither (Left err) = Failure err
+fromEither (Right value) = Success value
+

examples/Main.purs

@@ -2,74 +2,65 @@ module Main where
 
 import Prelude
 
-import Effect.Aff (Aff)
-import Effect.Aff.Class (class MonadAff)
-import Effect (Effect)
-import Effect.Class (liftEffect)
-import Web.HTML.HTMLElement (HTMLElement, toElement, fromNode)
-import Web.HTML (window)
-import Web.HTML.Window (document)
-import Web.HTML.HTMLDocument (toParentNode)
-import Web.DOM.Element (getAttribute)
-import Web.DOM.NodeList (toArray)
-import Web.DOM.ParentNode (QuerySelector(..), querySelectorAll)
 import Data.Array (zipWith)
 import Data.Const (Const)
-import Data.Map as Map
+import Data.Map as M
 import Data.Maybe (Maybe(..), fromMaybe)
-import Data.Traversable (sequence, traverse, traverse_)
+import Data.Symbol (SProxy(..))
+import Data.Traversable (for_, sequence, traverse)
 import Data.Tuple (Tuple(..))
-
+import Components.Typeahead as Typeahead
+import Components.Dropdown as Dropdown
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
 import Halogen as H
 import Halogen.Aff as HA
 import Halogen.HTML as HH
 import Halogen.VDom.Driver (runUI)
-
+import Internal.Proxy (ProxyS, proxy)
-import Docs.Internal.Proxy (ProxyS, proxy)
+import Select as Select
-import Docs.Internal.Component as Component
+import Web.DOM.Element (getAttribute)
+import Web.DOM.NodeList (toArray)
+import Web.DOM.ParentNode (QuerySelector(..), querySelectorAll)
+import Web.HTML (window)
+import Web.HTML.HTMLDocument (toParentNode)
+import Web.HTML.HTMLElement (HTMLElement, toElement, fromNode)
+import Web.HTML.Window (document)
 
 -- Finds all nodes labeled "data-component-id" and retrieves the associated attribute.
 -- Then, mounts the right component at each node.
+
 main :: Effect Unit
 main = HA.runHalogenAff do
   elements <- awaitSelectAll
     { query: QuerySelector "div[data-component]"
     , attr: "data-component"
     }
-  flip traverse_ elements $ \e -> runUI app e.attr e.element
+  for_ elements \e -> runUI app e.attr e.element
 
 ----------
 -- Routes
 
-type ComponentQuery = ProxyS (Const Void) Unit
+type Components
-type Components m
+  = M.Map String (H.Component HH.HTML (ProxyS (Const Void) Unit) Unit Void Aff)
-  = Map.Map String (H.Component HH.HTML ComponentQuery Unit Void m)
 
-routes :: ∀ m. MonadAff m => Components m
+routes :: Components
-routes = Map.fromFoldable
+routes = M.fromFoldable
-  [ Tuple "typeahead" $ proxy Component.typeahead
+  [ Tuple "typeahead" $ proxy typeahead
-  , Tuple "dropdown" $ proxy Component.dropdown ]
+  , Tuple "dropdown" $ proxy dropdown 
+  ]
 
-data Query a = NoOp a
+app :: H.Component HH.HTML (Const Void) String Void Aff
-
+app = H.mkComponent
-app :: ∀ m. MonadAff m => H.Component HH.HTML Query String Void m
+  { initialState: identity
-app =
+  , render
-  H.parentComponent
+  , eval: H.mkEval H.defaultEval
-    { initialState: identity
+  }
-    , render
-    , eval
-    , receiver: const Nothing
-    }
   where
-    render st = do
+  render st = M.lookup st routes # case _ of
-      let mbComponent = Map.lookup st routes
+    Nothing -> HH.div_ []
-      case mbComponent of
+    Just component -> HH.slot (SProxy :: SProxy "child") unit component unit absurd
-        Nothing -> HH.div_ []
-        Just component -> HH.slot unit component unit absurd
-
-    eval :: Query ~> H.ParentDSL String Query ComponentQuery Unit Void m
-    eval (NoOp a) = pure a
-
 
 ----------
 -- Selection Helpers
@@ -77,17 +68,40 @@ app =
 awaitSelectAll
   :: { query :: QuerySelector, attr :: String }
   -> Aff (Array { element :: HTMLElement, attr :: String })
-awaitSelectAll ask@{ query } = HA.awaitLoad >>= \_ -> selectElements ask >>= pure
+awaitSelectAll ask@{ query } = HA.awaitLoad >>= \_ -> selectElements ask
 
 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 :: Array HTMLElement
+    elems = fromMaybe [] <<< sequence $ fromNode <$> nodeArray
-      elems = fromMaybe [] <<< sequence $ fromNode <$> nodeArray
-
   attrs <- liftEffect $ traverse (getAttribute attr <<< toElement) elems
   pure $ zipWith ({ element: _, attr: _ }) elems (fromMaybe "" <$> attrs)
+
+----------
+-- Components
+
+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
+  , eval: H.mkEval H.defaultEval
+  }
+  where
+  label = SProxy :: SProxy "dropdown"
+  input = { items: [ "Chris", "Forest", "Dave" ], buttonLabel: "Choose a character" }
+
+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
+  , eval: H.mkEval H.defaultEval
+  }
+  where
+  label = SProxy :: SProxy "typeahead"
+

mkdocs.yml

@@ -9,7 +9,7 @@ repo_name: 'purescript-halogen-select'
 repo_url: 'https://github.com/citizennet/purescript-halogen-select'
 
 # Copyright
-copyright: 'Copyright © 2018 CitizenNet'
+copyright: 'Copyright © 2019 CitizenNet'
 
 # Config
 theme:
@@ -24,18 +24,11 @@ theme:
   logo:
     icon: 'school'
 
-# To mount components
 extra_javascript:
   - js/app.js
 
-# To style components
+extra_css:
-# extra_css:
+  - css/Select.css
-#  - css/cn-tailwind.scoped.css
-
-# Google Analytics
-# google_analytics:
-#   - 'UA-XXXXXXXX-X'
-#   - 'auto'
 
 # Extensions
 # Recommended here:
@@ -84,3 +77,4 @@ pages:
     # - 'Controlling component behavior from HTML': 'index.md'
     - 'Understanding free queries': 'concepts/understanding-free-queries.md'
   - Examples: 'examples.md'
+

package.json

@@ -5,14 +5,13 @@
     "watch": "pulp -w build",
     "build-docs": "pulp build -I examples --to docs/js/app.js",
     "watch-docs": "pulp -w --then 'mkdocs serve' build -I examples --to docs/js/app.js",
-    "clean": "rm -rf output bower_components node_modules site docs/js docs/css",
+    "clean": "rm -rf output bower_components site docs/js",
-    "postinstall": "bower i --silent",
+    "postinstall": "bower i --silent"
-    "fetch-css": "curl https://cdn.rawgit.com/citizennet/purescript-ocelot/dev/dist/cn-tailwind.scoped.css --output cn-tailwind.scoped.css",
-    "move-css": "mkdir -p docs/css/ && mv cn-tailwind.scoped.css docs/css/"
   },
-  "devDependencies": {},
+  "devDependencies": {
-  "dependencies": {
+    "bower": "^1.8.8",
-    "pulp": "^12.2.0",
+    "npm-check-updates": "^3.1.0",
-    "purescript": "^0.12.0"
+    "pulp": "12.3.1",
+    "purescript": "0.12.3"
   }
 }

src/Select.purs

@@ -7,12 +7,11 @@ module Select where
 
 import Prelude
 
-import Control.Comonad (extract)
+import Control.Monad.Free (liftF)
-import Control.Comonad.Store (Store, store)
+import Data.Const (Const)
-import Control.Monad.Free (Free, foldFree, liftF)
-import Data.Array (length, (!!))
 import Data.Maybe (Maybe(..), fromMaybe)
-import Data.Time.Duration (Milliseconds(..))
+import Data.Symbol (SProxy(..))
+import Data.Time.Duration (Milliseconds)
 import Data.Traversable (for_, traverse, traverse_)
 import Effect.Aff (Fiber, delay, error, forkAff, killFiber)
 import Effect.Aff.AVar (AVar)
@@ -22,124 +21,54 @@ import Effect.Ref (Ref)
 import Effect.Ref as Ref
 import Halogen as H
 import Halogen.HTML as HH
-import Renderless.State (getState, modifyState_, modifyStore)
+import Halogen.Query.ChildQuery (ChildQueryBox)
+import Prim.Row as Row
+import Record.Builder as Builder
+import Unsafe.Coerce (unsafeCoerce)
 import Web.Event.Event (preventDefault)
-import Web.HTML.HTMLElement (blur, focus)
+import Web.HTML.HTMLElement as HTMLElement
 import Web.UIEvent.KeyboardEvent as KE
 import Web.UIEvent.MouseEvent as ME
 
-----------
+data Action act
--- Component Types
+  = Search String
+  | Highlight Target
+  | Select Target (Maybe ME.MouseEvent)
+  | ToggleClick ME.MouseEvent
+  | Focus Boolean
+  | Key KE.KeyboardEvent
+  | PreventClick ME.MouseEvent
+  | SetVisibility Visibility
+  | Initialize (Maybe (Action act))
+  | Action act
 
--- | A useful shorthand for the Halogen component type
+type Action' = Action Void
-type Component o item m = H.Component HH.HTML (Query o item) (Input o item) (Message o item) m
 
--- | A useful shorthand for the Halogen component HTML type
+-----
-type ComponentHTML o item = H.ComponentHTML (Query o item)
+-- QUERIES
 
--- | A useful shorthand for the Halogen component DSL type
+data Query query ps a
-type ComponentDSL o item m = H.ComponentDSL (StateStore o item) (Query o item) (Message o item) m
+  = Send (ChildQueryBox ps (Maybe a))
+  | Query (query a)
 
--- | The component's state type, wrapped in `Store`. The state and result of the
+type Query' = Query (Const Void) ()
--- | render function are stored so that `extract` from `Control.Comonad` can be
--- | used to pull out the render function.
-type StateStore o item = Store (State item) (ComponentHTML o item)
 
-----------
+-----
--- Core Constructors
+-- Message
 
--- | These queries ensure the component behaves as expected so long as you use the
+data Message
--- | helper functions from `Select.Setters.Utils` to attach them to the right elements.
+  = Searched String
--- |
+  | Selected Int
--- | - `o`: The query type of the component that will mount this component in a child slot.
+  | VisibilityChanged Visibility
--- |        This allows you to embed your own queries into the `Select` component.
--- | - `item`: Your custom item type. It can be a simple type like `String`, or something
--- |           complex like `CalendarItem StartDate EndDate (Maybe Disabled)`.
--- |
--- | See the below functions for documentation for the individual constructors.
--- | The README details how to use them in Halogen code, since the patterns
--- | are a little different.
-data QueryF o item a
-  = Search String a
-  | Highlight Target a
-  | Select Int a
-  | Focus Boolean a
-  | Key KE.KeyboardEvent a
-  | PreventClick ME.MouseEvent a
-  | SetVisibility Visibility a
-  | GetVisibility (Visibility -> a)
-  | ReplaceItems (Array item) a
-  | Raise (o Unit) a
-  | Initialize a
-  | Receive (Input o item) a
 
-type Query o item = Free (QueryF o item)
+-----
+-- HELPER TYPES
 
--- | Trigger the relevant action with the event each time it occurs
+-- | The component slot type for easy use in a parent component
-always :: ∀ a b. a -> b -> Maybe a
+type Slot query ps msg = H.Slot (Query query ps) msg
-always = const <<< Just
 
--- | Perform a new search with the included string.
+-- | The component slot type when there is no extension
-search :: ∀ o item. String -> Query o item Unit
+type Slot' = Slot (Const Void) () Void
-search s = liftF (Search s unit)
-
--- | Change the highlighted index to the next item, previous item, or a
--- | specific index.
-highlight :: ∀ o item. Target -> Query o item Unit
-highlight t = liftF (Highlight t unit)
-
--- | Triggers the "Selected" message for the item at the specified index.
-select :: ∀ o item. Int -> Query o item Unit
-select i = liftF (Select i unit)
-
--- | Trigger the DOM focus event for the element we have a reference to.
-triggerFocus :: ∀ o item . Query o item Unit
-triggerFocus = liftF (Focus true unit)
-
--- | Trigger the DOM blur event for the element we have a reference to
-triggerBlur :: ∀ o item . Query o item Unit
-triggerBlur = liftF (Focus false unit)
-
--- | Register a key event. `TextInput`-driven components use these only for
--- | navigation, whereas `Toggle`-driven components also use the key stream for
--- | highlighting.
-key :: ∀ o item . KE.KeyboardEvent -> Query o item Unit
-key e = liftF (Key e unit)
-
--- | A helper query to prevent click events from bubbling up.
-preventClick :: ∀ o item . ME.MouseEvent -> Query o item Unit
-preventClick i = liftF (PreventClick i unit)
-
--- | Set the container visibility (`On` or `Off`)
-setVisibility :: ∀ o item . Visibility -> Query o item Unit
-setVisibility v = liftF (SetVisibility v unit)
-
--- | Get the container visibility (`On` or `Off`). Most useful when sequenced
--- | with other actions.
-getVisibility :: ∀ o item . Query o item Visibility
-getVisibility = liftF (GetVisibility identity)
-
--- | Toggles the container visibility.
-toggleVisibility :: ∀ o item . Query o item Unit
-toggleVisibility = getVisibility >>= not >>> setVisibility
-
--- | Replaces all items in state with the new array of items.
-replaceItems :: ∀ o item . Array item -> Query o item Unit
-replaceItems items = liftF (ReplaceItems items unit)
-
--- | A helper query that the component that mounts `Select` can use to embed its
--- | own queries. Triggers an `Emit` message containing the query when triggered.
--- | This can be used to easily extend `Select` with more behaviors.
-raise :: ∀ o item . o Unit -> Query o item Unit
-raise o = liftF (Raise o unit)
-
--- | Sets the component with new input.
-receive :: ∀ o item . Input o item -> Query o item Unit
-receive i = liftF (Receive i unit)
-
--- | Initializes the component on mount.
-initialize :: ∀ o item. Query o item Unit
-initialize = liftF (Initialize unit)
 
 -- | Represents a way to navigate on `Highlight` events: to the previous
 -- | item, next item, or the item at a particular index.
@@ -152,232 +81,267 @@ derive instance eqTarget :: Eq Target
 -- | ```purescript
 -- | render state = if state.visibility == On then renderAll else renderInputOnly
 -- | ```
--- |
--- | This is a Boolean Algebra, where `On` corresponds to true, and `Off` to
--- | false, as one might expect. Thus, `not` will invert visibility.
 data Visibility = Off | On
 derive instance eqVisibility :: Eq Visibility
 derive instance ordVisibility :: Ord Visibility
 
-instance heytingAlgebraVisibility :: HeytingAlgebra Visibility where
-  tt = On
-  ff = Off
-  not On = Off
-  not Off = On
-  conj On On = On
-  conj _ _ = Off
-  disj Off Off = Off
-  disj _ _ = On
-  implies On Off = Off
-  implies _ _ = On
-instance booleanAlgebraVisibility :: BooleanAlgebra Visibility
-
 -- | Text-driven inputs will operate like a normal search-driven selection component.
 -- | Toggle-driven inputs will capture key streams and debounce in reverse (only notify
 -- | about searches when time has expired).
-data InputType
+data InputType = Text | Toggle
-  = TextInput
-  | Toggle
 
--- | The component's state, once unpacked from `Store`.
+-- | The component state
--- |
+type State st =
--- | - `inputType`: Controls whether the component is input-driven or toggle-driven
+  { inputType :: InputType
--- | - `search`: The text the user has typed into the text input, or stream of keys
+  , search :: String
--- |             they have typed on the toggle.
+  , debounceTime :: Milliseconds
--- | - `debounceTime`: How long, in milliseconds, before events should occur based
+  , debounceRef :: Maybe (Ref (Maybe Debouncer))
--- |                   on user searches.
+  , visibility :: Visibility
--- | - `debounceRef`: A representation of a running timer that, when it expires, will
--- |                  trigger debounced events.
--- | - `inputElement`: A reference to the toggle or input element.
--- | - `items`: An array of user-provided `item`s.
--- | - `visibility`: Whether the array of items should be considered visible or not.
--- |                 Useful for rendering.
--- | - `highlightedIndex`: What item in the array of items should be considered
--- |                       highlighted. Useful for rendering.
--- | - `lastIndex`: The length of the array of items.
-type State item =
-  { inputType        :: InputType
-  , search           :: String
-  , debounceTime     :: Milliseconds
-  , debounceRef      :: Maybe (Ref (Maybe Debouncer))
-  , items            :: Array item
-  , visibility       :: Visibility
   , highlightedIndex :: Maybe Int
-  , lastIndex        :: Int
+  , getItemCount :: {| st } -> Int
+  | st
   }
 
--- | Represents a running computation that, when it completes, will trigger debounced
--- | .cts.
 type Debouncer =
-  { var   :: AVar Unit
+  { var :: AVar Unit
-  , fiber :: Fiber Unit 
+  , fiber :: Fiber Unit
   }
 
--- | The component's input type, which includes the component's render function. This
+type Input st =
--- | render function can also be used to share data with the parent component, as every
+  { inputType :: InputType
--- | time the parent re-renders, the render function will refresh in `Select`.
+  , search :: Maybe String
-type Input o item =
+  , debounceTime :: Maybe Milliseconds
-  { inputType     :: InputType
+  , getItemCount :: {| st } -> Int
-  , items         :: Array item
+  | st
-  , initialSearch :: Maybe String
-  , debounceTime  :: Maybe Milliseconds
-  , render        :: State item -> ComponentHTML o item
   }
 
--- | The parent is only notified for a few important events, but `Emit` makes it
+type Spec st query act ps msg m =
--- | possible to raise arbitrary queries on events.
+  { -- usual Halogen component spec 
--- |
+    render 
--- | - `Searched`: A new text search has been performed. Contains the text.
+      :: State st 
--- | - `Selected`: An item has been selected. Contains the item.
+      -> H.ComponentHTML (Action act) ps m
--- | - `VisibilityChanged`: The visibility has changed. Contains the new visibility.
+    
--- | - `Emit`: An embedded query has been triggered and can now be evaluated.
+    -- handle additional actions provided to the component
--- |           Contains the query.
+  , handleAction 
-data Message o item
+      :: act
-  = Searched String
+      -> H.HalogenM (State st) (Action act) ps msg m Unit
-  | Selected item
-  | VisibilityChanged Visibility
-  | Emit (o Unit)
 
-component :: ∀ o item m. MonadAff m => Component o item m
+    -- handle additional queries provided to the component
-component =
+  , handleQuery 
-  H.lifecycleComponent
+      :: forall a
-    { initialState
+       . query a 
-    , render: extract
+      -> H.HalogenM (State st) (Action act) ps msg m (Maybe a)
-    , eval: eval'
+
-    , receiver: Just <<< receive
+    -- handle messages emitted by the component; provide H.raise to simply
-    , initializer: Just initialize
+    -- raise the Select messages to the parent.
-    , finalizer: Nothing
+  , handleMessage 
-    }
+      :: Message
-  where
+      -> H.HalogenM (State st) (Action act) ps msg m Unit
-    initialState i = store i.render
+
-      { inputType: i.inputType
+    -- optionally handle input on parent re-renders; off by default, but use 
-      , search: fromMaybe "" i.initialSearch
+    -- `Just <<< Receive` to enable Select's default receiver 
-      , debounceTime: fromMaybe (Milliseconds 0.0) i.debounceTime
+  , receive 
-      , debounceRef: Nothing
+      :: Input st 
-      , items: i.items
+      -> Maybe (Action act)
-      , highlightedIndex: Nothing
+
-      , visibility: Off
+    -- perform some action when the component initializes.
-      , lastIndex: length i.items - 1
+  , initialize 
+      :: Maybe (Action act)
+
+    -- optionally perform some action on initialization. disabled by default.
+  , finalize
+      :: Maybe (Action act)
+  }
+
+type Spec' st m = Spec st (Const Void) Void () Void m
+
+defaultSpec :: forall st query act ps msg m. Spec st query act ps msg m
+defaultSpec = 
+  { render: const (HH.text mempty)
+  , handleAction: const (pure unit)
+  , handleQuery: const (pure Nothing)
+  , handleMessage: const (pure unit)
+  , receive: const Nothing
+  , initialize: Nothing
+  , finalize: Nothing
+  }
+  
+component
+  :: forall st query act ps msg m
+   . MonadAff m
+  => Row.Lacks "debounceRef" st
+  => Row.Lacks "visibility" st
+  => Row.Lacks "highlightedIndex" st
+  => Spec st query act ps msg m
+  -> H.Component HH.HTML (Query query ps) (Input st) msg m
+component spec = H.mkComponent
+  { initialState
+  , render: spec.render
+  , eval: H.mkEval $ H.defaultEval
+      { handleQuery = handleQuery spec.handleQuery
+      , handleAction = handleAction spec.handleAction spec.handleMessage
+      , initialize = Just (Initialize spec.initialize)
+      , receive = spec.receive
+      , finalize = spec.finalize
       }
+  }
+  where
+  initialState :: Input st -> State st
+  initialState = Builder.build pipeline
+    where
+    pipeline = 
+      Builder.modify (SProxy :: _ "search") (fromMaybe "")
+        >>> Builder.modify (SProxy :: _ "debounceTime") (fromMaybe mempty)
+        >>> Builder.insert (SProxy :: _ "debounceRef") Nothing
+        >>> Builder.insert (SProxy :: _ "visibility") Off
+        >>> Builder.insert (SProxy :: _ "highlightedIndex") Nothing
 
-    -- Construct the fold over the free monad based on the stepwise eval
+handleQuery
-    eval' :: Query o item ~> ComponentDSL o item m
+  :: forall st query act ps msg m a
-    eval' a = foldFree eval a
+   . MonadAff m
+  => (query a -> H.HalogenM (State st) (Action act) ps msg m (Maybe a))
+  -> Query query ps a
+  -> H.HalogenM (State st) (Action act) ps msg m (Maybe a)
+handleQuery handleQuery' = case _ of
+  Send box ->
+    H.HalogenM $ liftF $ H.ChildQuery box
 
-    -- Helper for setting visibility inside `eval`. Eta-expanded bc strict
+  Query query ->
-    -- mutual recursion woes.
+    handleQuery' query
-    setVis v = eval' (setVisibility v)
 
-    -- Just the normal Halogen eval
+handleAction
-    eval :: QueryF o item ~> ComponentDSL o item m
+  :: forall st act ps msg m
-    eval = case _ of
+   . MonadAff m
-      Initialize a -> a <$ do
+  => Row.Lacks "debounceRef" st
-        ref <- H.liftEffect $ Ref.new Nothing
+  => Row.Lacks "visibility" st
-        modifyState_ _ { debounceRef = Just ref }
+  => Row.Lacks "highlightedIndex" st
+  => (act -> H.HalogenM (State st) (Action act) ps msg m Unit)
+  -> (Message -> H.HalogenM (State st) (Action act) ps msg m Unit)
+  -> Action act
+  -> H.HalogenM (State st) (Action act) ps msg m Unit
+handleAction handleAction' handleMessage = case _ of
+  Initialize mbAction -> do
+    ref <- H.liftEffect $ Ref.new Nothing
+    H.modify_ _ { debounceRef = Just ref }
+    for_ mbAction handle
+  
+  Search str -> do
+    st <- H.get
+    ref <- H.liftEffect $ map join $ traverse Ref.read st.debounceRef
+    H.modify_ _ { search = str }
+    void $ H.fork $ handle $ SetVisibility On
 
-      Search str a -> a <$ do
+    case st.inputType, ref of
-        st <- getState
+      Text, Nothing -> unit <$ do
-        ref :: Maybe Debouncer <- H.liftEffect $ map join $ traverse Ref.read st.debounceRef
+        var   <- H.liftAff AVar.empty
-        modifyState_ _ { search = str }
+        fiber <- H.liftAff $ forkAff do
-        setVis On
+          delay st.debounceTime
+          AVar.put unit var
 
-        case st.inputType, ref of
+        -- This compututation will fork and run in the background. When the
-          TextInput, Nothing -> unit <$ do
+        -- var is finally filled, the action will run
-            var   <- H.liftAff AVar.empty
+        void $ H.fork do
-            fiber <- H.liftAff $ forkAff do
+          void $ H.liftAff $ AVar.take var
-              delay st.debounceTime
+          void $ H.liftEffect $ traverse_ (Ref.write Nothing) st.debounceRef
-              AVar.put unit var
+          H.modify_ _ { highlightedIndex = Just 0 }
+          newState <- H.get
+          handleMessage $ Searched newState.search
 
-            -- This compututation will fork and run in the background. When the
+        void $ H.liftEffect $ traverse_ (Ref.write $ Just { var, fiber }) st.debounceRef
-            -- var is finally filled, the action will run (raise a new search)
-            _ <- H.fork do
-              _ <- H.liftAff $ AVar.take var
-              void $ H.liftEffect $ traverse_ (Ref.write Nothing) st.debounceRef
-              modifyState_ _ { highlightedIndex = Just 0 }
-              newState <- getState
-              H.raise $ Searched newState.search
 
-            void $ H.liftEffect $ traverse_ (Ref.write $ Just { var, fiber }) st.debounceRef
+      Text, Just debouncer -> do
+        let var = debouncer.var
+        void $ H.liftAff $ killFiber (error "Time's up!") debouncer.fiber
+        fiber <- H.liftAff $ forkAff do
+          delay st.debounceTime
+          AVar.put unit var
+        void $ H.liftEffect $ traverse_ (Ref.write $ Just { var, fiber }) st.debounceRef
 
-          TextInput, Just debouncer -> do
+      -- Key stream is not yet implemented. However, this should capture user
-            let var = debouncer.var
+      -- key events and expire their search after a set number of milliseconds.
-            _ <- H.liftAff $ killFiber (error "Time's up!") debouncer.fiber
+      _, _ -> pure unit
-            fiber <- H.liftAff $ forkAff do
-              delay st.debounceTime
-              AVar.put unit var
 
-            void $ H.liftEffect $ traverse_ (Ref.write $ Just { var, fiber }) st.debounceRef
+  Highlight target -> do
+    st <- H.get
+    when (st.visibility == On) do
+      H.modify_ _ { highlightedIndex = Just $ getTargetIndex st target }
 
-          -- Key stream is not yet implemented. However, this should capture user
+  Select target mbEv -> do
-          -- key events and expire their search after a set number of milliseconds.
+    for_ mbEv (H.liftEffect <<< preventDefault <<< ME.toEvent)
-          _, _ -> pure unit
+    st <- H.get
+    when (st.visibility == On) case target of
+      Index ix -> handleMessage $ Selected ix
+      Next -> handleMessage $ Selected $ getTargetIndex st target
+      Prev -> handleMessage $ Selected $ getTargetIndex st target
 
-      Highlight target a -> a <$ do
+  ToggleClick ev -> do
-        st <- getState
+    H.liftEffect $ preventDefault $ ME.toEvent ev
-        when (st.visibility /= Off) $ do
+    st <- H.get
-          let highlightedIndex = case target of
+    case st.visibility of
-                Prev  -> case st.highlightedIndex of
+      On -> do
-                  Just i | i /= 0 ->
+        handle $ Focus false
-                    Just (i - 1)
+        handle $ SetVisibility Off
-                  _ ->
+      Off -> do
-                    Just st.lastIndex
+        handle $ Focus true
-                Next  -> case st.highlightedIndex of
+        handle $ SetVisibility On
-                  Just i | i /= st.lastIndex ->
-                    Just (i + 1)
-                  _ ->
-                    Just 0
-                Index i ->
-                  Just i
-          modifyState_ _ { highlightedIndex = highlightedIndex }
-        pure unit
 
-      Select index a -> a <$ do
+  Focus shouldFocus -> do
-        st <- getState
+    inputElement <- H.getHTMLElementRef $ H.RefLabel "select-input"
-        when (st.visibility == On) $
+    for_ inputElement \el -> H.liftEffect case shouldFocus of
-          for_ (st.items !! index)
+      true -> HTMLElement.focus el
-            \item -> H.raise (Selected item)
+      _ -> HTMLElement.blur el
 
-      Focus focusOrBlur a -> a <$ do
+  Key ev -> do
+    void $ H.fork $ handle $ SetVisibility On
+    let preventIt = H.liftEffect $ preventDefault $ KE.toEvent ev
+    case KE.code ev of
+      "ArrowUp" ->
+        preventIt *> handle (Highlight Prev)
+      "ArrowDown" ->
+        preventIt *> handle (Highlight Next)
+      "Escape" -> do
         inputElement <- H.getHTMLElementRef $ H.RefLabel "select-input"
-        traverse_ (H.liftEffect <<< if focusOrBlur then focus else blur) inputElement
+        preventIt
+        for_ inputElement (H.liftEffect <<< HTMLElement.blur)
+      "Enter" -> do
+        st <- H.get
+        preventIt
+        for_ st.highlightedIndex \ix ->
+          handle $ Select (Index ix) Nothing
+      otherKey -> pure unit
 
-      Key ev a -> a <$ do
+  PreventClick ev ->
-        setVis On
+    H.liftEffect $ preventDefault $ ME.toEvent ev
-        let preventIt = H.liftEffect $ preventDefault $ KE.toEvent ev
-        case KE.code ev of
-          "ArrowUp"   -> preventIt *> eval' (highlight Prev)
-          "ArrowDown" -> preventIt *> eval' (highlight Next)
-          "Escape"    -> do
-            inputElement <- H.getHTMLElementRef $ H.RefLabel "select-input"
-            preventIt
-            for_ inputElement (H.liftEffect <<< blur)
-          "Enter"     -> do
-            st <- getState
-            preventIt
-            for_ st.highlightedIndex (eval' <<< select)
-          otherKey    -> pure unit
 
-      PreventClick ev a -> a <$ do
+  SetVisibility v -> do
-        H.liftEffect <<< preventDefault <<< ME.toEvent $ ev
+    st <- H.get
+    when (st.visibility /= v) do
+      H.modify_ _ { visibility = v, highlightedIndex = Just 0 }
+      handleMessage $ VisibilityChanged v
 
-      SetVisibility v a -> a <$ do
+  Action act -> handleAction' act
-        st <- getState
-        when (st.visibility /= v) do
-          modifyState_ _ { visibility = v, highlightedIndex = Just 0 }
-          H.raise $ VisibilityChanged v
 
-      GetVisibility f -> do
+  where
-        st <- getState
+  -- eta-expansion is necessary to avoid infinite recursion
-        pure (f st.visibility)
+  handle act = handleAction handleAction' handleMessage act
+
+  getTargetIndex st = case _ of
+    Index i -> i
+    Prev -> case st.highlightedIndex of
+      Just i | i /= 0 -> i - 1
+      _ -> lastIndex st
+    Next -> case st.highlightedIndex of
+      Just i | i /= lastIndex st -> i + 1
+      _ -> 0
+    where
+    -- we know that the getItemCount function will only touch user fields,
+    -- and that the state record contains *at least* the user fields, so
+    -- this saves us from a set of unnecessary record deletions / modifications
+    userState :: State st -> {| st }
+    userState = unsafeCoerce
+
+    lastIndex :: State st -> Int
+    lastIndex = (_ - 1) <<< st.getItemCount <<< userState
 
-      ReplaceItems items a -> a <$ do
-        modifyState_ _
-          { items = items
-          , lastIndex = length items - 1
-          , highlightedIndex = Nothing }
 
-      Raise parentQuery a -> a <$ do
-        H.raise (Emit parentQuery)
 
-      Receive input a -> a <$ do
-        modifyStore input.render identity

src/Select/Setters.purs

@@ -4,29 +4,28 @@
 -- | below.
 module Select.Setters where
 
-import Prelude
+import Prelude (append, ($), (<<<))
 
 import Data.Maybe (Maybe(..))
-import Halogen (RefLabel(..)) as H
+import Halogen as H
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
-import Select (Query, Target(..), Visibility(..))
+import Select
-import Select as Select
+import Web.Event.Event as E
-import Web.Event.Event (Event)
 import Web.UIEvent.FocusEvent as FE
 import Web.UIEvent.KeyboardEvent as KE
 import Web.UIEvent.MouseEvent as ME
 
 -- | The properties that must be supported by the HTML element that serves
 -- | as a menu toggle. This should be used with toggle-driven `Select` components.
-type ToggleProps p =
+type ToggleProps props =
   ( onFocus :: FE.FocusEvent
   , onKeyDown :: KE.KeyboardEvent
   , onMouseDown :: ME.MouseEvent
   , onClick :: ME.MouseEvent
   , onBlur :: FE.FocusEvent
   , tabIndex :: Int
-  | p
+  | props
   )
 
 -- | A helper function that augments an array of `IProps` with `ToggleProps`. It
@@ -38,37 +37,30 @@ type ToggleProps p =
 -- | renderToggle = div (setToggleProps [ class "btn-class" ]) [ ...html ]
 -- | ```
 setToggleProps
-  :: ∀ o item p
+  :: forall props st act
-   . Array (HP.IProp (ToggleProps p) (Query o item Unit))
+   . State st
-  -> Array (HP.IProp (ToggleProps p) (Query o item Unit))
+  -> Array (HP.IProp (ToggleProps props) (Action act))
-setToggleProps = (<>)
+  -> Array (HP.IProp (ToggleProps props) (Action act))
-  [ HE.onFocus $ Select.always $ Select.setVisibility On
+setToggleProps st = append
-  , HE.onMouseDown \ev -> Just do
+  [ HE.onFocus \_ -> Just $ SetVisibility On
-      Select.preventClick ev
+  , HE.onMouseDown $ Just <<< ToggleClick
-      Select.getVisibility >>= case _ of
+  , HE.onKeyDown $ Just <<< Key
-        Select.On -> do
+  , HE.onBlur \_ -> Just $ SetVisibility Off
-          Select.triggerBlur
-          Select.setVisibility Select.Off
-        Select.Off -> do
-          Select.triggerFocus
-          Select.setVisibility Select.On
-  , HE.onKeyDown $ Just <<< Select.key
-  , HE.onBlur $ Select.always $ Select.setVisibility Off
   , HP.tabIndex 0
   , HP.ref (H.RefLabel "select-input")
   ]
 
 -- | The properties that must be supported by the HTML element that serves
 -- | as a text input. This should be used with input-driven `Select` components.
-type InputProps p =
+type InputProps props =
   ( onFocus :: FE.FocusEvent
   , onKeyDown :: KE.KeyboardEvent
-  , onInput :: Event
+  , onInput :: E.Event
   , value :: String
   , onMouseDown :: ME.MouseEvent
   , onBlur :: FE.FocusEvent
   , tabIndex :: Int
-  | p
+  | props
   )
 
 -- | A helper function that augments an array of `IProps` with `InputProps`. It
@@ -80,15 +72,15 @@ type InputProps p =
 -- | renderInput = input_ (setInputProps [ class "my-class" ])
 -- | ```
 setInputProps
-  :: ∀ o item p
+  :: forall props act
-   . Array (HP.IProp (InputProps p) (Query o item Unit))
+   . Array (HP.IProp (InputProps props) (Action act))
-  -> Array (HP.IProp (InputProps p) (Query o item Unit))
+  -> Array (HP.IProp (InputProps props) (Action act))
-setInputProps = (<>)
+setInputProps = append
-  [ HE.onFocus $ Select.always $ Select.setVisibility On
+  [ HE.onFocus \_ -> Just $ SetVisibility On
-  , HE.onKeyDown $ Just <<< Select.key
+  , HE.onKeyDown $ Just <<< Key
-  , HE.onValueInput $ Just <<< Select.search
+  , HE.onValueInput $ Just <<< Search
-  , HE.onMouseDown $ Select.always $ Select.setVisibility On
+  , HE.onMouseDown \_ -> Just $ SetVisibility On
-  , HE.onBlur $ Select.always $ Select.setVisibility Off
+  , HE.onBlur \_ -> Just $ SetVisibility Off
   , HP.tabIndex 0
   , HP.ref (H.RefLabel "select-input")
   ]
@@ -96,10 +88,10 @@ setInputProps = (<>)
 -- | The properties that must be supported by the HTML element that acts as a
 -- | selectable "item" in your UI. This should be attached to every item that
 -- | can be selected.
-type ItemProps p =
+type ItemProps props =
   ( onMouseDown :: ME.MouseEvent
   , onMouseOver :: ME.MouseEvent
-  | p
+  | props
   )
 
 -- | A helper function that augments an array of `IProps` with `ItemProps`. It
@@ -109,20 +101,19 @@ type ItemProps p =
 -- | with `mapWithIndex`:
 -- |
 -- | ```purescript
--- | renderItem index itemHTML = HH.li (setItemProps index [ class "my-class" ]) [ itemHTML ]
+-- | renderItem index itemHTML = 
+-- |   HH.li (setItemProps index [ props ]) [ itemHTML ]
 -- |
 -- | render = renderItem `mapWithIndex` itemsArray
 -- | ```
 setItemProps
-  :: ∀ o item p
+  :: forall props act
-   . Int
+   . Int 
-  -> Array (HP.IProp (ItemProps p) (Query o item Unit))
+  -> Array (HP.IProp (ItemProps props) (Action act)) 
-  -> Array (HP.IProp (ItemProps p) (Query o item Unit))
+  -> Array (HP.IProp (ItemProps props) (Action act))
-setItemProps index = (<>)
+setItemProps index = append
-  [ HE.onMouseDown \ev -> Just do
+  [ HE.onMouseDown \ev -> Just (Select (Index index) (Just ev))
-      Select.preventClick ev
+  , HE.onMouseOver \_ -> Just $ Highlight (Index index)
-      Select.select index
-  , HE.onMouseOver $ Select.always $ Select.highlight (Index index)
   ]
 
 -- | A helper function that augments an array of `IProps` with a `MouseDown`
@@ -130,8 +121,9 @@ setItemProps index = (<>)
 -- | from bubbling up a blur event to the DOM. This should be used on the parent
 -- | element that contains your items.
 setContainerProps
-  :: ∀ o item p
+  :: forall props act
-   . Array (HP.IProp (onMouseDown :: ME.MouseEvent | p) (Query o item Unit))
+   . Array (HP.IProp (onMouseDown :: ME.MouseEvent | props) (Action act))
-  -> Array (HP.IProp (onMouseDown :: ME.MouseEvent | p) (Query o item Unit))
+  -> Array (HP.IProp (onMouseDown :: ME.MouseEvent | props) (Action act))
-setContainerProps = (<>)
+setContainerProps = append
-  [ HE.onMouseDown $ Just <<< Select.preventClick ]
+  [ HE.onMouseDown $ Just <<< PreventClick ]
+