Update for Halogen 6 and PureScript 0.14 (#73)

Author: thomashoneyman

.github/workflows/ci.yml

@@ -1,6 +1,6 @@
 name: CI
 
-on: 
+on:
   push:
     branches: [main]
   pull_request:
@@ -11,13 +11,10 @@ jobs:
 
     steps:
       - uses: actions/checkout@v2
-      - uses: thomashoneyman/setup-purescript@main
+      - uses: purescript-contrib/setup-purescript@main
 
       - name: Build source
         run: spago build
 
-      - name: Run tests
-        run: spago test
-
       - name: Build examples
         run: spago -x example/example.dhall build

example/App/Home.purs

@@ -30,7 +30,7 @@ render =
 
 -- Component
 
-component :: H.Component HH.HTML (Const Void) Unit Void Aff
+component :: H.Component (Const Void) Unit Void Aff
 component = H.mkComponent
   { initialState: const unit
   , render: const render

example/App/UI/Dropdown.purs

@@ -5,7 +5,6 @@ import Prelude
 import DOM.HTML.Indexed (HTMLbutton)
 import Data.Array (difference, mapWithIndex, length, (!!))
 import Data.Maybe (Maybe(..), fromMaybe)
-import Data.Symbol (SProxy(..))
 import Data.Traversable (for_)
 import Effect.Aff.Class (class MonadAff)
 import Example.App.UI.Element (class_)
@@ -15,17 +14,18 @@ import Halogen as H
 import Halogen.HTML as HH
 import Select as Select
 import Select.Setters as Setters
+import Type.Proxy (Proxy(..))
 
 type Slot item =
   H.Slot (Select.Query Query ()) (Message item)
 
-_dropdown = SProxy :: SProxy "dropdown"
+_dropdown = Proxy :: Proxy "dropdown"
 
-data Query a 
+data Query a
   = Clear a
 
 clear :: Select.Query Query () Unit
-clear = Select.Query (H.tell Clear)
+clear = Select.Query (H.mkTell Clear)
 
 type State item =
   ( selected :: Maybe item
@@ -55,15 +55,15 @@ data Message item
   = Selected item
   | Cleared
 
-spec 
+spec
   :: forall item m i
-   . MonadAff m 
+   . MonadAff m
   => ToText item
   => Eq item
   => Select.Spec (State item) Query Void () i (Message item) m
 spec = Select.defaultSpec
-  { render = render 
-  , handleQuery = handleQuery 
+  { render = render
+  , handleQuery = handleQuery
   , handleEvent = handleEvent
   }
   where
@@ -87,7 +87,7 @@ spec = Select.defaultSpec
         H.modify_ _
           { selected = Just item
           , available = difference st.items [ item ]
-          , visibility = Select.Off 
+          , visibility = Select.Off
           }
         H.raise (Selected item)
     _ -> pure unit
@@ -117,13 +117,13 @@ menu st =
   [ if st.visibility == Select.Off then HH.text "" else
     HH.div
       (Setters.setContainerProps [ class_ "dropdown-content" ])
-      (mapWithIndex 
+      (mapWithIndex
         (\ix item ->
           HH.span
             (Setters.setItemProps ix case Just ix == st.highlightedIndex of
-              true -> 
+              true ->
                 [ class_ "dropdown-item has-background-link has-text-white-bis" ]
-              _ -> 
+              _ ->
                 [ class_ "dropdown-item" ]
             )
             [ HH.text (toText item) ]

example/App/UI/Element.purs

@@ -5,9 +5,9 @@ import Prelude
 import DOM.HTML.Indexed (HTMLa, HTMLbutton, HTMLinput, HTMLtextarea)
 import DOM.HTML.Indexed.InputType (InputType(..))
 import Data.Either (Either(..), either)
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (maybe)
 import Data.Newtype (class Newtype)
-import Data.Symbol (class IsSymbol, SProxy(..))
+import Data.Symbol (class IsSymbol)
 import Data.Variant (Variant)
 import Example.App.Validation (class ToText, toText)
 import Example.App.Validation as V
@@ -18,6 +18,7 @@ import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Prim.Row (class Cons)
 import Record.Builder as Builder
+import Type.Proxy (Proxy(..))
 import Web.Event.Event (Event)
 import Web.UIEvent.FocusEvent (FocusEvent)
 
@@ -125,11 +126,12 @@ type FieldConfig' =
 
 -- Provide a label, help text, placeholder, and symbol to have Formless wire everything
 -- up on your behalf.
+type FieldConfig :: Symbol -> Type
 type FieldConfig sym =
   { label :: String
   , help :: String
   , placeholder :: String
-  , sym :: SProxy sym
+  , sym :: Proxy sym
   }
 
 input :: forall i p. FieldConfig' -> Array (HH.IProp HTMLinput p) -> HH.HTML i p
@@ -148,8 +150,8 @@ textarea config props =
   field
     { label: config.label, help: config.help }
     [ HH.textarea $
-        [ config.help # either 
-            (const $ class_ "textarea is-danger") 
+        [ config.help # either
+            (const $ class_ "textarea is-danger")
             (const $ class_ "textarea")
         , HP.placeholder config.placeholder
         ] <> props
@@ -177,14 +179,14 @@ formlessField
 formlessField fieldType config state = fieldType (Builder.build config' config) props
   where
     config' =
-      Builder.delete (SProxy :: SProxy "sym")
-        >>> Builder.modify (SProxy :: SProxy "help") (const help')
+      Builder.delete (Proxy :: Proxy "sym")
+        >>> Builder.modify (Proxy :: Proxy "help") (const help')
 
-    help' = 
+    help' =
       maybe (Right config.help) (Left <<< toText) (F.getError config.sym state.form)
 
     props =
       [ HP.value (F.getInput config.sym state.form)
-      , HE.onValueInput (Just <<< F.setValidate config.sym)
+      , HE.onValueInput (F.setValidate config.sym)
       ]
 

example/App/UI/Typeahead.purs

@@ -5,7 +5,6 @@ import Prelude
 import Data.Array (difference, filter, length, (:), (!!))
 import Data.Maybe (Maybe(..))
 import Data.String as String
-import Data.Symbol (SProxy(..))
 import Effect.Aff.Class (class MonadAff)
 import Example.App.UI.Dropdown as Dropdown
 import Example.App.UI.Element (class_)
@@ -16,13 +15,14 @@ import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Select as Select
 import Select.Setters as Setters
+import Type.Proxy (Proxy(..))
 
 type Slot f item =
   H.Slot (Select.Query (Query item) ()) (Message f item)
 
-_typeahead = SProxy :: SProxy "typeahead"
-_typeaheadSingle = SProxy :: SProxy "typeaheadSingle"
-_typeaheadMulti = SProxy :: SProxy "typeaheadMulti"
+_typeahead = Proxy :: Proxy "typeahead"
+_typeaheadSingle = Proxy :: Proxy "typeaheadSingle"
+_typeaheadMulti = Proxy :: Proxy "typeaheadMulti"
 
 data Query item a
   = GetAvailableItems (Array item -> a)
@@ -35,10 +35,10 @@ clear :: forall item. Select.Query (Query item) () Unit
 clear = Select.Query (Clear unit)
 
 data Action item
-  = Remove item 
+  = Remove item
 
 remove :: forall item. item -> Select.Action (Action item)
-remove = Select.Action <<< Remove 
+remove = Select.Action <<< Remove
 
 type State f item =
   ( items :: Array item
@@ -64,7 +64,7 @@ input { items, placeholder } =
   , placeholder
   }
 
-data Message f item
+data Message (f :: Type -> Type) item
   = SelectionsChanged (f item)
 
 ----------
@@ -85,18 +85,18 @@ single = spec' (\i av -> const (av !! i)) (const $ const Nothing) filter' render
   render st = case st.selected of
     Just item ->
       HH.div
-        [ if st.visibility == Select.On 
-            then class_ "dropdown is-active" 
+        [ if st.visibility == Select.On
+            then class_ "dropdown is-active"
             else class_ "dropdown is-flex" ]
-        [ Dropdown.toggle 
-            [ HE.onClick \_ -> Just $ remove item ] 
+        [ Dropdown.toggle
+            [ HE.onClick \_ -> remove item ]
             st
         , Dropdown.menu st
         ]
     Nothing ->
       HH.div
-        [ if st.visibility == Select.On 
-            then class_ "dropdown is-flex is-active" 
+        [ if st.visibility == Select.On
+            then class_ "dropdown is-flex is-active"
             else class_ "dropdown is-flex" ]
         [ HH.input
           ( Setters.setInputProps
@@ -123,27 +123,27 @@ multi = spec' selectByIndex (filter <<< (/=)) difference render
   render st =
     HH.div_
       [ HH.div
-        [ if length st.selected > 0 
-            then class_ "panel is-marginless" 
-            else class_ "panel is-hidden" 
+        [ if length st.selected > 0
+            then class_ "panel is-marginless"
+            else class_ "panel is-hidden"
         ]
         (st.selected <#> \i ->
           HH.div
             [ class_ "panel-block has-background-white"
-            , HE.onClick \_ -> Just $ remove i
+            , HE.onClick \_ -> remove i
             ]
             [ HH.text $ toText i ]
         )
       , HH.div
-        [ if st.visibility == Select.On 
-            then class_ "dropdown is-flex is-active" 
-            else class_ "dropdown is-flex" 
+        [ if st.visibility == Select.On
+            then class_ "dropdown is-flex is-active"
+            else class_ "dropdown is-flex"
         ]
         [ HH.input
-            (Setters.setInputProps 
+            (Setters.setInputProps
               [ class_ "input"
               , HP.placeholder st.placeholder
-              , HP.value st.search 
+              , HP.value st.search
               ]
             )
         , Dropdown.menu st
@@ -163,12 +163,12 @@ spec'
   => (Int -> Array item -> f item -> f item)
   -> (item -> f item -> f item)
   -> (Array item -> f item -> Array item)
-  -> (Select.State (State f item) 
+  -> (Select.State (State f item)
        -> H.ComponentHTML (Select.Action (Action item)) () m
      )
   -> Select.Spec (State f item) (Query item) (Action item) () i (Message f item) m
 spec' select' remove' filter' render' = Select.defaultSpec
-  { render = render' 
+  { render = render'
   , handleEvent = handleEvent
   , handleQuery = handleQuery
   , handleAction = handleAction
@@ -183,7 +183,7 @@ spec' select' remove' filter' render' = Select.defaultSpec
     Select.Selected ix -> do
       st <- H.get
       let selected' = select' ix st.available st.selected
-      H.modify_ _ 
+      H.modify_ _
         { selected = selected'
         , available = filter' st.available selected'
         , visibility = Select.Off
@@ -209,6 +209,6 @@ spec' select' remove' filter' render' = Select.defaultSpec
       let selected' = remove' item st.selected
       H.modify_ _
         { selected = selected'
-        , available = filter' st.items selected' 
+        , available = filter' st.items selected'
         }
       H.raise (SelectionsChanged selected')

example/App/Validation.purs

@@ -4,8 +4,6 @@ import Prelude
 
 import Data.Either (Either(..))
 import Data.Foldable (length) as Foldable
-import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
 import Data.Int (fromString) as Int
 import Data.Lens (preview)
 import Data.Maybe (Maybe, maybe)
@@ -27,10 +25,6 @@ data FieldError
   | NotEqual String String
   | NotEnoughMoney
 
-derive instance genericFieldError :: Generic FieldError _
-instance showFieldError :: Show FieldError where
-  show = genericShow
-
 instance toTextFieldError :: ToText FieldError where
   toText EmptyField = "This field is required."
   toText InvalidEmail = "That email is not valid."
@@ -119,4 +113,4 @@ enoughMoney = Validation \_ i -> do
   _ <- liftAff $ delay $ Milliseconds 5000.0
   pure $ if (i > 1000)
     then Left NotEnoughMoney
-    else pure i
+    else pure i