A simple Halogen form abstraction leveraging the Reader monad and lenses

App.purs

module App (Query, app) where 

import Prelude
import Control.Monad.Reader (Reader, asks, runReader)
import Data.Array ((:))
import Data.Lens (Lens', (^.), _1, _2, set, view)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(Nothing))
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP

type State = { firstName :: String, lastName :: String }

data Query a = SetState State a

app :: forall m. H.Component HH.HTML Query Unit Void m
app =
  H.component
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    }
  where

    initialState :: State
    initialState = { firstName: "Anonymous", lastName: "User" }

    render :: State -> H.ComponentHTML Query
    render state@({ firstName, lastName }) =
      HH.div_ $ heading : ((renderForm (formContext state $ HE.input SetState)) <$> fields)
      where

        heading = HH.h1_ [ HH.text $ "Welcome, " <> firstName <> " " <> lastName <> "!" ]
        fields =
          [ field "First Name" $ textInput _firstName
          , field "Last Name" $ textInput _lastName
          ]

        _firstName = prop (SProxy :: SProxy "firstName")
        _lastName = prop (SProxy :: SProxy "lastName")


    eval :: Query ~> H.ComponentDSL State Query Void m
    eval = case _ of
      SetState state next -> do
        H.put state
        pure next

type FormContext i s = Tuple s (s -> Maybe i)

formContext :: forall i s. s -> (s -> Maybe i) -> FormContext i s
formContext = Tuple

newtype Form p i s = Form (Reader (FormContext i s) (HH.HTML p i))

renderForm :: forall p i s. FormContext i s -> Form p i s -> HH.HTML p i
renderForm context (Form form) = runReader form context

field :: forall p i s. String -> Form p i s -> Form p i s
field label (Form form) = Form $ (\html -> HH.label_ [ HH.text label, html ]) <$> form

textInput :: forall p i s. Lens' s String -> Form p i s
textInput focus = Form do
  state <- asks $ view _1
  callback <- asks $ view _2
  pure $ HH.input [ HP.value $ state ^. focus, HE.onValueInput (callback <<< flip (set focus) state) ]