Skip to content

Commit

Permalink
Update for Halogen 6
Browse files Browse the repository at this point in the history
  • Loading branch information
thomashoneyman committed Apr 1, 2021
1 parent 256d09d commit 27befa1
Show file tree
Hide file tree
Showing 9 changed files with 56 additions and 176 deletions.
16 changes: 7 additions & 9 deletions bower.json
Original file line number Diff line number Diff line change
@@ -1,9 +1,7 @@
{
"name": "purescript-halogen-select",
"homepage": "https://github.com/citizennet/purescript-halogen-select",
"authors": [
"Thomas Honeyman <[email protected]>"
],
"authors": ["Thomas Honeyman <[email protected]>"],
"description": "Building blocks for common selection user interfaces in PureScript & Halogen",
"keywords": [
"purescript",
Expand All @@ -17,7 +15,7 @@
],
"repository": {
"type": "git",
"url": "git://github.com/citizennet/purescript-halogen-select.git"
"url": "https://github.com/citizennet/purescript-halogen-select.git"
},
"license": "Apache-2.0",
"ignore": [
Expand All @@ -31,12 +29,12 @@
"generated-docs"
],
"dependencies": {
"purescript-halogen": "^5.0.0-rc.4",
"purescript-record": "^2.0.0"
"purescript-halogen": "^6.0.0",
"purescript-record": "^3.0.0"
},
"devDependencies": {
"purescript-debug": "^4.0.0",
"purescript-affjax": "^9.0.0",
"purescript-argonaut": "^6.0.0"
"purescript-debug": "^5.0.0",
"purescript-affjax": "^12.0.0",
"purescript-argonaut": "^8.0.0"
}
}
2 changes: 1 addition & 1 deletion examples/Components/Dropdown.purs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ type Input =
, buttonLabel :: String
}

component :: H.Component HH.HTML S.Query' Input Message Aff
component :: H.Component S.Query' Input Message Aff
component = S.component input $ S.defaultSpec
{ render = render
, handleEvent = handleEvent
Expand Down
22 changes: 13 additions & 9 deletions examples/Components/Typeahead.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,16 +2,16 @@ module Components.Typeahead where

import Prelude

import Affjax (printError)
import Affjax as AX
import Affjax.ResponseFormat as AR
import Components.Dropdown as D
import Data.Argonaut.Decode ((.:), decodeJson)
import Data.Argonaut.Decode (decodeJson, printJsonDecodeError, (.:))
import Data.Array (mapWithIndex, filter, (:), (!!), length, null, difference)
import Data.Foldable (for_)
import Data.Bifunctor (lmap)
import Data.Foldable (for_)
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)
Expand All @@ -23,6 +23,7 @@ import Internal.CSS (class_, classes_, whenElem)
import Internal.RemoteData as RD
import Select as S
import Select.Setters as SS
import Type.Proxy (Proxy(..))

type Slot =
S.Slot Query ChildSlots Message
Expand All @@ -46,7 +47,7 @@ data Message
type ChildSlots =
( dropdown :: D.Slot Unit )

component :: H.Component HH.HTML (S.Query Query ChildSlots) Unit Message Aff
component :: H.Component (S.Query Query ChildSlots) Unit Message Aff
component = S.component (const input) $ S.defaultSpec
{ render = render
, handleAction = handleAction
Expand Down Expand Up @@ -148,7 +149,7 @@ component = S.component (const input) $ S.defaultSpec
closeButton item =
HH.span
[ class_ "Location__closeButton"
, HE.onClick \_ -> Just $ S.Action $ Remove item
, HE.onClick \_ -> S.Action $ Remove item
]
[ HH.text "×" ]

Expand All @@ -164,8 +165,8 @@ component = S.component (const input) $ S.defaultSpec
renderDropdown = whenElem (st.visibility == S.On) \_ ->
HH.slot _dropdown unit D.component dropdownInput handler
where
_dropdown = SProxy :: SProxy "dropdown"
handler msg = Just $ S.Action $ HandleDropdown msg
_dropdown = Proxy :: Proxy "dropdown"
handler msg = S.Action $ HandleDropdown msg
dropdownInput = { items: [ "Earth", "Mars" ], buttonLabel: "Human Planets" }

renderContainer = whenElem (st.visibility == S.On) \_ ->
Expand Down Expand Up @@ -215,5 +216,8 @@ 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)
let body = lmap AR.printResponseFormatError res.body
pure $ RD.fromEither $ traverse decodeJson =<< (_ .: "results") =<< decodeJson =<< body
pure $ RD.fromEither $ traverse (lmap printJsonDecodeError <<< decodeJson)
=<< (lmap printJsonDecodeError <<< (_ .: "results"))
=<< (lmap printJsonDecodeError <<< decodeJson)
<<< _.body
=<< (lmap printError res)
13 changes: 7 additions & 6 deletions examples/Internal/Proxy.purs
Original file line number Diff line number Diff line change
Expand Up @@ -12,33 +12,34 @@ 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
import Type.Proxy (Proxy(..))

data ProxyS :: (Type -> Type) -> Type -> Type -> Type
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
-> H.Component HH.HTML (ProxyS (Const Void) i) i Void m
. H.Component f i o m
-> H.Component (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.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
-> H.Component f i o m
-> H.Component (ProxyS g i) i Void m
proxyEval evalQuery component = H.mkComponent
{ initialState: identity
, render
, eval: H.mkEval $ H.defaultEval { handleQuery = handleQuery }
}
where
render :: i -> H.ComponentHTML Void (child :: H.Slot f o Unit) m
render i = HH.slot (SProxy :: SProxy "child") unit component i (const Nothing)
render i = HH.slot_ (Proxy :: Proxy "child") unit component i

handleQuery :: forall a. ProxyS g i a -> H.HalogenM i Void (child :: H.Slot f o Unit) Void m (Maybe a)
handleQuery (Query iq) = Just <$> unCoyoneda evalQuery iq
20 changes: 10 additions & 10 deletions examples/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,15 +2,14 @@ module Main where

import Prelude

import Components.Dropdown as Dropdown
import Components.Typeahead as Typeahead
import Data.Array (zipWith)
import Data.Const (Const)
import Data.Map as M
import Data.Maybe (Maybe(..), fromMaybe)
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)
Expand All @@ -19,6 +18,7 @@ import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.VDom.Driver (runUI)
import Internal.Proxy (ProxyS, proxy)
import Type.Proxy (Proxy(..))
import Web.DOM.Element (getAttribute)
import Web.DOM.NodeList (toArray)
import Web.DOM.ParentNode (QuerySelector(..), querySelectorAll)
Expand All @@ -42,15 +42,15 @@ main = HA.runHalogenAff do
-- Routes

type Components
= M.Map String (H.Component HH.HTML (ProxyS (Const Void) Unit) Unit Void Aff)
= M.Map String (H.Component (ProxyS (Const Void) Unit) Unit Void Aff)

routes :: Components
routes = M.fromFoldable
[ Tuple "typeahead" $ proxy typeahead
, Tuple "dropdown" $ proxy dropdown
]

app :: H.Component HH.HTML (Const Void) String Void Aff
app :: H.Component (Const Void) String Void Aff
app = H.mkComponent
{ initialState: identity
, render
Expand All @@ -59,7 +59,7 @@ app = H.mkComponent
where
render st = M.lookup st routes # case _ of
Nothing -> HH.div_ []
Just component -> HH.slot (SProxy :: SProxy "child") unit component unit absurd
Just component -> HH.slot (Proxy :: Proxy "child") unit component unit absurd

----------
-- Selection Helpers
Expand All @@ -83,23 +83,23 @@ selectElements { query, attr } = do
----------
-- Components

dropdown :: forall t0 t1 t2. H.Component HH.HTML t0 t1 t2 Aff
dropdown :: forall t0 t1 t2. H.Component t0 t1 t2 Aff
dropdown = H.mkComponent
{ initialState: const unit
, render: \_ ->
HH.slot label unit Dropdown.component input \_ -> Nothing
, eval: H.mkEval H.defaultEval
}
where
label = SProxy :: SProxy "dropdown"
label = Proxy :: Proxy "dropdown"
input = { items: [ "Chris", "Forest", "Dave" ], buttonLabel: "Choose a character" }

typeahead :: forall t0 t1 t2. H.Component HH.HTML t0 t1 t2 Aff
typeahead :: forall t0 t1 t2. H.Component t0 t1 t2 Aff
typeahead = H.mkComponent
{ initialState: const unit
, render: \_ ->
HH.slot label unit Typeahead.component unit \_ -> Nothing
, eval: H.mkEval H.defaultEval
}
where
label = SProxy :: SProxy "typeahead"
label = Proxy :: Proxy "typeahead"
7 changes: 3 additions & 4 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,8 @@
"postinstall": "bower i --silent"
},
"devDependencies": {
"bower": "^1.8.8",
"npm-check-updates": "^3.1.0",
"pulp": "12.3.1",
"purescript": "0.12.3"
"bower": "^1.8.12",
"pulp": "15.0.0",
"purescript": "0.14.0"
}
}
4 changes: 2 additions & 2 deletions src/Select.purs
Original file line number Diff line number Diff line change
Expand Up @@ -116,7 +116,7 @@ type Input st =
}

type Component query slots input msg m =
H.Component HH.HTML (Query query slots) input msg m
H.Component (Query query slots) input msg m

type ComponentHTML action slots m =
H.ComponentHTML (Action action) slots m
Expand Down Expand Up @@ -184,7 +184,7 @@ component
=> Row.Lacks "highlightedIndex" st
=> (input -> Input st)
-> Spec st query action slots input msg m
-> H.Component HH.HTML (Query query slots) input msg m
-> H.Component (Query query slots) input msg m
component mkInput spec = H.mkComponent
{ initialState: initialState <<< mkInput
, render: spec.render
Expand Down
26 changes: 13 additions & 13 deletions src/Select/Setters.purs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
-- | below.
module Select.Setters where

import Prelude (append, ($), (<<<))
import Prelude (append)

import Data.Maybe (Maybe(..))
import Halogen as H
Expand Down Expand Up @@ -41,10 +41,10 @@ setToggleProps
. Array (HP.IProp (ToggleProps props) (Action act))
-> Array (HP.IProp (ToggleProps props) (Action act))
setToggleProps = append
[ HE.onFocus \_ -> Just $ SetVisibility On
, HE.onMouseDown $ Just <<< ToggleClick
, HE.onKeyDown $ Just <<< Key
, HE.onBlur \_ -> Just $ SetVisibility Off
[ HE.onFocus \_ -> SetVisibility On
, HE.onMouseDown ToggleClick
, HE.onKeyDown Key
, HE.onBlur \_ -> SetVisibility Off
, HP.tabIndex 0
, HP.ref (H.RefLabel "select-input")
]
Expand Down Expand Up @@ -75,11 +75,11 @@ setInputProps
. Array (HP.IProp (InputProps props) (Action act))
-> Array (HP.IProp (InputProps props) (Action act))
setInputProps = append
[ HE.onFocus \_ -> Just $ SetVisibility On
, HE.onKeyDown $ Just <<< Key
, HE.onValueInput $ Just <<< Search
, HE.onMouseDown \_ -> Just $ SetVisibility On
, HE.onBlur \_ -> Just $ SetVisibility Off
[ HE.onFocus \_ -> SetVisibility On
, HE.onKeyDown Key
, HE.onValueInput Search
, HE.onMouseDown \_ -> SetVisibility On
, HE.onBlur \_ -> SetVisibility Off
, HP.tabIndex 0
, HP.ref (H.RefLabel "select-input")
]
Expand Down Expand Up @@ -111,8 +111,8 @@ setItemProps
-> Array (HP.IProp (ItemProps props) (Action act))
-> Array (HP.IProp (ItemProps props) (Action act))
setItemProps index = append
[ HE.onMouseDown \ev -> Just (Select (Index index) (Just ev))
, HE.onMouseOver \_ -> Just $ Highlight (Index index)
[ HE.onMouseDown \ev -> Select (Index index) (Just ev)
, HE.onMouseOver \_ -> Highlight (Index index)
]

-- | A helper function that augments an array of `IProps` with a `MouseDown`
Expand All @@ -124,4 +124,4 @@ setContainerProps
. Array (HP.IProp (onMouseDown :: ME.MouseEvent | props) (Action act))
-> Array (HP.IProp (onMouseDown :: ME.MouseEvent | props) (Action act))
setContainerProps = append
[ HE.onMouseDown $ Just <<< PreventClick ]
[ HE.onMouseDown PreventClick ]
Loading

0 comments on commit 27befa1

Please sign in to comment.