diff --git a/.gitignore b/.gitignore index bc15262..c527459 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ dist/* !dist/cn-tailwind.min.css !dist/storybook.css *.lock +*.swp diff --git a/bower.json b/bower.json index 8a949bb..39c4a12 100644 --- a/bower.json +++ b/bower.json @@ -19,17 +19,15 @@ "tests" ], "dependencies": { - "purescript-halogen": "^4.0.0", - "purescript-halogen-renderless": "^0.0.3", - "purescript-variant": "^5.0.0", - "purescript-heterogeneous": "^0.3.0", - "purescript-generics-rep": "^6.1.0" + "purescript-halogen": "^5.0.0-rc.6", + "purescript-variant": "^6.0.0", + "purescript-heterogeneous": "^0.4.0", + "purescript-generics-rep": "^6.1.0", + "purescript-profunctor-lenses": "^6.2.0" }, "devDependencies": { - "purescript-halogen-storybook": "^0.4.0", "purescript-debug": "^4.0.0", - "purescript-test-unit": "^14.0.0", - "purescript-read": "^1.0.1", - "purescript-halogen-select": "^2.0.0" + "purescript-halogen-select": "master", + "purescript-halogen-storybook": "master" } } diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..329c2e5 --- /dev/null +++ b/default.nix @@ -0,0 +1,10 @@ +{ nixpkgs ? import {} }: + +nixpkgs.stdenv.mkDerivation { + name = "env"; + buildInputs = [ + nixpkgs.nodejs + nixpkgs.yarn + nixpkgs.stack + ]; +} diff --git a/example/App/Home.purs b/example/App/Home.purs index 4d78e34..a84bc8e 100644 --- a/example/App/Home.purs +++ b/example/App/Home.purs @@ -2,7 +2,7 @@ module Example.App.Home where import Prelude -import Data.Maybe (Maybe(..)) +import Data.Const (Const) import Effect.Aff (Aff) import Example.App.UI.Element as UI import Halogen as H @@ -12,42 +12,28 @@ import Halogen.HTML.Properties as HP ----- -- Render -render :: H.ComponentHTML Box +render :: forall i p. HH.HTML i p render = UI.section_ - [ UI.h1_ [ HH.text "Formless" ] - , UI.h2_ [ HH.text "A renderless component for painless forms in Halogen" ] - , UI.content_ - [ UI.p_ $ - "Formless allows you to write a small, simple spec for your form and receive " - <> "state updates, validation, dirty states, submission handling, and more for " - <> "free. You are responsible for providing an initial value and a validation " - <> "function for every field in your form, but beyond that, Formless will take " - <> "care of things behind the scenes without ever imposing on how you'd like to " - <> "render and display your form. You can freely use external Halogen components, " - <> "add new form behaviors on top (like dependent validation or clearing sets of " - <> "fields), and more." - <> "\n" - , UI.a - [ HP.href "https://github.com/thomashoneyman/purescript-halogen-formless" ] - [ HH.text "purescript-halogen-formless" ] - ] + [ UI.h1_ [ HH.text "Formless" ] + , UI.h2_ [ HH.text "A renderless component for painless forms in Halogen" ] + , UI.content_ + [ UI.p_ + """ + Formless allows you to write a small, simple spec for your form and receive state updates, validation, dirty states, submission handling, and more for free. You are responsible for providing an initial value and a validation function for every field in your form, but beyond that, Formless will take care of things behind the scenes without ever imposing on how you'd like to render and display your form. You can freely use external Halogen components, add new form behaviors on top (like dependent validation or clearing sets of fields), and more. + """ + , UI.a + [ HP.href "https://github.com/thomashoneyman/purescript-halogen-formless" ] + [ HH.text "purescript-halogen-formless" ] + ] ] ------ -- Component -data Box a = Box a - -component :: H.Component HH.HTML Box Unit Void Aff -component = H.component +component :: H.Component HH.HTML (Const Void) Unit Void Aff +component = H.mkComponent { initialState: const unit , render: const render - , eval - , receiver: const Nothing + , eval: H.mkEval H.defaultEval } - where - - eval :: Box ~> H.ComponentDSL Unit Box Void Aff - eval (Box a) = pure a diff --git a/example/App/UI/Dropdown.purs b/example/App/UI/Dropdown.purs index 0447078..7ee0f22 100644 --- a/example/App/UI/Dropdown.purs +++ b/example/App/UI/Dropdown.purs @@ -3,132 +3,132 @@ module Example.App.UI.Dropdown where import Prelude import DOM.HTML.Indexed (HTMLbutton) -import Data.Array (difference, mapWithIndex) +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 (css) +import Example.App.UI.Element (class_) import Example.App.UI.Element as UI import Example.App.Validation (class ToText, toText) import Halogen as H import Halogen.HTML as HH -import Halogen.HTML.Events as HE import Select as Select -import Select.Utils.Setters as Setters +import Select.Setters as Setters -data Query item a - = HandleSelect (Select.Message (Query item) item) a - | Clear a +type Slot item = + H.Slot (Select.Query Query ()) (Message item) + +_dropdown = SProxy :: SProxy "dropdown" + +data Query a + = Clear a + +clear :: Select.Query Query () Unit +clear = Select.Query (H.tell Clear) type State item = - { selected :: Maybe item + ( selected :: Maybe item + , available :: Array item , items :: Array item , placeholder :: String - } + ) type Input item = { items :: Array item , placeholder :: String } +input :: forall item. Input item -> Select.Input (State item) +input { items, placeholder } = + { inputType: Select.Toggle + , search: Nothing + , debounceTime: Nothing + , getItemCount: length <<< _.items + , selected: Nothing + , available: items + , items + , placeholder + } + data Message item = Selected item | Cleared -type ChildSlot = Unit -type ChildQuery item = Select.Query (Query item) item - -component - :: ∀ item m - . MonadAff m +spec + :: forall item m i + . MonadAff m => ToText item => Eq item - => H.Component HH.HTML (Query item) (Input item) (Message item) m -component = - H.parentComponent - { initialState - , render - , eval - , receiver: const Nothing - } + => Select.Spec (State item) Query Void () i (Message item) m +spec = Select.defaultSpec + { render = render + , handleQuery = handleQuery + , handleEvent = handleEvent + } where + render st = + HH.div + [ if st.visibility == Select.On then class_ "dropdown is-active" else class_ "dropdown" ] + [ toggle [] st, menu st ] - initialState :: Input item -> State item - initialState { items, placeholder } = - { selected: Nothing - , items - , placeholder - } - - render :: State item -> H.ParentHTML (Query item) (ChildQuery item) ChildSlot m - render parentState = - HH.slot unit Select.component selectInput (HE.input HandleSelect) - where - selectInput = - { inputType: Select.Toggle - , items: parentState.items - , initialSearch: Nothing - , debounceTime: Nothing - , render: dropdown - } - - dropdown childState = - HH.div - [ if childState.visibility == Select.On then css "dropdown is-active" else css "dropdown" ] - [ toggle [] parentState - , menu childState - ] - - eval :: Query item ~> H.ParentDSL (State item) (Query item) (ChildQuery item) ChildSlot (Message item) m - eval = case _ of - Clear next -> do - st <- H.modify _ { selected = Nothing } - _ <- H.query unit $ Select.replaceItems st.items - pure next - - HandleSelect message next -> case message of - Select.Selected item -> do - st <- H.get - _ <- H.query unit $ Select.setVisibility Select.Off - _ <- H.query unit $ Select.replaceItems $ difference st.items [ item ] - H.modify_ _ { selected = Just item } + handleQuery :: forall a. Query a -> H.HalogenM _ _ _ _ _ (Maybe a) + handleQuery = case _ of + Clear a -> do + H.modify_ \st -> st { selected = Nothing, available = st.items } + H.raise Cleared + pure (Just a) + + handleEvent = case _ of + Select.Selected ix -> do + st <- H.get + let mbItem = st.available !! ix + for_ mbItem \item -> do + H.modify_ _ + { selected = Just item + , available = difference st.items [ item ] + , visibility = Select.Off + } H.raise (Selected item) - pure next - _ -> pure next + _ -> pure unit toggle - :: ∀ item q r + :: forall item act ps m r . ToText item - => Array (HH.IProp HTMLbutton (Select.Query q item Unit)) + => Array (HH.IProp HTMLbutton (Select.Action act)) -> { placeholder :: String, selected :: Maybe item | r } - -> Select.ComponentHTML q item -toggle props parentState = + -> H.ComponentHTML (Select.Action act) ps m +toggle props st = HH.div - [ css "dropdown-trigger" ] + [ class_ "dropdown-trigger" ] [ UI.button ( Setters.setToggleProps props ) - [ HH.text $ fromMaybe parentState.placeholder (toText <$> parentState.selected) ] + [ HH.text $ fromMaybe st.placeholder (toText <$> st.selected) ] ] menu - :: ∀ item q + :: forall item st act ps m . ToText item - => Select.State item - -> Select.ComponentHTML q item -menu selectState = + => Select.State (available :: Array item | st) + -> H.ComponentHTML (Select.Action act) ps m +menu st = HH.div - [ css "dropdown-menu" ] - [ if selectState.visibility == Select.Off then HH.text "" else + [ class_ "dropdown-menu" ] + [ if st.visibility == Select.Off then HH.text "" else HH.div - ( Setters.setContainerProps [ css "dropdown-content" ] ) - ( mapWithIndex (\ix item -> - HH.span - ( Setters.setItemProps ix - $ case Just ix == selectState.highlightedIndex of - true -> [ css "dropdown-item has-background-link has-text-white-bis" ] - _ -> [ css "dropdown-item" ] - ) - [ HH.text (toText item) ] + (Setters.setContainerProps [ class_ "dropdown-content" ]) + (mapWithIndex + (\ix item -> + HH.span + (Setters.setItemProps ix case Just ix == st.highlightedIndex of + true -> + [ class_ "dropdown-item has-background-link has-text-white-bis" ] + _ -> + [ class_ "dropdown-item" ] + ) + [ HH.text (toText item) ] ) - selectState.items - ) + st.available + ) ] + diff --git a/example/App/UI/Element.purs b/example/App/UI/Element.purs index ba2fc32..7f4610d 100644 --- a/example/App/UI/Element.purs +++ b/example/App/UI/Element.purs @@ -5,7 +5,7 @@ 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) +import Data.Maybe (Maybe(..), maybe) import Data.Newtype (class Newtype) import Data.Symbol (class IsSymbol, SProxy(..)) import Data.Variant (Variant) @@ -23,96 +23,94 @@ import Web.UIEvent.FocusEvent (FocusEvent) type Plain i p = Array (HH.HTML i p) -> HH.HTML i p -css :: ∀ r t. String -> HH.IProp ( "class" :: String | r ) t -css = HP.class_ <<< HH.ClassName +class_ :: forall r t. String -> HH.IProp ( "class" :: String | r ) t +class_ = HP.class_ <<< HH.ClassName ---------- -- Typography -h1_ :: ∀ i p. Plain i p -h1_ = HH.h1 [ css "title" ] +h1_ :: forall i p. Plain i p +h1_ = HH.h1 [ class_ "title" ] -h2_ :: ∀ i p. Plain i p -h2_ = HH.h2 [ css "subtitle is-size-4 has-text-grey" ] +h2_ :: forall i p. Plain i p +h2_ = HH.h2 [ class_ "subtitle is-size-4 has-text-grey" ] -p_ :: ∀ i p. String -> HH.HTML i p +p_ :: forall i p. String -> HH.HTML i p p_ str = HH.p_ [ HH.text str ] -a :: ∀ i p. Array (HH.IProp HTMLa p) -> Plain i p -a props = HH.a ([ css "has-text-blue" ] <> props) +a :: forall i p. Array (HH.IProp HTMLa p) -> Plain i p +a props = HH.a ([ class_ "has-text-blue" ] <> props) ---------- -- Layout -section_ :: ∀ i p. Plain i p +section_ :: forall i p. Plain i p section_ content = HH.section - [ css "section columns" ] - [ HH.div - [ css "column is-11-tablet is-three-fifths-desktop" ] - content - ] + [ class_ "section columns" ] + [ HH.div + [ class_ "column is-11-tablet is-three-fifths-desktop" ] + content + ] -formContent_ :: ∀ i p. Plain i p +formContent_ :: forall i p. Plain i p formContent_ content = HH.div - [ css "content" ] - [ HH.div - [ css "column has-background-white-bis" ] - content - ] + [ class_ "content" ] + [ HH.div + [ class_ "column has-background-white-bis" ] + content + ] -content_ :: ∀ i p. Plain i p -content_ = HH.div [ css "content" ] +content_ :: forall i p. Plain i p +content_ = HH.div [ class_ "content" ] ---------- -- Buttons -button :: ∀ i p. Array (HH.IProp HTMLbutton p) -> Plain i p -button props = HH.button ([ css "button is-light" ] <> props) +button :: forall i p. Array (HH.IProp HTMLbutton p) -> Plain i p +button props = HH.button ([ class_ "button is-light" ] <> props) -buttonDark :: ∀ i p. Array (HH.IProp HTMLbutton p) -> Plain i p -buttonDark props = HH.button ([ css "button is-dark" ] <> props) +buttonDark :: forall i p. Array (HH.IProp HTMLbutton p) -> Plain i p +buttonDark props = HH.button ([ class_ "button is-dark" ] <> props) -buttonPrimary :: ∀ i p. Array (HH.IProp HTMLbutton p) -> Plain i p -buttonPrimary props = HH.button ([ css "button is-link" ] <> props) +buttonPrimary :: forall i p. Array (HH.IProp HTMLbutton p) -> Plain i p +buttonPrimary props = HH.button ([ class_ "button is-link" ] <> props) ---------- -- Form -grouped_ :: ∀ i p. Plain i p +grouped_ :: forall i p. Plain i p grouped_ array = HH.div - [ css "field is-grouped" ] - ( wrap <$> array ) - + [ class_ "field is-grouped" ] + ( wrap <$> array ) where - wrap x = HH.p [ css "control" ] [ x ] + wrap x = HH.p [ class_ "control" ] [ x ] -field :: ∀ i p. { label :: String, help :: Either String String } -> Plain i p +field :: forall i p. { label :: String, help :: Either String String } -> Plain i p field config contents = HH.div - [ css "field" ] - [ HH.div - [ css "label" ] - [ HH.text config.label ] - , HH.div - [ css "control" ] - contents - , case config.help of - Left str -> helpError_ str - Right str -> help_ str - ] + [ class_ "field" ] + [ HH.div + [ class_ "label" ] + [ HH.text config.label ] + , HH.div + [ class_ "control" ] + contents + , case config.help of + Left str -> helpError_ str + Right str -> help_ str + ] where - help_ str = HH.p [ css "help" ] [ HH.text str ] - helpError_ str = HH.p [ css "help is-danger" ] [ HH.text str ] - + help_ str = HH.p [ class_ "help" ] [ HH.text str ] + helpError_ str = HH.p [ class_ "help is-danger" ] [ HH.text str ] ---------- -- Formless -- Render a result as help text -resultToHelp :: ∀ t e. ToText e => String -> FormFieldResult e t -> Either String String +resultToHelp :: forall t e. ToText e => String -> FormFieldResult e t -> Either String String resultToHelp str = case _ of NotValidated -> Right str Validating -> Right "validating..." @@ -134,57 +132,59 @@ type FieldConfig sym = , sym :: SProxy sym } -input :: ∀ i p. FieldConfig' -> Array (HH.IProp HTMLinput p) -> HH.HTML i p +input :: forall i p. FieldConfig' -> Array (HH.IProp HTMLinput p) -> HH.HTML i p input config props = field { label: config.label, help: config.help } - [ HH.input - ( [ HP.type_ InputText - , either (const $ css "input is-danger") (const $ css "input") config.help + [ HH.input $ + [ HP.type_ InputText + , either (const $ class_ "input is-danger") (const $ class_ "input") config.help , HP.placeholder config.placeholder ] <> props - ) ] -textarea :: ∀ i p. FieldConfig' -> Array (HH.IProp HTMLtextarea p) -> HH.HTML i p +textarea :: forall i p. FieldConfig' -> Array (HH.IProp HTMLtextarea p) -> HH.HTML i p textarea config props = field { label: config.label, help: config.help } - [ HH.textarea - ( [ either (const $ css "textarea is-danger") (const $ css "textarea") config.help + [ HH.textarea $ + [ config.help # either + (const $ class_ "textarea is-danger") + (const $ class_ "textarea") , HP.placeholder config.placeholder ] <> props - ) ] -- Already ready to work with Formless formlessField - :: ∀ form sym e o t0 t1 m pq cq cs r fields inputs + :: forall form st act ps m sym e o t0 t1 r fields inputs . IsSymbol sym => ToText e - => Newtype (form Record F.FormField) (Record fields) + => Newtype (form Record F.FormField) { | fields } => Newtype (form Variant F.InputFunction) (Variant inputs) => Cons sym (F.FormField e String o) t0 fields => Cons sym (F.InputFunction e String o) t1 inputs - => ( FieldConfig' - -> Array ( HH.IProp - ( value :: String, onBlur :: FocusEvent, onInput :: Event | r) - ( F.Query pq cq cs form m Unit ) - ) - -> F.HTML pq cq cs form m + => (FieldConfig' + -> Array (HH.IProp + (value :: String, onBlur :: FocusEvent, onInput :: Event | r) + (F.Action form act) + ) + -> F.ComponentHTML form act ps m ) -> FieldConfig sym - -> F.State form m - -> F.HTML pq cq cs form m + -> F.PublicState form st + -> F.ComponentHTML form act ps m 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.modify (SProxy :: SProxy "help") (const help') - help' = maybe (Right config.help) (Left <<< toText) (F.getError config.sym state.form) + help' = + maybe (Right config.help) (Left <<< toText) (F.getError config.sym state.form) props = [ HP.value (F.getInput config.sym state.form) - , HE.onValueInput $ HE.input $ F.setValidate config.sym + , HE.onValueInput (Just <<< F.setValidate config.sym) ] + diff --git a/example/App/UI/Typeahead.purs b/example/App/UI/Typeahead.purs index 4d1f554..4b1e15d 100644 --- a/example/App/UI/Typeahead.purs +++ b/example/App/UI/Typeahead.purs @@ -2,183 +2,213 @@ module Example.App.UI.Typeahead where import Prelude -import Data.Array (difference, filter, length, (:)) +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 (css) +import Example.App.UI.Element (class_) import Example.App.Validation (class ToText, toText) 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.Utils.Setters as Setters +import Select.Setters as Setters + +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" data Query item a - = HandleSelect (Select.Message (Query item) item) a - | GetItems (Array item -> a) - | Remove item a + = GetAvailableItems (Array item -> a) | Clear a +getAvailableItems :: forall item a. (Array item -> a) -> Select.Query (Query item) () a +getAvailableItems = Select.Query <<< GetAvailableItems + +clear :: forall item. Select.Query (Query item) () Unit +clear = Select.Query (Clear unit) + +data Action item + = Remove item + +remove :: forall item. item -> Select.Action (Action item) +remove = Select.Action <<< Remove + type State f item = - { items :: Array item + ( items :: Array item + , available :: Array item , selected :: f item , placeholder :: String - } + ) type Input item = { items :: Array item , placeholder :: String } +input :: forall f item. Monoid (f item) => Input item -> Select.Input (State f item) +input { items, placeholder } = + { inputType: Select.Text + , search: Nothing + , debounceTime: Nothing + , getItemCount: length <<< _.items + , selected: mempty + , available: items + , items + , placeholder + } + data Message f item = SelectionsChanged (f item) -type ChildSlot = Unit -type ChildQuery item = Select.Query (Query item) item - ---------- -- Premade single - :: ∀ item m + :: ∀ item i m . MonadAff m => ToText item => Eq item => Semigroup item - => H.Component HH.HTML (Query item) (Input item) (Message Maybe item) m -single = component' (const <<< Just) (const $ const Nothing) filter' render + => Select.Spec (State Maybe item) (Query item) (Action item) () i (Message Maybe item) m +single = spec' (\i av -> const (av !! i)) (const $ const Nothing) filter' render where filter' items Nothing = items filter' items (Just item) = filter (_ == item) items - render st selectState = case st.selected of + render st = case st.selected of Just item -> HH.div - [ if selectState.visibility == Select.On then css "dropdown is-active" else css "dropdown is-flex" ] - [ Dropdown.toggle [ HE.onClick $ Select.always $ Select.raise $ H.action $ Remove item ] st - , Dropdown.menu selectState - ] + [ if st.visibility == Select.On + then class_ "dropdown is-active" + else class_ "dropdown is-flex" ] + [ Dropdown.toggle + [ HE.onClick \_ -> Just $ remove item ] + st + , Dropdown.menu st + ] Nothing -> HH.div - [ if selectState.visibility == Select.On then css "dropdown is-flex is-active" else css "dropdown is-flex" ] - [ HH.input - ( Setters.setInputProps - [ HP.placeholder st.placeholder - , HP.value selectState.search - , css "input" - ] - ) - , Dropdown.menu selectState - ] - + [ if st.visibility == Select.On + then class_ "dropdown is-flex is-active" + else class_ "dropdown is-flex" ] + [ HH.input + ( Setters.setInputProps + [ HP.placeholder st.placeholder + , HP.value st.search + , class_ "input" + ] + ) + , Dropdown.menu st + ] multi - :: ∀ item m + :: ∀ item i m . MonadAff m => ToText item => Eq item - => H.Component HH.HTML (Query item) (Input item) (Message Array item) m -multi = component' ((:)) (filter <<< (/=)) difference render + => Select.Spec (State Array item) (Query item) (Action item) () i (Message Array item) m +multi = spec' selectByIndex (filter <<< (/=)) difference render where - render st selectState = + selectByIndex ix available selected = case available !! ix of + Nothing -> selected + Just item -> item : selected + + render st = HH.div_ - [ HH.div - [ if length st.selected > 0 then css "panel is-marginless" else css "panel is-hidden" ] - ( (\i -> + [ HH.div + [ if length st.selected > 0 + then class_ "panel is-marginless" + else class_ "panel is-hidden" + ] + (st.selected <#> \i -> HH.div - [ css "panel-block has-background-white" - , HE.onClick $ Select.always $ Select.raise $ H.action $ Remove i - ] - [ HH.text $ toText i ] - ) <$> st.selected - ) - , HH.div - [ if selectState.visibility == Select.On then css "dropdown is-flex is-active" else css "dropdown is-flex" ] - [ HH.input - ( Setters.setInputProps [ css "input", HP.placeholder st.placeholder, HP.value selectState.search ] ) - , Dropdown.menu selectState + [ class_ "panel-block has-background-white" + , HE.onClick \_ -> Just $ 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" + ] + [ HH.input + (Setters.setInputProps + [ class_ "input" + , HP.placeholder st.placeholder + , HP.value st.search + ] + ) + , Dropdown.menu st + ] ] - ] ---------- -- Base component -component' - :: ∀ item f m +spec' + :: ∀ item f i m . MonadAff m => Functor f => Monoid (f item) => ToText item => Eq item - => (item -> f item -> f item) + => (Int -> Array item -> f item -> f item) -> (item -> f item -> f item) -> (Array item -> f item -> Array item) - -> (State f item -> Select.State item -> Select.ComponentHTML (Query item) item) - -> H.Component HH.HTML (Query item) (Input item) (Message f item) m -component' select' remove' filter' render' = - H.parentComponent - { initialState - , render - , eval - , receiver: const Nothing - } + -> (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' + , handleEvent = handleEvent + , handleQuery = handleQuery + , handleAction = handleAction + } where + handleEvent = case _ of + Select.Searched string -> do + st <- H.get + let items = filter (String.contains (String.Pattern string) <<< toText) st.items + H.modify_ _ { available = filter' items st.selected } - initialState :: Input item -> State f item - initialState { items, placeholder } = - { items - , placeholder - , selected: mempty - } - - render :: State f item -> H.ParentHTML (Query item) (ChildQuery item) ChildSlot m - render st = - HH.slot unit Select.component selectInput (HE.input HandleSelect) - - where - - selectInput = - { inputType: Select.TextInput - , items: st.items - , initialSearch: Nothing - , debounceTime: Nothing - , render: render' st - } - - eval :: Query item ~> H.ParentDSL (State f item) (Query item) (ChildQuery item) ChildSlot (Message f item) m - eval = case _ of - Clear next -> do - st <- H.modify _ { selected = mempty :: f item } - _ <- H.query unit $ Select.replaceItems st.items + Select.Selected ix -> do + st <- H.get + let selected' = select' ix st.available st.selected + H.modify_ _ + { selected = selected' + , available = filter' st.available selected' + , visibility = Select.Off + } + H.raise $ SelectionsChanged selected' + + _ -> pure unit + + handleQuery :: forall a. Query item a -> H.HalogenM _ _ _ _ _ (Maybe a) + handleQuery = case _ of + Clear a -> do + st <- H.modify \st -> st { selected = mempty :: f item, available = st.items, search = "" } H.raise (SelectionsChanged st.selected) - pure next + pure (Just a) - Remove item next -> do - st <- H.modify \st -> st { selected = remove' item st.selected } - _ <- H.query unit $ Select.replaceItems $ filter' st.items st.selected - H.raise (SelectionsChanged st.selected) - pure next + GetAvailableItems f -> do + st <- H.get + pure $ Just $ f st.available - GetItems f -> do + handleAction = case _ of + Remove item -> do st <- H.get - pure $ f st.items - - HandleSelect message next -> case message of - Select.Emit q -> eval q $> next - Select.Searched string -> do - st <- H.get - let items = filter (String.contains (String.Pattern string) <<< toText) st.items - _ <- H.query unit $ Select.replaceItems $ filter' items st.selected - pure next - - Select.Selected item -> do - st <- H.modify \st -> st { selected = select' item st.selected } - _ <- H.query unit $ Select.setVisibility Select.Off - _ <- H.query unit $ Select.replaceItems $ filter' st.items st.selected - H.raise (SelectionsChanged st.selected) - pure next - - _ -> pure next + let selected' = remove' item st.selected + H.modify_ _ + { selected = selected' + , available = filter' st.items selected' + } + H.raise (SelectionsChanged selected') diff --git a/example/App/Validation.purs b/example/App/Validation.purs index 8ecfcec..f958d47 100644 --- a/example/App/Validation.purs +++ b/example/App/Validation.purs @@ -110,13 +110,13 @@ emailIsUsed = Validation \_ e@(Email e') -> do -- Perhaps we hit the server to if the email is in use _ <- liftAff $ delay $ Milliseconds 1000.0 pure $ if (contains (Pattern "t") e') - then pure e - else Left EmailInUse + then Left EmailInUse + else pure e enoughMoney :: ∀ form m. MonadAff m => Validation form m FieldError Int Int enoughMoney = Validation \_ i -> do -- Let's check if we have enough money... _ <- liftAff $ delay $ Milliseconds 5000.0 pure $ if (i > 1000) - then pure i - else Left NotEnoughMoney \ No newline at end of file + then Left NotEnoughMoney + else pure i \ No newline at end of file diff --git a/example/Main.purs b/example/Main.purs index 5993148..3b46e51 100644 --- a/example/Main.purs +++ b/example/Main.purs @@ -8,10 +8,10 @@ import Effect (Effect) import Effect.Aff (Aff) import Example.Basic.Component as Basic import Example.Async.Component as Async -import Example.Nested.Component as Nested -import Example.ExternalComponents.Component as ExternalComponents +import Example.Nested.Page as Nested +import Example.ExternalComponents.Page as ExternalComponents import Example.App.Home as Home -import Example.RealWorld.Component as RealWorld +import Example.RealWorld.Page as RealWorld import Foreign.Object as Object import Halogen.Aff as HA import Halogen.HTML (text) as HH diff --git a/example/async/Component.purs b/example/async/Component.purs index 3fb051e..3f9dae2 100644 --- a/example/async/Component.purs +++ b/example/async/Component.purs @@ -2,10 +2,10 @@ module Example.Async.Component where import Prelude +import Data.Const (Const) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) import Effect.Aff (Aff, Milliseconds(..)) -import Effect.Aff.Class (class MonadAff) import Effect.Console (logShow) import Example.App.UI.Element as UI import Example.App.Validation as V @@ -15,46 +15,11 @@ import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP -data Query a = Formless (F.Message' Form) a - -type ChildQuery = F.Query' Form Aff -type ChildSlot = Unit - -component :: H.Component HH.HTML Query Unit Void Aff -component = H.parentComponent - { initialState: const unit - , render - , eval - , receiver: const Nothing +type BankUser = + { name :: String + , email :: V.Email + , balance :: Int } - where - - render :: Unit -> H.ParentHTML Query ChildQuery ChildSlot Aff - render _ = - UI.section_ - [ UI.h1_ [ HH.text "Formless" ] - , UI.h2_ [ HH.text "A form with debounced async fields." ] - , UI.p_ $ - "If you have fields with expensive validation, you can debounce modifications to the field " - <> "with the async versions of setValidate and modifyValidate query functions. The result " - <> "type of the form field lets you know whether the field has not been validated, is " - <> "currently validating, or has produced an error or result." - , HH.br_ - , HH.slot unit F.component { initialInputs, validators, render: renderForm } (HE.input Formless) - ] - - eval :: Query ~> H.ParentDSL Unit Query ChildQuery ChildSlot Void Aff - eval (Formless (F.Submitted formOutputs) a) = a <$ do - let result = F.unwrapOutputFields formOutputs - H.liftEffect $ logShow result - - -- In this example we can ignore other outputs, but see the other examples for more - -- in-depth usage. - eval (Formless _ a) = pure a - ----------- --- FORM SPEC ------------ newtype Form r f = Form (r (FormRow f)) derive instance newtypeForm :: Newtype (Form r f) _ @@ -65,53 +30,75 @@ type FormRow f = , balance :: f V.FieldError String Int ) --- | You'll usually want symbol proxies for convenience -prx :: F.SProxies Form -prx = F.mkSProxies $ F.FormProxy :: F.FormProxy Form - --- | You can generate your initial inputs -initialInputs :: Form Record F.InputField -initialInputs = F.mkInputFields $ F.FormProxy :: F.FormProxy Form +data Action = HandleForm BankUser -validators :: ∀ m. MonadAff m => Form Record (F.Validation Form m) -validators = Form - { name: V.minLength 5 - , email: V.emailFormat >>> V.emailIsUsed - , balance: V.strIsInt >>> V.enoughMoney +component :: H.Component HH.HTML (Const Void) Unit Void Aff +component = H.mkComponent + { initialState: const unit + , render + , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } } + where + handleAction = case _ of + HandleForm bankUser -> H.liftEffect $ logShow (bankUser :: BankUser) ----------- --- RENDER ----------- - -renderForm :: F.State Form Aff -> F.HTML' Form Aff -renderForm { form } = - UI.formContent_ - [ UI.input - { label: "Name" - , help: UI.resultToHelp "Write your name" $ F.getResult prx.name form - , placeholder: "Frank Ocean" - } - [ HP.value $ F.getInput prx.name form - , HE.onValueInput $ HE.input $ F.setValidate prx.name - ] - , UI.input - { label: "Email" - , help: UI.resultToHelp "Provide your email address" $ F.getResult prx.email form - , placeholder: "john@hamm.com" - } - [ HP.value $ F.getInput prx.email form - , HE.onValueInput $ HE.input $ F.asyncSetValidate (Milliseconds 300.0) prx.email + render _ = + UI.section_ + [ UI.h1_ [ HH.text "Formless" ] + , UI.h2_ [ HH.text "A form with debounced async fields." ] + , UI.p_ + """ + If you have fields with expensive validation, you can debounce modifications to the field with the async versions of setValidate and modifyValidate query functions. The result type of the form field lets you know whether the field has not been validated, is currently validating, or has produced an error or result. + """ + , HH.br_ + , HH.slot F._formless unit formComponent unit (Just <<< HandleForm) ] - , UI.input - { label: "Donation" - , help: UI.resultToHelp "How many dollas do you want to spend?" $ F.getResult prx.balance form - , placeholder: "1000" + + formComponent :: F.Component Form (Const Void) () Unit BankUser Aff + formComponent = F.component (const formInput) $ F.defaultSpec { render = renderForm, handleEvent = F.raiseResult } + where + formInput = + { validators: Form + { name: V.minLength 5 + , email: V.emailFormat >>> V.emailIsUsed + , balance: V.strIsInt >>> V.enoughMoney + } + , initialInputs: Nothing } - [ HP.value $ F.getInput prx.balance form - , HE.onValueInput $ HE.input $ F.asyncSetValidate (Milliseconds 500.0) prx.balance - ] - , UI.buttonPrimary - [ HE.onClick $ HE.input_ F.submit ] - [ HH.text "Submit" ] - ] \ No newline at end of file + + renderForm { form } = + UI.formContent_ + [ UI.input + { label: "Name" + , help: UI.resultToHelp "Write your name" $ F.getResult prx.name form + , placeholder: "Frank Ocean" + } + [ HP.value $ F.getInput prx.name form + , HE.onValueInput (Just <<< F.setValidate prx.name) + ] + , UI.input + { label: "Email" + , help: F.getResult prx.email form # UI.resultToHelp + "Provide your email address" + , placeholder: "john@hamm.com" + } + [ HP.value $ F.getInput prx.email form + , HE.onValueInput $ + Just <<< F.asyncSetValidate (Milliseconds 300.0) prx.email + ] + , UI.input + { label: "Donation" + , help: F.getResult prx.balance form # UI.resultToHelp + "How many dollas do you want to spend?" + , placeholder: "1000" + } + [ HP.value $ F.getInput prx.balance form + , HE.onValueInput $ + Just <<< F.asyncSetValidate (Milliseconds 500.0) prx.balance + ] + , UI.buttonPrimary + [ HE.onClick \_ -> Just F.submit ] + [ HH.text "Submit" ] + ] + where + prx = F.mkSProxies (F.FormProxy :: _ Form) diff --git a/example/basic/Component.purs b/example/basic/Component.purs index 91bf24b..90f4d17 100644 --- a/example/basic/Component.purs +++ b/example/basic/Component.purs @@ -2,6 +2,7 @@ module Example.Basic.Component where import Prelude +import Data.Const (Const) import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) @@ -16,48 +17,6 @@ import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP -data Query a = Formless (F.Message' ContactForm) a - -type ChildQuery = F.Query' ContactForm Aff -type ChildSlot = Unit - -component :: H.Component HH.HTML Query Unit Void Aff -component = H.parentComponent - { initialState: const unit - , render - , eval - , receiver: const Nothing - } - where - - render :: Unit -> H.ParentHTML Query ChildQuery ChildSlot Aff - render st = - UI.section_ - [ UI.h1_ [ HH.text "Formless" ] - , UI.h2_ [ HH.text "A basic contact form." ] - , UI.p_ $ - "You can create a full Halogen contact form like this in less than 100 lines of code with " - <> "Formless, most of which is simply Halogen boilerplate. The actual form spec and wiring " - <> "consists of less than 20 lines of code." - , HH.br_ - , HH.slot unit F.component { initialInputs, validators, render: renderFormless } (HE.input Formless) - ] - - eval :: Query ~> H.ParentDSL Unit Query ChildQuery ChildSlot Void Aff - eval (Formless (F.Submitted formOutputs) a) = a <$ do - -- To unwrap the OutputField newtypes on each field and the overall ContactForm newtype, - -- use the unwrapOutputFields helper. - let contact :: Contact - contact = F.unwrapOutputFields formOutputs - H.liftEffect $ logShow contact - - -- In this example we can ignore other outputs, but see the other examples for more - -- in-depth usage. - eval (Formless _ a) = pure a - ------ --- Formless - type Contact = { name :: String, text :: String } newtype ContactForm r f = ContactForm (r @@ -66,35 +25,60 @@ newtype ContactForm r f = ContactForm (r )) derive instance newtypeContactForm :: Newtype (ContactForm r f) _ -initialInputs :: ContactForm Record F.InputField -initialInputs = F.wrapInputFields { name: "", text: "" } - -validators :: ContactForm Record (F.Validation ContactForm Aff) -validators = ContactForm { name: V.minLength 5, text: F.hoistFn_ identity } +data Action = HandleContact Contact -renderFormless :: F.State ContactForm Aff -> F.HTML' ContactForm Aff -renderFormless state = - UI.formContent_ - [ UI.input - { label: "Name" - , help: UI.resultToHelp "Write your name" $ F.getResult _name state.form - , placeholder: "Dale" - } - [ HP.value $ F.getInput _name state.form - , HE.onValueInput $ HE.input $ F.setValidate _name - ] - , UI.textarea - { label: "Message" - , help: Right "Write us a message" - , placeholder: "We prefer nice messages, but have at it." - } - [ HP.value $ F.getInput _text state.form - , HE.onValueInput $ HE.input $ F.set _text - ] - , UI.buttonPrimary - [ HE.onClick $ HE.input_ F.submit ] - [ HH.text "Submit" ] - ] +component :: H.Component HH.HTML (Const Void) Unit Void Aff +component = H.mkComponent + { initialState: const unit + , render: const render + , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } + } where - _name = SProxy :: SProxy "name" - _text = SProxy :: SProxy "text" + handleAction = case _ of + HandleContact contact -> H.liftEffect $ logShow (contact :: Contact) + + render = + UI.section_ + [ UI.h1_ [ HH.text "Formless" ] + , UI.h2_ [ HH.text "A basic contact form." ] + , UI.p_ + """ + You can create a full Halogen contact form like this in less than 20 lines of Formless, excluding the render function. It's type-safe, supports complex types, has validation, and parses to the output type of your choice." + """ + , HH.br_ + , HH.slot F._formless unit formComponent unit (Just <<< HandleContact) + ] + + formComponent :: F.Component ContactForm (Const Void) () Unit Contact Aff + formComponent = F.component (const formInput) $ F.defaultSpec { render = renderFormless, handleEvent = F.raiseResult } + where + formInput = + { validators: ContactForm { name: V.minLength 5, text: F.noValidation } + , initialInputs: Nothing + } + + renderFormless st = + UI.formContent_ + [ UI.input + { label: "Name" + , help: UI.resultToHelp "Write your name" $ F.getResult _name st.form + , placeholder: "Dale" + } + [ HP.value $ F.getInput _name st.form + , HE.onValueInput (Just <<< F.setValidate _name) + ] + , UI.textarea + { label: "Message" + , help: Right "Write us a message" + , placeholder: "We prefer nice messages, but have at it." + } + [ HP.value $ F.getInput _text st.form + , HE.onValueInput (Just <<< F.set _text) + ] + , UI.buttonPrimary + [ HE.onClick \_ -> Just F.submit ] + [ HH.text "Submit" ] + ] + where + _name = SProxy :: SProxy "name" + _text = SProxy :: SProxy "text" diff --git a/example/external-components/Component.purs b/example/external-components/Component.purs deleted file mode 100644 index 9c65376..0000000 --- a/example/external-components/Component.purs +++ /dev/null @@ -1,81 +0,0 @@ -module Example.ExternalComponents.Component where - -import Prelude - -import Data.Maybe (Maybe(..), fromMaybe) -import Data.Symbol (SProxy(..)) -import Effect.Aff (Aff) -import Effect.Console as Console -import Example.App.UI.Element as UI -import Example.App.UI.Typeahead as TA -import Example.ExternalComponents.RenderForm (formless) -import Example.ExternalComponents.Spec (User, prx, initialInputs, validators) -import Example.ExternalComponents.Types (ChildQuery, ChildSlot, Query(..), Slot(..), State) -import Formless as F -import Halogen as H -import Halogen.HTML as HH -import Halogen.HTML.Events as HE -import Record (delete) - -component :: H.Component HH.HTML Query Unit Void Aff -component = - H.parentComponent - { initialState: const unit - , render - , eval - , receiver: const Nothing - } - where - - render :: State -> H.ParentHTML Query ChildQuery ChildSlot Aff - render st = - UI.section_ - [ UI.h1_ [ HH.text "Formless" ] - , UI.h2_ [ HH.text "A form leveraging external components and custom form actions." ] - , UI.p_ $ - "In Formless, you can freely leverage external components and embed them in the form. " - <> "This form shows how to use custom typeahead components built with Select from " - <> "CitizenNet. This form also demonstrates how you can manipulate forms in Formless. " - <> "Try selecting an email address, then a whiskey. You'll notice that changing your " - <> "whiskey selection also clears the selected email." - , HH.br_ - , UI.p_ $ - "Next, try opening the console. If you submit the form with invalid values, Formless will " - <> "show you your errors. If you submit a valid form, you'll see Formless just returns the " - <> "valid outputs for you to work with." - , HH.br_ - , HH.slot unit F.component { initialInputs, validators, render: formless } (HE.input Formless) - ] - - eval :: Query ~> H.ParentDSL State Query ChildQuery ChildSlot Void Aff - eval = case _ of - Formless m a -> a <$ case m of - F.Emit q -> eval q - F.Submitted formOutputs -> do - let user :: User - user = F.unwrapOutputFields formOutputs - H.liftEffect $ Console.logShow user - F.Changed fstate -> do - H.liftEffect $ Console.log $ show $ delete (SProxy :: SProxy "form") fstate - - Reset a -> a <$ do - x <- H.query unit $ F.send Email (H.request TA.GetItems) - -- If the reset succeeded, then print out the items. - H.liftEffect $ Console.logShow $ fromMaybe [] x - _ <- H.query unit $ F.send Email (H.action TA.Clear) - _ <- H.query unit $ F.send Whiskey (H.action TA.Clear) - _ <- H.query unit $ F.send Language (H.action TA.Clear) - H.query unit F.resetAll_ - - Typeahead slot (TA.SelectionsChanged new) a -> case slot of - Email -> a <$ do - H.query unit $ F.setValidate_ prx.email new - - Whiskey -> a <$ do - _ <- H.query unit $ F.setValidate_ prx.whiskey new - -- We'll clear the email field when a new whiskey is selected - _ <- H.query unit $ F.reset_ prx.email - H.query unit $ F.send Email (H.action TA.Clear) - - Language -> a <$ do - H.query unit $ F.setValidate_ prx.language new diff --git a/example/external-components/Form.purs b/example/external-components/Form.purs new file mode 100644 index 0000000..b39c6c0 --- /dev/null +++ b/example/external-components/Form.purs @@ -0,0 +1,205 @@ +module Example.ExternalComponents.Form where + +import Prelude + +import Data.Const (Const) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Newtype (class Newtype) +import Data.Symbol (SProxy(..)) +import Effect.Aff (Aff) +import Effect.Class.Console (logShow) +import Example.App.UI.Element as UI +import Example.App.UI.Typeahead as TA +import Example.App.Validation as V +import Formless as F +import Halogen as H +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP +import Record (delete) +import Select as Select + +-- Form spec + +-- equivalent to { name :: String, email :: V.Email, ... } +type User = { | UserFormRow F.OutputType } + +newtype UserForm r f = UserForm (r (UserFormRow f)) +derive instance newtypeUserForm' :: Newtype (UserForm r f) _ + +type UserFormRow f = + ( name :: f V.FieldError String String + , email :: f V.FieldError (Maybe String) V.Email + , whiskey :: f V.FieldError (Maybe String) String + , language :: f V.FieldError (Maybe String) String + ) + + +-- Form component types + +data Action + = HandleTypeahead Typeahead (TA.Message Maybe String) + | Reset + + +-- Form child component types + +type ChildSlots = + ( typeahead :: TA.Slot Maybe String Typeahead ) + +data Typeahead + = Email + | Whiskey + | Language + +derive instance eqTypeahead :: Eq Typeahead +derive instance ordTypeahead :: Ord Typeahead + +-- Component spec + +component :: F.Component UserForm (Const Void) ChildSlots Unit User Aff +component = F.component (const defaultInput) $ F.defaultSpec + { render = render + , handleAction = handleAction + , handleEvent = handleEvent + } + where + defaultInput :: F.Input' UserForm Aff + defaultInput = + { validators: UserForm + { name: V.minLength 7 + , email: V.exists >>> V.emailFormat + , whiskey: V.exists + , language: V.exists + } + , initialInputs: Nothing + } + + handleEvent = case _ of + F.Submitted outputs -> H.raise (F.unwrapOutputFields outputs) + F.Changed formState -> logShow $ delete (SProxy :: _ "form") formState + + prx = F.mkSProxies (F.FormProxy :: _ UserForm) + + handleAction = case _ of + HandleTypeahead slot (TA.SelectionsChanged new) -> case slot of + Email -> + eval $ F.setValidate prx.email new + + Whiskey -> do + eval $ F.setValidate prx.whiskey new + eval $ F.reset prx.email + void $ H.query TA._typeahead Email TA.clear + + Language -> do + eval $ F.setValidate prx.language new + + Reset -> do + items <- H.query TA._typeahead Email $ H.request TA.getAvailableItems + logShow $ fromMaybe [] items + _ <- H.queryAll TA._typeahead TA.clear + eval F.resetAll + + where + -- you will usually want to define this pre-applied function if you + -- are recursively evaluating Formless actions. + eval act = F.handleAction handleAction handleEvent act + + render :: F.PublicState UserForm () -> F.ComponentHTML UserForm Action ChildSlots Aff + render st = + UI.formContent_ + [ name + , email + , whiskey + , language + , UI.p_ + """ + You can only attempt to submit this form if it is valid and not already being submitted. You can only attempt to reset the form if it has changed from its initial state. + """ + , HH.br_ + , UI.grouped_ + [ UI.buttonPrimary + [ if st.submitting || st.validity /= F.Valid + then HP.disabled true + else HE.onClick \_ -> Just F.submit + ] + [ HH.text "Submit" ] + , UI.button + [ if not st.dirty + then HP.disabled true + else HE.onClick \_ -> Just $ F.injAction Reset + ] + [ HH.text "Reset" ] + ] + ] + where + name = st # UI.formlessField UI.input + { label: "Name" + , help: "Write your name" + , placeholder: "Dale" + , sym: prx.name + } + + email = UI.field + { label: "Email" + , help: F.getResult prx.email st.form # UI.resultToHelp "Choose an email" + } + [ singleTypeahead Email + { placeholder: "me@you.com" + , items: + [ "not@anemail.org" + , "snail@utopia.snailutopia" + , "blue@jordans@blordens.pordens" + , "yea_that_won't_work@email.com" + , "standard@email.com" + ] + } + ] + + whiskey = UI.field + { label: "Whiskey" + , help: F.getResult prx.whiskey st.form # UI.resultToHelp + "Select a favorite whiskey" + } + [ singleTypeahead Whiskey + { placeholder: "Lagavulin 12" + , items: + [ "Lagavulin 16" + , "Kilchoman Blue Label" + , "Laphroaig" + , "Ardbeg" + ] + } + ] + + language = UI.field + { label: "Language" + , help: F.getResult prx.language st.form # UI.resultToHelp + "Choose your favorite programming language" + } + [ singleTypeahead Language + { placeholder: "Haskell" + , items: + [ "Rust" + , "Python" + , "Blodwen" + , "Hackett" + , "PHP" + , "PureScript" + , "JavaScript" + , "C" + , "C++" + , "TLA+" + , "F#" + , "F*" + , "Agda" + , "Ruby" + , "APL" + ] + } + ] + + singleTypeahead slot input = + HH.slot TA._typeahead slot (Select.component TA.input TA.single) input handler + where + handler = Just <<< F.injAction <<< HandleTypeahead slot diff --git a/example/external-components/Page.purs b/example/external-components/Page.purs new file mode 100644 index 0000000..17511c9 --- /dev/null +++ b/example/external-components/Page.purs @@ -0,0 +1,44 @@ +module Example.ExternalComponents.Page where + +import Prelude + +import Data.Const (Const) +import Data.Maybe (Maybe(..)) +import Effect.Aff (Aff) +import Effect.Class.Console (logShow) +import Example.App.UI.Element as UI +import Example.ExternalComponents.Form (ChildSlots, User, UserForm) +import Example.ExternalComponents.Form as Form +import Formless as F +import Halogen as H +import Halogen.HTML as HH + +data Action + = HandleFormless User + +type ChildSlot = + ( formless :: F.Slot UserForm (Const Void) ChildSlots User Unit ) + +component :: H.Component HH.HTML (Const Void) Unit Void Aff +component = H.mkComponent + { initialState: const unit + , render + , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } + } + where + handleAction = case _ of + HandleFormless user -> logShow (user :: User) + + render st = + UI.section_ + [ UI.h1_ [ HH.text "Formless" ] + , UI.h2_ [ HH.text "A form leveraging external components and custom form actions." ] + , UI.p_ + """ + In Formless, you can freely leverage external components and embed them in the form. This form shows how to use custom typeahead components built with Select from CitizenNet. This form also demonstrates how you can manipulate forms in Formless. Try selecting an email address, then a whiskey. You'll notice that changing your whiskey selection also clears the selected email. + + Next, try opening the console. If you submit the form with invalid values, Formless will show you your errors. If you submit a valid form, you'll see Formless just returns the valid outputs for you to work with. + + """ + , HH.slot F._formless unit Form.component unit (Just <<< HandleFormless) + ] diff --git a/example/external-components/RenderForm.purs b/example/external-components/RenderForm.purs deleted file mode 100644 index a3f6652..0000000 --- a/example/external-components/RenderForm.purs +++ /dev/null @@ -1,115 +0,0 @@ -module Example.ExternalComponents.RenderForm where - -import Prelude - -import Effect.Aff (Aff) -import Example.App.UI.Element as UI -import Example.App.UI.Typeahead as TA -import Example.ExternalComponents.Spec (UserForm, prx) -import Example.ExternalComponents.Types (Query(..), Slot(..)) -import Formless as F -import Halogen as H -import Halogen.HTML as HH -import Halogen.HTML.Events as HE -import Halogen.HTML.Properties as HP - -formless :: F.State UserForm Aff -> F.HTML Query (TA.Query String) Slot UserForm Aff -formless state = - UI.formContent_ - [ UI.formlessField - UI.input - { label: "Name" - , help: "Write your name" - , placeholder: "Dale" - , sym: prx.name - } state - , email state - , whiskey state - , language state - , UI.p_ $ - "You can only attempt to submit this form if it is valid " - <> "and not already being submitted. You can only attempt " - <> "to reset the form if it has been changed from its initial " - <> "state." - , HH.br_ - , UI.grouped_ - [ UI.buttonPrimary - [ if state.submitting || state.validity /= F.Valid - then HP.disabled true - else HE.onClick $ HE.input_ F.submit - ] - [ HH.text "Submit" ] - , UI.button - [ if not state.dirty - then HP.disabled true - else HE.onClick $ HE.input_ $ F.Raise $ H.action Reset - ] - [ HH.text "Reset" ] - ] - ] - ----------- --- Helpers - -email :: F.State UserForm Aff -> F.HTML Query (TA.Query String) Slot UserForm Aff -email state = - UI.field - { label: "Email" - , help: UI.resultToHelp "Choose an email address -- carefully." (F.getResult prx.email state.form) - } - [ HH.slot Email TA.single - { placeholder: "me@you.com" - , items: - [ "not@anemail.org" - , "snail@utopia.snailutopia" - , "blue@jordans@blordans.pordens" - , "yea_that_won't_work@email.com" - , "standard@email.com" - ] - } - ( HE.input $ F.Raise <<< H.action <<< Typeahead Email ) - ] - -whiskey :: F.State UserForm Aff -> F.HTML Query (TA.Query String) Slot UserForm Aff -whiskey state = - UI.field - { label: "Whiskey" - , help: UI.resultToHelp "Select a favorite whiskey" (F.getResult prx.whiskey state.form) - } - [ HH.slot Whiskey TA.single - { placeholder: "Lagavulin 12" - , items: - [ "Lagavulin 16" - , "Kilchoman Blue Label" - , "Laphroaig" - , "Ardbeg" - ] - } - ( HE.input $ F.Raise <<< H.action <<< Typeahead Whiskey ) - ] - -language :: F.State UserForm Aff -> F.HTML Query (TA.Query String) Slot UserForm Aff -language state = - UI.field - { label: "Language" - , help: UI.resultToHelp "Choose your favorite programming language." (F.getResult prx.language state.form) - } - [ HH.slot Language TA.single - { placeholder: "Haskell" - , items: - [ "Rust" - , "Python" - , "Haskell" - , "PureScript" - , "PHP" - , "JavaScript" - , "C" - , "C++" - , "C#" - , "C--" - , "Ruby" - , "APL" - ] - } - ( HE.input $ F.Raise <<< H.action <<< Typeahead Language ) - ] diff --git a/example/external-components/Spec.purs b/example/external-components/Spec.purs deleted file mode 100644 index aaf0a2c..0000000 --- a/example/external-components/Spec.purs +++ /dev/null @@ -1,39 +0,0 @@ -module Example.ExternalComponents.Spec where - -import Prelude - -import Data.Maybe (Maybe) -import Data.Newtype (class Newtype) -import Example.App.Validation as V -import Formless as F - --- We can easily reclaim our ideal User type by picking the --- parsed outputs from the FormRow like this: -type User = Record (UserFormRow F.OutputType) - -newtype UserForm r f = UserForm (r (UserFormRow f)) -derive instance newtypeUserForm' :: Newtype (UserForm r f) _ - -type UserFormRow f = - ( name :: f V.FieldError String String - , email :: f V.FieldError (Maybe String) V.Email - , whiskey :: f V.FieldError (Maybe String) String - , language :: f V.FieldError (Maybe String) String - ) - --- | You'll usually want symbol proxies for convenience -prx :: F.SProxies UserForm -prx = F.mkSProxies $ F.FormProxy :: F.FormProxy UserForm - --- | You can generate your initial inputs -initialInputs :: UserForm Record F.InputField -initialInputs = F.mkInputFields $ F.FormProxy :: F.FormProxy UserForm - -validators :: ∀ m. Monad m => UserForm Record (F.Validation UserForm m) -validators = UserForm - { name: V.minLength 7 - -- Unpacks the Maybe value, then checks the email format - , email: V.exists >>> V.emailFormat - , whiskey: V.exists - , language: V.exists - } diff --git a/example/external-components/Types.purs b/example/external-components/Types.purs deleted file mode 100644 index d5b0529..0000000 --- a/example/external-components/Types.purs +++ /dev/null @@ -1,29 +0,0 @@ -module Example.ExternalComponents.Types where - -import Prelude - -import Data.Maybe (Maybe) -import Effect.Aff (Aff) -import Example.App.UI.Typeahead as TA -import Example.ExternalComponents.Spec (UserForm) -import Formless as F - ----------- --- Component - -data Query a - = Formless (F.Message Query UserForm) a - | Typeahead Slot (TA.Message Maybe String) a - | Reset a - -type State = Unit - -type ChildQuery = F.Query Query (TA.Query String) Slot UserForm Aff -type ChildSlot = Unit - -data Slot - = Email - | Whiskey - | Language -derive instance eqSlot :: Eq Slot -derive instance ordSlot :: Ord Slot diff --git a/example/nested-array/Component.purs b/example/nested-array/Component.purs deleted file mode 100644 index 0fa91a2..0000000 --- a/example/nested-array/Component.purs +++ /dev/null @@ -1,238 +0,0 @@ -module Example.Nested.Component where - -import Prelude - -import Data.Array (filter, snoc) -import Data.Const (Const) -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) -import Data.Symbol (SProxy(..)) -import Data.Traversable (for, traverse) -import Effect.Aff (Aff) -import Effect.Console as Console -import Example.App.UI.Element as UI -import Example.App.Validation as V -import Formless as F -import Halogen as H -import Halogen.HTML as HH -import Halogen.HTML.Events as HE -import Halogen.HTML.Properties as HP - -data Query a - = HandleMemberForm Int (F.Message Query MemberForm) a - | HandleEventForm (F.Message Query EventForm) a - | AddMemberForm a - | RemoveMemberForm Int a - | SubmitAll a - -type CQ = F.Query Query EventCQ EventCS EventForm Aff -type CS = Unit - -type EventCQ = F.Query Query (Const Void) Void MemberForm Aff -type EventCS = Int - -type State = { formIds :: Array Int, nextId :: Int } - -component :: H.Component HH.HTML Query Unit Void Aff -component = H.parentComponent - { initialState: const { formIds: [], nextId: 1 } - , render - , eval - , receiver: const Nothing - } - where - - render :: State -> H.ParentHTML Query CQ CS Aff - render st = - UI.section_ - [ UI.h1_ [ HH.text "Formless" ] - , UI.h2_ [ HH.text "A form with a dynamic array of nested sub-forms." ] - , UI.p_ $ - "It is possible to nest sub-forms within Formless like any other external component. This " - <> "allows you to create an arbitrary number of forms within other forms while preserving the " - <> "type safety provided by the Formless library. Try submitting the form with no sub-forms, and " - <> "review the output in the console. Next, try adding one or more sub-forms and submitting them " - <> "when valid or invalid." - , HH.br_ - , HH.slot unit F.component - { initialInputs: F.wrapInputFields { name: "", location: "", members: Nothing } - , validators: eventFormValidation - , render: renderEventForm st - } - (HE.input HandleEventForm) - ] - - eval :: Query ~> H.ParentDSL State Query CQ CS Void Aff - eval = case _ of - - -- We only care about queries raised out of the components, but no messages - -- because we'll use `submitReply` later. - HandleEventForm (F.Emit q) a -> eval q *> pure a - HandleEventForm _ a -> pure a - - HandleMemberForm _ (F.Emit q) a -> eval q *> pure a - HandleMemberForm _ _ a -> pure a - - SubmitAll a -> do - st <- H.get - - -- First, we'll submit the member forms to set the top-level form - memberForms <- for st.formIds \id -> H.query unit $ F.send id F.submitReply - let members = (map <<< map) F.unwrapOutputFields $ traverse join memberForms - - -- Now, we'll use their outputs as the input to our top-level form component - _ <- H.query unit $ F.set_ (SProxy :: SProxy "members") members - - -- and submit that form, accepting its output - res <- H.query unit F.submitReply - - -- now we can review the results of submitting the form - case join res of - Nothing -> H.liftEffect $ Console.log "Forms are not valid" - Just r -> H.liftEffect do - Console.log "Valid!" - Console.logShow $ F.unwrapOutputFields r - - pure a - - AddMemberForm a -> do - H.modify_ \st -> st { nextId = st.nextId + 1, formIds = st.formIds `snoc` st.nextId } - pure a - - RemoveMemberForm i a -> do - H.modify_ \st -> st { formIds = filter (_ /= i) st.formIds } - pure a - ----------- --- Formless (Event Form) - -type Event = Record (EventRow F.OutputType) - -newtype EventForm r f = EventForm (r (EventRow f)) -derive instance newtypeEventForm :: Newtype (EventForm r f) _ - -type EventRow f = - ( name :: f V.FieldError String String - , location :: f V.FieldError String String - , members :: f V.FieldError (Maybe (Array MemberInfo)) (Array MemberInfo) - ) - -eventFormValidation :: EventForm Record (F.Validation EventForm Aff) -eventFormValidation = EventForm - { name: V.minLength 3 - , location: V.minLength 3 - , members: V.exists - } - -renderEventForm :: State -> F.State EventForm Aff -> F.HTML Query EventCQ EventCS EventForm Aff -renderEventForm st fs = - HH.div_ - ( [ HH.div - [ HP.class_ $ HH.ClassName "field is-grouped" ] - [ HH.div - [ HP.class_ $ HH.ClassName "control" ] - [ UI.button - [ HE.onClick $ HE.input_ $ F.raise $ H.action AddMemberForm ] - [ HH.text "Add Member Form" ] - ] - , HH.div - [ HP.class_ $ HH.ClassName "control" ] - [ UI.buttonPrimary - [ HE.onClick $ HE.input_ $ F.raise $ H.action SubmitAll ] - [ HH.text "Submit" ] - ] - ] - , UI.input - { label: "Event Name" - , help: UI.resultToHelp "Provide an event name" $ F.getResult _name fs.form - , placeholder: "My Event" - } - [ HP.value $ F.getInput _name fs.form - , HE.onValueInput $ HE.input $ F.setValidate _name - ] - , UI.input - { label: "Event Location" - , help: UI.resultToHelp "Provide an event location" $ F.getResult _location fs.form - , placeholder: "Los Angeles, CA" - } - [ HP.value $ F.getInput _location fs.form - , HE.onValueInput $ HE.input $ F.setValidate _location - ] - ] - <> map mkMemberForm st.formIds - ) - where - mkMemberForm :: Int -> F.HTML Query EventCQ EventCS EventForm Aff - mkMemberForm i = - HH.slot i F.component - { initialInputs: F.wrapInputFields { name: "", email: "", notes: "" } - , validators: memberFormValidation - , render: renderMemberForm i - } - (HE.input $ F.raise <<< H.action <<< HandleMemberForm i) - - _name = SProxy :: SProxy "name" - _location = SProxy :: SProxy "location" - - - ----------- --- Formless (Member Form) - -type MemberInfo = Record (MemberRow F.OutputType) - -newtype MemberForm r f = MemberForm (r (MemberRow f)) -derive instance newtypeMemberForm :: Newtype (MemberForm r f) _ - -type MemberRow f = - ( name :: f V.FieldError String String - , email :: f V.FieldError String V.Email - , notes :: f Void String String - ) - -memberFormValidation :: MemberForm Record (F.Validation MemberForm Aff) -memberFormValidation = MemberForm - { name: V.minLength 5 - , email: V.emailFormat >>> V.emailIsUsed - , notes: F.hoistFn_ identity - } - -renderMemberForm :: Int -> F.State MemberForm Aff -> F.HTML Query (Const Void) Void MemberForm Aff -renderMemberForm i fs = - UI.formContent_ - [ HH.div - [ HP.class_ $ HH.ClassName "field" ] - [ UI.buttonPrimary - [ HE.onClick $ HE.input_ $ F.raise $ H.action $ RemoveMemberForm i ] - [ HH.text "Remove Me" ] - ] - , UI.input - { label: "Member Name" - , help: UI.resultToHelp "Provide the registrant's name" $ F.getResult _name fs.form - , placeholder: "Dale Cooper" - } - [ HP.value $ F.getInput _name fs.form - , HE.onValueInput $ HE.input $ F.setValidate _name - ] - , UI.input - { label: "Member Email" - , help: UI.resultToHelp "Provide the registrant's email address" $ F.getResult _email fs.form - , placeholder: "dalecooper@fbi.gov" - } - [ HP.value $ F.getInput _email fs.form - , HE.onValueInput $ HE.input $ F.setValidate _email - ] - , UI.input - { label: "Additional Notes" - , help: Right "Provide any additional notes you'd like." - , placeholder: "Fond of Tibetan traditions" - } - [ HP.value $ F.getInput _notes fs.form - , HE.onValueInput $ HE.input $ F.set _notes - ] - ] - where - _name = SProxy :: SProxy "name" - _email = SProxy :: SProxy "email" - _notes = SProxy :: SProxy "notes" diff --git a/example/nested-array/Form.purs b/example/nested-array/Form.purs new file mode 100644 index 0000000..06ed824 --- /dev/null +++ b/example/nested-array/Form.purs @@ -0,0 +1,236 @@ +module Example.Nested.Form where + +import Prelude + +import Data.Array (filter, snoc, catMaybes) +import Data.Const (Const) +import Data.Either (Either(..)) +import Data.List (toUnfoldable) +import Data.Map as M +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Newtype (class Newtype) +import Data.Symbol (SProxy(..)) +import Effect.Aff (Aff) +import Example.App.UI.Element (class_) +import Example.App.UI.Element as UI +import Example.App.Validation as V +import Formless as F +import Halogen as H +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP + +----- +-- Event form + +-- Form types + +type Event = { | EventRow F.OutputType } + +newtype EventForm r f = EventForm (r (EventRow f)) +derive instance newtypeEventForm :: Newtype (EventForm r f) _ + +type EventRow f = + ( name :: f V.FieldError String String + , location :: f V.FieldError String String + , members :: f V.FieldError (Maybe (Array MemberInfo)) (Array MemberInfo) + ) + +-- Form component types + +type Slot = + H.Slot (F.Query EventForm (Const Void) ChildSlots) Event + +type State = + ( formIds :: Array Int + , nextId :: Int + ) + +data Action + = AddMemberForm + | SubmitAll + | HandleMemberForm Int MFMessage + +type ChildSlots = + ( memberForm :: MFSlot Int ) + +-- Form spec + +eventComponent :: F.Component EventForm (Const Void) ChildSlots Unit Event Aff +eventComponent = F.component (const eventFormInput) $ F.defaultSpec + { render = render + , handleAction = handleAction + , handleEvent = handleEvent + } + where + eventFormInput :: F.Input EventForm State Aff + eventFormInput = + { validators: EventForm + { name: V.minLength 3 + , location: V.minLength 3 + , members: F.hoistFn_ (fromMaybe []) + } + , initialInputs: Nothing + , formIds: [] + , nextId: 0 + } + + handleAction = case _ of + HandleMemberForm ix Destroy -> do + H.modify_ \st -> st { formIds = filter (_ /= ix) st.formIds } + eval $ F.set _members Nothing + + AddMemberForm -> + H.modify_ \st -> st + { nextId = st.nextId + 1, formIds = st.formIds `snoc` st.nextId } + + SubmitAll -> do + st <- H.get + res <- H.queryAll _memberForm $ H.request F.submitReply + case map F.unwrapOutputFields $ catMaybes $ toUnfoldable $ M.values res of + [] -> eval F.submit + members -> eval (F.set _members (Just members)) *> eval F.submit + + where + eval act = F.handleAction handleAction handleEvent act + _members = SProxy :: _ "members" + _memberForm = SProxy :: _ "memberForm" + + handleEvent = case _ of + F.Submitted outputs -> + H.raise (F.unwrapOutputFields outputs) + _ -> pure unit + + render st = + HH.div_ + [ HH.div + [ class_ "field is-grouped" ] + [ HH.div + [ class_ "control" ] + [ UI.button + [ HE.onClick \_ -> Just $ F.injAction AddMemberForm ] + [ HH.text "Add Member Form" ] + ] + , HH.div + [ class_ "control" ] + [ UI.buttonPrimary + [ HE.onClick \_ -> Just $ F.injAction SubmitAll ] + [ HH.text "Submit" ] + ] + ] + , UI.input + { label: "Event Name" + , help: F.getResult _name st.form # UI.resultToHelp + "Provide an event name" + , placeholder: "My Event" + } + [ HP.value $ F.getInput _name st.form + , HE.onValueInput $ Just <<< F.setValidate _name + ] + , UI.input + { label: "Event Location" + , help: F.getResult _location st.form # UI.resultToHelp + "Provide an event location" + , placeholder: "Los Angeles, CA" + } + [ HP.value $ F.getInput _location st.form + , HE.onValueInput $ Just <<< F.setValidate _location + ] + , HH.div_ + (mkMemberForm <$> st.formIds) + ] + where + mkMemberForm i = do + let handler = Just <<< F.injAction <<< HandleMemberForm i + HH.slot _memberForm i memberFormComponent unit handler + + _name = SProxy :: SProxy "name" + _location = SProxy :: SProxy "location" + _memberForm = SProxy :: SProxy "memberForm" + + +----- +-- Member form, nested inside +----- + +-- Form types + +type MemberInfo = { | MemberRow F.OutputType } + +newtype MemberForm r f = MemberForm (r (MemberRow f)) +derive instance newtypeMemberForm :: Newtype (MemberForm r f) _ + +type MemberRow f = + ( name :: f V.FieldError String String + , email :: f V.FieldError String V.Email + , notes :: f Void String String + ) + +-- Form component types + +type MFSlot = + H.Slot (F.Query' MemberForm) MFMessage + +data MFAction = RemoveMe +data MFMessage = Destroy + +-- Form spec + +memberFormComponent :: F.Component MemberForm (Const Void) () Unit MFMessage Aff +memberFormComponent = F.component (const memberFormInput) $ F.defaultSpec + { render = render + , handleAction = handleAction + } + where + memberFormInput :: F.Input' MemberForm Aff + memberFormInput = + { validators: MemberForm + { name: V.minLength 5 + , email: V.emailFormat >>> V.emailIsUsed + , notes: F.noValidation + } + , initialInputs: Nothing + } + + handleAction = case _ of + RemoveMe -> H.raise Destroy + + render st = + UI.formContent_ + [ HH.div + [ class_ "field" ] + [ UI.buttonPrimary + [ HE.onClick \_ -> Just $ F.injAction RemoveMe ] + [ HH.text "Remove Me" ] + ] + , UI.input + { label: "Member Name" + , help: F.getResult _name st.form # UI.resultToHelp + "Provide the registrant's name" + , placeholder: "Dale Cooper" + } + [ HP.value $ F.getInput _name st.form + , HE.onValueInput $ Just <<< F.setValidate _name + ] + , UI.input + { label: "Member Email" + , help: F.getResult _email st.form # UI.resultToHelp + "Provide the registrant's email address" + , placeholder: "dalecooper@fbi.gov" + } + [ HP.value $ F.getInput _email st.form + , HE.onValueInput $ Just <<< F.setValidate _email + ] + , UI.input + { label: "Additional Notes" + , help: Right "Provide any additional notes you'd like." + , placeholder: "Fond of Tibetan traditions" + } + [ HP.value $ F.getInput _notes st.form + , HE.onValueInput $ Just <<< F.set _notes + ] + ] + where + _name = SProxy :: SProxy "name" + _email = SProxy :: SProxy "email" + _notes = SProxy :: SProxy "notes" diff --git a/example/nested-array/Page.purs b/example/nested-array/Page.purs new file mode 100644 index 0000000..38d076d --- /dev/null +++ b/example/nested-array/Page.purs @@ -0,0 +1,44 @@ +module Example.Nested.Page where + +import Prelude + +import Data.Const (Const) +import Data.Maybe (Maybe(..)) +import Data.Symbol (SProxy(..)) +import Effect.Aff (Aff) +import Effect.Console as Console +import Example.App.UI.Element as UI +import Example.Nested.Form as Form +import Halogen as H +import Halogen.HTML as HH + +data Query a + = HandleEventForm Form.Event + +type ChildSlots = + ( eventForm :: Form.Slot Unit ) + +component :: H.Component HH.HTML (Const Void) Unit Void Aff +component = H.mkComponent + { initialState: const unit + , render + , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } + } + where + render st = + UI.section_ + [ UI.h1_ [ HH.text "Formless" ] + , UI.h2_ [ HH.text "A form with a dynamic array of nested sub-forms." ] + , UI.p_ + """ + It is possible to nest sub-forms within Formless like any other external component. This allows you to create an arbitrary number of forms within other forms while preserving the type safety provided by the Formless library. Try submitting the form with no sub-forms, and review the output in the console. Next, try adding one or more sub-forms and submitting them when valid or invalid. + """ + , HH.br_ + , HH.slot _event unit Form.eventComponent unit handler + ] + where + _event = SProxy :: _ "eventForm" + handler = Just <<< HandleEventForm + + handleAction = case _ of + HandleEventForm event -> H.liftEffect $ Console.logShow event diff --git a/example/real-world/Component.purs b/example/real-world/Component.purs deleted file mode 100644 index 0807b05..0000000 --- a/example/real-world/Component.purs +++ /dev/null @@ -1,205 +0,0 @@ -module Example.RealWorld.Component where - -import Prelude - -import Data.Maybe (Maybe(..)) -import Data.Newtype (over, unwrap) -import Data.Traversable (traverse) -import Effect.Aff (Aff) -import Effect.Console as Console -import Example.App.UI.Dropdown as DD -import Example.App.UI.Element (css) -import Example.App.UI.Element as UI -import Example.App.UI.Typeahead as TA -import Example.RealWorld.Data.Group as G -import Example.RealWorld.Data.Options as O -import Example.RealWorld.Render.GroupForm as GroupForm -import Example.RealWorld.Render.OptionsForm as OptionsForm -import Example.RealWorld.Spec.GroupForm (groupInputs, groupValidators, groupFormSubmit) -import Example.RealWorld.Spec.OptionsForm (optionsFormInputs, optionsFormValidators, defaultInputs) -import Example.RealWorld.Types (ChildQuery, ChildSlot, GroupTASlot(..), Query(..), State, Tab(..)) -import Formless as F -import Halogen as H -import Halogen.Component.ChildPath as CP -import Halogen.HTML as HH -import Halogen.HTML.Events as HE -import Halogen.HTML.Properties as HP - -component :: H.Component HH.HTML Query Unit Void Aff -component = - H.parentComponent - { initialState: const initialState - , render - , eval - , receiver: const Nothing - } - where - - initialState :: State - initialState = - { focus: GroupTab - , groupFormErrors: 0 - , groupFormDirty: false - , optionsFormErrors: 0 - , optionsFormDirty: false - , optionsEnabled: false - , group: Nothing - } - - render :: State -> H.ParentHTML Query ChildQuery ChildSlot Aff - render st = - UI.section_ - [ UI.h1_ [ HH.text "Formless" ] - , UI.h2_ [ HH.text "A complex form inspired by real-world use cases." ] - , UI.p_ $ - "This component demonstrates building a large form with complex rendering and validation " - <> "requirements. Notice how both tabs end up unifying to a single output type after the " - <> "two forms are combined, how various dropdowns determine the contents (and visibility) " - <> "of other form elements, the assorted external components, and how validation for many " - <> "fields depends on the values of other fields in the form." - , HH.br_ - , UI.p_ $ - "Next, review the source code. You'll notice that all of the complex types and state necessary " - <> "to run this form can be generated from a pair of row types. All that's left for you to handle " - <> "is to write the validation (with helper functions) and the render function." - , HH.br_ - , UI.grouped_ - [ UI.button - [ HE.onClick $ HE.input_ $ Select GroupTab ] - [ UI.p_ $ "Group Form" <> - if st.groupFormErrors > 0 - then " (" <> show st.groupFormErrors <> ")" - else "" - ] - , UI.button - [ HE.onClick $ HE.input_ $ Select OptionsTab ] - [ UI.p_ $ "Options Form" <> - if st.optionsFormErrors > 0 - then " (" <> show st.optionsFormErrors <> ")" - else "" - ] - , UI.buttonPrimary - [ HE.onClick $ HE.input_ Submit ] - [ HH.text "Submit Form" ] - , UI.button - [ if st.groupFormDirty || st.optionsFormDirty - then HE.onClick $ HE.input_ Reset - else HP.disabled true - ] - [ HH.text "Reset All" ] - ] - , HH.div - [ if st.focus == GroupTab then css "" else css "is-hidden" ] - [ HH.slot' CP.cp1 unit F.component - { initialInputs: groupInputs - , validators: groupValidators - , render: GroupForm.render - } (HE.input GroupForm) - ] - , HH.div - [ if st.focus == OptionsTab then css "" else css "is-hidden" ] - [ HH.slot' CP.cp2 unit F.component - { initialInputs: defaultInputs - , validators: optionsFormValidators - -- , submitter: pure <<< O.Options <<< F.unwrapOutputFields - , render: OptionsForm.render - } (HE.input OptionsForm) - ] - ] - - eval :: Query ~> H.ParentDSL State Query ChildQuery ChildSlot Void Aff - eval = case _ of - Select tab a -> do - H.modify_ _ { focus = tab } - pure a - - Reset a -> do - -- To send a query through to a child component when Formless has multiple, use send' - _ <- H.query' CP.cp1 unit $ F.send' CP.cp1 Applications (H.action TA.Clear) - _ <- H.query' CP.cp1 unit $ F.send' CP.cp1 Pixels (H.action TA.Clear) - _ <- H.query' CP.cp1 unit $ F.send' CP.cp2 unit (H.action TA.Clear) - _ <- H.query' CP.cp1 unit $ F.send' CP.cp3 unit (H.action DD.Clear) - -- If there is only one child type, use Send - _ <- H.query' CP.cp2 unit $ F.send unit (H.action DD.Clear) - _ <- H.query' CP.cp1 unit F.resetAll_ - _ <- H.query' CP.cp2 unit F.resetAll_ - pure a - - -- On submit, we need to make sure both forms are run. We - -- can use the `SubmitReply` query to have submission return - -- the result directly, rather than via independent messages. - Submit a -> do - mbGroupForm <- H.query' CP.cp1 unit $ H.request F.SubmitReply - mbOptionsForm <- H.query' CP.cp2 unit $ H.request F.SubmitReply - -- Here, we'll construct our new group from the two form outputs. - case mbGroupForm, mbOptionsForm of - Just g, Just o -> do - -- We can run our monadic submission function here - group :: Maybe G.Group <- traverse groupFormSubmit g - -- We can unwrap our options purely - let options :: Maybe O.Options - options = O.Options <<< F.unwrapOutputFields <$> o - H.modify_ _ { group = map (over G.Group (_ { options = options })) group } - _, _ -> H.liftEffect (Console.error "Forms did not validate.") - st <- H.get - H.liftEffect $ Console.log $ show st.group - pure a - - ----- - -- Group Form - - GroupForm m a -> case m of - F.Emit q -> eval q $> a - F.Submitted _ -> pure a - F.Changed fstate -> do - H.modify_ \st -> st { groupFormErrors = fstate.errors, groupFormDirty = fstate.dirty } - pure a - - TASingle (TA.SelectionsChanged new) a -> a <$ do - H.query' CP.cp1 unit $ F.setValidate_ G.prx.whiskey new - - TAMulti slot (TA.SelectionsChanged new) a -> a <$ case slot of - Applications -> - H.query' CP.cp1 unit $ F.setValidate_ G.prx.applications new - Pixels -> - H.query' CP.cp1 unit $ F.setValidate_ G.prx.pixels new - - AdminDropdown m a -> a <$ do - _ <- H.query' CP.cp1 unit $ F.reset_ G.prx.secretKey1 - _ <- H.query' CP.cp1 unit $ F.reset_ G.prx.secretKey2 - case m of - DD.Selected x -> do - H.query' CP.cp1 unit $ F.setValidate_ G.prx.admin (Just x) - DD.Cleared -> do - H.query' CP.cp1 unit $ F.setValidate_ G.prx.admin Nothing - - ----- - -- Options Form - - OptionsForm m a -> case m of - F.Emit q -> eval q $> a - F.Submitted _ -> pure a - F.Changed fstate -> do - st <- H.get - st' <- H.modify _ - { optionsFormErrors = fstate.errors - , optionsFormDirty = fstate.dirty - , optionsEnabled = F.getInput O.prx.enable fstate.form - } - - -- The generated spec will set enabled to false, but we'll want it to be true before - -- sending a new spec in to the component. - when (st.optionsEnabled /= st'.optionsEnabled) do - case st'.optionsEnabled of - true -> do - let spec' = O.OptionsForm $ _ { enable = F.InputField true } $ unwrap optionsFormInputs - void $ H.query' CP.cp2 unit $ F.loadForm_ spec' - _ -> do - void $ H.query' CP.cp2 unit $ F.loadForm_ defaultInputs - pure a - - MetricDropdown m a -> a <$ case m of - DD.Selected x -> do - H.query' CP.cp2 unit $ F.setValidate_ O.prx.metric (Just x) - DD.Cleared -> do - H.query' CP.cp2 unit $ F.setValidate_ O.prx.metric Nothing diff --git a/example/real-world/Data/Group.purs b/example/real-world/Data/Group.purs deleted file mode 100644 index 2f7f2b5..0000000 --- a/example/real-world/Data/Group.purs +++ /dev/null @@ -1,75 +0,0 @@ -module Example.RealWorld.Data.Group where - -import Prelude - -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) -import Data.Symbol (SProxy(..)) -import Example.App.Validation (class ToText, FieldError) -import Example.RealWorld.Data.Options (Options) -import Formless as F - ------ --- A custom ID type - -newtype GroupId = GroupId Int -derive instance newtypeFBGroupId :: Newtype GroupId _ -derive newtype instance eqGroupId :: Eq GroupId -derive newtype instance showGroupId :: Show GroupId - ------ --- A nested field type - -newtype Admin = Admin { id :: Maybe GroupId } -derive instance newtypeAdmin :: Newtype Admin _ -derive newtype instance eqAdmin :: Eq Admin -derive newtype instance showAdmin :: Show Admin - -instance toTextAdmin :: ToText Admin where - toText (Admin { id }) = case id of - Just (GroupId n) -> "Administrator " <> show n - Nothing -> "None" - ------ --- Our primary data type -type GroupRow f r = - ( name :: f FieldError String String - , admin :: f FieldError (Maybe Admin) Admin - , applications :: f FieldError (Array String) (Array String) - , pixels :: f FieldError (Array String) (Array String) - , whiskey :: f FieldError (Maybe String) String - | r - ) - --- | Here's the Group data type we'll use throughout our application. After we send --- | a form result off to the server, this is what we'll get in return. -newtype Group = Group - ( Record - ( GroupRow F.OutputType - ( id :: GroupId - , secretKey :: String - , options :: Maybe Options - ) - ) - ) -derive instance newtypeGroup :: Newtype Group _ -derive newtype instance eqGroup :: Eq Group -derive newtype instance showGroup :: Show Group - -_id = SProxy :: SProxy "id" -_secretKey = SProxy :: SProxy "secretKey" -_options = SProxy :: SProxy "options" - --- | Here's the Form type we'll use to run with Formless. -newtype GroupForm r f = GroupForm (r (GroupFormRow f)) -derive instance newtypeGroupForm :: Newtype (GroupForm r f) _ - -prx :: F.SProxies GroupForm -prx = F.mkSProxies $ F.FormProxy :: F.FormProxy GroupForm - --- | In order to generate our fields automatically using mkFormSpecFromRow, we'll make --- | sure to have the new row as a new type. -type GroupFormRow f = GroupRow f - ( secretKey1 :: f FieldError String String - , secretKey2 :: f FieldError String String - ) diff --git a/example/real-world/Data/Options.purs b/example/real-world/Data/Options.purs deleted file mode 100644 index 8595170..0000000 --- a/example/real-world/Data/Options.purs +++ /dev/null @@ -1,93 +0,0 @@ --- | A data type representing some large object that will need to be --- | parsed from a form and sent to a database via JSON. Similarly, --- | loading up a form ought to load the last-saved values for each --- | field and hydrate them. -module Example.RealWorld.Data.Options where - -import Prelude - -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.Maybe (Maybe) -import Data.Newtype (class Newtype) -import Example.App.Validation (class ToText, FieldError) -import Formless as F - ------ --- Some custom data - --- | This data type represents dollar amounts -newtype Dollars = Dollars Int -derive instance newtypeDollars :: Newtype Dollars _ -derive newtype instance eqDollars :: Eq Dollars -derive newtype instance showDollars :: Show Dollars - --- | This data type represents different metrics a user --- | can choose from. Depending on what metric they choose, --- | only fields relevant to that metric ought to render in --- | the form. -data Metric - = ViewCost - | ClickCost - | InstallCost -derive instance genericMetric :: Generic Metric _ -derive instance eqMetric :: Eq Metric -derive instance ordMetric :: Ord Metric - -instance showMetric :: Show Metric where - show = genericShow - -instance toTextMetric :: ToText Metric where - toText ViewCost = "View Cost" - toText ClickCost = "Click Cost" - toText InstallCost = "Install Cost" - --- | This data type will be used in radio buttons, and so if we --- | want to generate an initial form from our row, we'll need an --- | instance of the F.Initial type class -data Speed - = Low - | Medium - | Fast -derive instance genericSpeed :: Generic Speed _ -derive instance eqSpeed :: Eq Speed -derive instance ordSpeed :: Ord Speed - -instance showSpeed :: Show Speed where - show = genericShow - -instance initialSpeed :: F.Initial Speed where - initial = Low - ------ --- Our primary data type - --- | Just like the Group data type, we'll use a row as our underlying type. However, --- | since we don't have to extend this with any fields, we can stick with a simpler --- | closed row. In the case of the 'enable' option, we know there's no validation --- | for it, so we'll use `Void` as the error type. -type OptionsRow f = - ( enable :: f Void Boolean Boolean - , metric :: f FieldError (Maybe Metric) Metric - , viewCost :: f FieldError String (Maybe Dollars) - , clickCost :: f FieldError String (Maybe Dollars) - , installCost :: f FieldError String (Maybe Dollars) - , size :: f FieldError String Number - , dimensions :: f FieldError String Number - , speed :: f Void Speed Speed - ) - -prx :: F.SProxies OptionsForm -prx = F.mkSProxies $ F.FormProxy :: F.FormProxy OptionsForm - --- | This is the data type used throughout the application. In this case, it's the same --- | as the form and the underlying row. -newtype Options = Options (Record (OptionsRow F.OutputType)) -derive instance newtypeOptions :: Newtype Options _ -derive newtype instance eqOptions :: Eq Options -derive newtype instance showOptions :: Show Options - --- | Here's the Form type we'll use to run with Formless. The fields are the same as the --- | underlying row. -newtype OptionsForm r f = OptionsForm (r (OptionsRow f)) -derive instance newtypeOptionsForm :: Newtype (OptionsForm r f) _ diff --git a/example/real-world/GroupForm.purs b/example/real-world/GroupForm.purs new file mode 100644 index 0000000..8e27eba --- /dev/null +++ b/example/real-world/GroupForm.purs @@ -0,0 +1,370 @@ +module Example.RealWorld.GroupForm where + +import Prelude + +import Data.Const (Const) +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Data.Monoid (guard) +import Data.Newtype (class Newtype) +import Data.Symbol (SProxy(..)) +import Effect.Aff (Aff) +import Example.App.UI.Dropdown as DD +import Example.App.UI.Element (class_) +import Example.App.UI.Element as UI +import Example.App.UI.Typeahead as TA +import Example.App.Validation (class ToText, FieldError) +import Example.App.Validation as V +import Example.RealWorld.OptionsForm as OF +import Formless as F +import Halogen as H +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP +import Record as Record +import Select as Select + +-- Supporting types + +newtype GroupId = GroupId Int +derive instance newtypeGroupId :: Newtype GroupId _ +derive newtype instance eqGroupId :: Eq GroupId +derive newtype instance showGroupId :: Show GroupId + +newtype Admin = Admin { id :: Maybe GroupId } +derive instance newtypeAdmin :: Newtype Admin _ +derive newtype instance eqAdmin :: Eq Admin +derive newtype instance showAdmin :: Show Admin + +instance toTextAdmin :: ToText Admin where + toText (Admin { id }) = case id of + Just (GroupId n) -> "Administrator " <> show n + Nothing -> "None" + +-- As far as our application is concerned this is the type that matters. Most +-- fields are directly out of our form and we could have used `F.OutputType` to +-- recover them. To be explicit, though, we'll copy them here. +-- +-- The extra fields `id` and `secretKey` will come from the server after +-- submission, and the `options` field will come from our sub-form. +newtype Group = Group + { name :: String + , admin :: Admin + , applications :: Array String + , pixels :: Array String + , whiskey :: String + , id :: GroupId + , secretKey :: String + , options :: Maybe OF.Options + } +derive instance newtypeGroup :: Newtype Group _ +derive newtype instance eqGroup :: Eq Group +derive newtype instance showGroup :: Show Group + +data Tab = GroupTab | OptionsTab +derive instance eqTab :: Eq Tab +derive instance ordTab :: Ord Tab + + +-- Form types + +newtype GroupForm r f = GroupForm (r (GroupFormRow f)) +derive instance newtypeGroupForm :: Newtype (GroupForm r f) _ + +type GroupFormRow f = + ( name :: f FieldError String String + , admin :: f FieldError (Maybe Admin) Admin + , applications :: f FieldError (Array String) (Array String) + , pixels :: f FieldError (Array String) (Array String) + , whiskey :: f FieldError (Maybe String) String + , secretKey1 :: f FieldError String String + , secretKey2 :: f FieldError String String + ) + +-- Form component types + +type Slot = + H.Slot (F.Query GroupForm (Const Void) ChildSlots) Group + +_groupForm = SProxy :: SProxy "groupForm" + +type State = + ( selectedTab :: Tab -- which tab the user is viewing + , optionsErrors :: Int -- count of errors in the options form + , optionsDirty :: Boolean -- whether the options form has been edited + ) + +data Action + = Select Tab + | UpdateKey1 String + | UpdateKey2 String + | HandleDropdown (DD.Message Admin) + | HandleTASingle (TA.Message Maybe String) + | HandleTAMulti TASlot (TA.Message Array String) + | HandleOptionsForm OF.Message + | ResetForm + +type ChildSlots = + ( dropdown :: DD.Slot Admin Unit + , typeaheadSingle :: TA.Slot Maybe String Unit + , typeaheadMulti :: TA.Slot Array String TASlot + , optionsForm :: OF.Slot Unit + ) + +data TASlot = Applications | Pixels +derive instance eqTASlot :: Eq TASlot +derive instance ordTASlot :: Ord TASlot + + +-- Form spec + +prx :: F.SProxies GroupForm +prx = F.mkSProxies (F.FormProxy :: _ GroupForm) + +component :: F.Component GroupForm (Const Void) ChildSlots Unit Group Aff +component = F.component (const input) $ F.defaultSpec + { render = render + , handleAction = handleAction + , handleEvent = handleEvent + } + where + input :: F.Input GroupForm State Aff + input = + { validators: GroupForm + { name: V.nonEmptyStr + , admin: V.exists + , applications: V.nonEmptyArray + , pixels: V.nonEmptyArray + , whiskey: V.exists + , secretKey1: V.nonEmptyStr >>> V.minLength 5 >>> equalsSecretKey2 + , secretKey2: V.nonEmptyStr >>> V.minLength 5 >>> equalsSecretKey1 + } + , initialInputs: Nothing + , selectedTab: GroupTab + , optionsErrors: 0 + , optionsDirty: false + } + where + equalsSecretKey2 = F.hoistFnE \form secretKey1 -> do + let secretKey2 = F.getInput prx.secretKey2 form + if secretKey1 == secretKey2 + then Right secretKey1 + else Left $ V.NotEqual secretKey2 secretKey1 + + equalsSecretKey1 = F.hoistFnE \form secretKey2 -> do + let secretKey1 = F.getInput prx.secretKey1 form + if secretKey2 == secretKey1 + then Right secretKey2 + else Left $ V.NotEqual secretKey1 secretKey2 + + handleEvent = case _ of + F.Submitted form -> do + -- first, we'll submit the options form + mbOptionsForm <- H.query OF._optionsForm unit (H.request F.submitReply) + let options = map (OF.Options <<< F.unwrapOutputFields) (join mbOptionsForm) + -- next, we'll fetch a new group id (in the real world this might be a server call) + groupId <- pure $ GroupId 10 + -- then, we'll produce a new Group by transforming our form outputs and raise it + -- as a message. + H.raise + $ Group + $ Record.delete (SProxy :: _ "secretKey2") + $ Record.rename (SProxy :: _ "secretKey1") (SProxy :: _ "secretKey") + $ Record.insert (SProxy :: _ "id") groupId + $ Record.insert (SProxy :: _ "options") options + $ F.unwrapOutputFields form + _ -> pure unit + + handleAction = case _ of + Select tab -> + H.modify_ _ { selectedTab = tab } + + ResetForm -> do + -- first, we'll reset this form's components + _ <- H.query TA._typeaheadMulti Applications TA.clear + _ <- H.query TA._typeaheadMulti Pixels TA.clear + _ <- H.query TA._typeaheadSingle unit TA.clear + _ <- H.query DD._dropdown unit DD.clear + -- then, we'll reset the options form's components + _ <- F.sendQuery OF._optionsForm unit DD._dropdown unit DD.clear + -- and then we'll reset the forms + _ <- H.query OF._optionsForm unit (F.asQuery F.resetAll) + eval F.resetAll + + HandleOptionsForm { errors, dirty } -> + H.modify_ _ + { optionsErrors = errors + , optionsDirty = dirty + } + + UpdateKey1 key -> do + eval $ F.setValidate prx.secretKey1 key + eval $ F.validate prx.secretKey2 + + UpdateKey2 key -> do + eval $ F.setValidate prx.secretKey2 key + eval $ F.validate prx.secretKey1 + + HandleDropdown dropdownMessage -> do + eval $ F.reset prx.secretKey1 + eval $ F.reset prx.secretKey2 + case dropdownMessage of + DD.Selected admin -> + eval $ F.setValidate prx.admin (Just admin) + DD.Cleared -> + eval $ F.setValidate prx.admin Nothing + + HandleTASingle (TA.SelectionsChanged new) -> + eval $ F.setValidate prx.whiskey new + + HandleTAMulti slot (TA.SelectionsChanged new) -> case slot of + Applications -> eval $ F.setValidate prx.applications new + Pixels -> eval $ F.setValidate prx.pixels new + + where + eval act = F.handleAction handleAction handleEvent act + + render st@{ form } = + HH.div_ + [ UI.grouped_ + [ UI.button + [ HE.onClick \_ -> Just $ F.injAction $ Select GroupTab ] + [ UI.p_ $ "Group Form" <> + if st.errors > 0 + then " (" <> show st.errors <> ")" + else "" + ] + , UI.button + [ HE.onClick \_ -> Just $ F.injAction $ Select OptionsTab ] + [ UI.p_ $ "Options Form" <> + if st.optionsErrors > 0 + then " (" <> show st.optionsErrors <> ")" + else "" + ] + , UI.buttonPrimary + [ HE.onClick \_ -> Just F.submit ] + [ HH.text "Submit Form" ] + , UI.button + [ if st.dirty || st.optionsDirty + then HE.onClick \_ -> Just $ F.injAction ResetForm + else HP.disabled true + ] + [ HH.text "Reset All" ] + ] + , HH.div + [ class_ $ "is-hidden" # guard (st.selectedTab /= GroupTab) ] + [ UI.formContent_ + [ renderName + , renderAdmin + , renderSecretKey1 + , renderSecretKey2 + , renderApplications + , renderPixels + , renderWhiskey + ] + ] + , HH.div + [ class_ $ "is-hidden" # guard (st.selectedTab /= OptionsTab) ] + [ HH.slot OF._optionsForm unit OF.component unit handleOF ] + ] + where + handleOF = Just <<< F.injAction <<< HandleOptionsForm + + renderName = st # UI.formlessField UI.input + { label: "Name" + , help: "Give the group a name." + , placeholder: "January Analytics Seminar" + , sym: prx.name + } + + renderSecretKey1 = UI.input + { label: "Secret Key 1" + , help: F.getResult prx.secretKey1 form # UI.resultToHelp + "Provide a secret identifier for the group" + , placeholder: "ia30<>Psncdi3b#$<0423" + } + [ HP.value $ F.getInput prx.secretKey1 form + , HE.onValueInput $ Just <<< F.injAction <<< UpdateKey1 + ] + + renderSecretKey2 = UI.input + { label: "Secret Key 1" + , help: F.getResult prx.secretKey2 form # UI.resultToHelp + "Confirm the secret identifier for the group" + , placeholder: "ia30<>Psncdi3b#$<0423" + } + [ HP.value $ F.getInput prx.secretKey2 form + , HE.onValueInput $ Just <<< F.injAction <<< UpdateKey2 + ] + + renderAdmin = UI.field + { label: "Administrator" + , help: F.getResult prx.admin form # UI.resultToHelp + "Choose an administrator for the account" + } + [ HH.slot DD._dropdown unit (Select.component DD.input DD.spec) ddInput handler ] + where + handler = Just <<< F.injAction <<< HandleDropdown + ddInput = + { placeholder: "Choose an admin" + , items: map (Admin <<< { id: _ }) + [ Nothing + , Just $ GroupId 10 + , Just $ GroupId 15 + , Just $ GroupId 20 + , Just $ GroupId 25 + , Just $ GroupId 30 + , Just $ GroupId 35 + ] + } + + renderWhiskey = UI.field + { label: "Whiskey" + , help: F.getResult prx.whiskey form # UI.resultToHelp + "Choose a whiskey to be awarded" + } + [ HH.slot TA._typeaheadSingle unit (Select.component TA.input TA.single) taInput handler ] + where + handler = Just <<< F.injAction <<< HandleTASingle + taInput = + { placeholder: "Choose a whiskey" + , items: + [ "Laphroiag 10" + , "Lagavulin 12" + , "Lagavulin 16" + , "Oban 16" + , "Kilchoman Blue Label" + ] + } + + renderPixels = UI.field + { label: "Tracking Pixels" + , help: F.getResult prx.pixels form # UI.resultToHelp "Choose a pixel to track" + } + [ HH.slot TA._typeaheadMulti Pixels selectComponent taInput handler ] + where + selectComponent = Select.component TA.input TA.multi + handler = Just <<< F.injAction <<< HandleTAMulti Pixels + taInput = + { placeholder: "Search pixels" + , items: + [ "My favorite pixel" + , "Your favorite pixel" + , "Application main pixel" + , "A pixel for you is a pixel for me" + ] + } + + renderApplications = UI.field + { label: "Application Targets" + , help: F.getResult prx.applications form # UI.resultToHelp + "Applications are available in several sizes." + } + [ HH.slot TA._typeaheadMulti Applications selectComponent taInput handler ] + where + selectComponent = Select.component TA.input TA.multi + handler = Just <<< F.injAction <<< HandleTAMulti Applications + taInput = + { placeholder: "Search one or more applications" + , items: [ "Facebook", "Google", "Twitter", "Pinterest" ] + } diff --git a/example/real-world/OptionsForm.purs b/example/real-world/OptionsForm.purs new file mode 100644 index 0000000..d45deca --- /dev/null +++ b/example/real-world/OptionsForm.purs @@ -0,0 +1,274 @@ +module Example.RealWorld.OptionsForm where + +import Prelude + +import DOM.HTML.Indexed.InputType (InputType(..)) +import Data.Const (Const) +import Data.Either (Either(..)) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Int as Int +import Data.Maybe (Maybe(..)) +import Data.Monoid (guard) +import Data.Newtype (class Newtype, over) +import Data.Symbol (SProxy(..)) +import Effect.Aff (Aff) +import Example.App.UI.Dropdown as DD +import Example.App.UI.Element (class_) +import Example.App.UI.Element as UI +import Example.App.Validation (class ToText, FieldError) +import Example.App.Validation as V +import Formless as F +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 + +-- Supporting types + +newtype Dollars = Dollars Int +derive instance newtypeDollars :: Newtype Dollars _ +derive newtype instance eqDollars :: Eq Dollars +derive newtype instance showDollars :: Show Dollars + +-- Depending on the user's choice of metric, different fields ought to display +data Metric = ViewCost | ClickCost | InstallCost +derive instance genericMetric :: Generic Metric _ +derive instance eqMetric :: Eq Metric +derive instance ordMetric :: Ord Metric + +instance showMetric :: Show Metric where + show = genericShow + +instance toTextMetric :: ToText Metric where + toText ViewCost = "View Cost" + toText ClickCost = "Click Cost" + toText InstallCost = "Install Cost" + +-- This data type will be used in radio buttons. To generate a default value +-- with `F.mkInputFields` we'll need an instance of the `Initial` type class +data Speed = Low | Medium | Fast +derive instance genericSpeed :: Generic Speed _ +derive instance eqSpeed :: Eq Speed +derive instance ordSpeed :: Ord Speed + +instance showSpeed :: Show Speed where + show = genericShow + +instance initialSpeed :: F.Initial Speed where + initial = Low + +-- This is the data type used throughout our fake application. In this case, it's +-- the same type the form and the underlying row, so we'll use `F.OutputType`. +newtype Options = Options { | OptionsRow F.OutputType } +derive instance newtypeOptions :: Newtype Options _ +derive newtype instance eqOptions :: Eq Options +derive newtype instance showOptions :: Show Options + + +-- Form types + +newtype OptionsForm r f = OptionsForm (r (OptionsRow f)) +derive instance newtypeOptionsForm :: Newtype (OptionsForm r f) _ + +type OptionsRow f = + ( enable :: f Void Boolean Boolean + , metric :: f FieldError (Maybe Metric) Metric + , viewCost :: f FieldError String (Maybe Dollars) + , clickCost :: f FieldError String (Maybe Dollars) + , installCost :: f FieldError String (Maybe Dollars) + , size :: f FieldError String Number + , dimensions :: f FieldError String Number + , speed :: f Void Speed Speed + ) + + +-- Form component types + +type Slot = + H.Slot (F.Query OptionsForm (Const Void) ChildSlots) Message + +_optionsForm = SProxy :: SProxy "optionsForm" + +-- We'll maintain a flag so we can check if the enabled state has changed +type State = + ( prevEnabled :: Boolean ) + +data Action + = HandleDropdown (DD.Message Metric) + +type Message = + { errors :: Int + , dirty :: Boolean + } + +type ChildSlots = + ( dropdown :: DD.Slot Metric Unit ) + +-- Form spec + +prx :: F.SProxies OptionsForm +prx = F.mkSProxies (F.FormProxy :: _ OptionsForm) + +component :: F.Component OptionsForm (Const Void) ChildSlots Unit Message Aff +component = F.component (const input) $ F.defaultSpec + { render = render + , handleAction = handleAction + , handleEvent = handleEvent + } + where + input :: F.Input OptionsForm State Aff + input = + { prevEnabled: false + , initialInputs: Just defaultInputFields + , validators: OptionsForm + { enable: F.noValidation + , metric: V.exists + , viewCost: validateMetric ViewCost + , clickCost: validateMetric ClickCost + , installCost: validateMetric InstallCost + , size: Int.toNumber <$> V.strIsInt + , dimensions: Int.toNumber <$> V.strIsInt + , speed: F.noValidation + } + } + where + validateMetric metric = F.Validation \form i -> + if F.getInput prx.metric form == Just metric + then map (map (Just <<< Dollars)) $ F.runValidation V.strIsInt form i + else pure (pure Nothing) + + defaultInputFields :: OptionsForm Record F.InputField + defaultInputFields = F.wrapInputFields + { enable: false + , metric: Just ViewCost + , viewCost: "10" + , clickCost: "" + , installCost: "" + , size: "21" + , dimensions: "3005" + , speed: Low + } + + -- available for both handleEvent and handleAction + eval act = F.handleAction handleAction handleEvent act + + handleEvent = case _ of + F.Changed form -> do + st <- H.get + let enabled = F.getInput prx.enable form.form + H.raise { errors: form.errors, dirty: form.dirty } + H.modify_ _ { prevEnabled = enabled } + when (st.prevEnabled /= enabled) case enabled of + true -> do + let + initial = F.mkInputFields (F.FormProxy :: _ OptionsForm) + new = over OptionsForm (_ { enable = F.InputField true }) initial + eval $ F.loadForm new + _ -> + eval $ F.loadForm defaultInputFields + _ -> pure unit + + handleAction = case _ of + HandleDropdown msg -> case msg of + DD.Selected new -> eval $ F.setValidate prx.metric (Just new) + DD.Cleared -> eval $ F.setValidate prx.metric Nothing + + render st@{ form } = UI.formContent_ + [ renderEnabled + , HH.div + [ class_ ("is-hidden" # guard (not $ F.getInput prx.enable form)) ] + [ renderMetric + , case F.getInput prx.metric form of + Just ViewCost -> renderViewCost + Just ClickCost -> renderClickCost + Just InstallCost -> renderInstallCost + Nothing -> HH.div_ [] + , renderSize + , renderDimensions + , renderSpeed + ] + ] + where + renderEnabled = UI.field + { label: "Enable" + , help: Right "Do you want to enable this set of options?" + } + [ HH.label + [ class_ "checkbox" ] + [ HH.input + [ class_ "checkbox" + , HP.type_ InputCheckbox + , HP.checked $ F.getInput prx.enable form + , HE.onChange \_ -> Just $ F.modify prx.enable not + ] + , HH.text " Enable extra options" + ] + ] + + renderMetric = UI.field + { label: "Metric" + , help: F.getResult prx.metric form # UI.resultToHelp + "Choose a metric to optimize for." + } + [ HH.slot DD._dropdown unit (Select.component DD.input DD.spec) ddInput handler ] + where + handler = Just <<< F.injAction <<< HandleDropdown + ddInput = + { placeholder: "Choose a metric" + , items: [ ViewCost, ClickCost, InstallCost ] + } + + renderViewCost = st # UI.formlessField UI.input + { label: "View Cost" + , placeholder: "100" + , help: "Enter a dollar amount for view costs." + , sym: prx.viewCost + } + + renderClickCost = st # UI.formlessField UI.input + { label: "Click Cost" + , placeholder: "1" + , help: "Enter a dollar amount you're willing to pay for a click." + , sym: prx.clickCost + } + + renderInstallCost = st # UI.formlessField UI.input + { label: "Install Cost" + , placeholder: "10" + , help: "Enter a dollar amount you're willing to pay for an app install." + , sym: prx.installCost + } + + renderSize = st # UI.formlessField UI.input + { label: "Size" + , placeholder: "10.233" + , help: "Enter a total campaign size." + , sym: prx.size + } + + renderDimensions = st # UI.formlessField UI.input + { label: "Dimensions" + , placeholder: "1.027" + , help: "Enter a total campaign dimension set ratio buzzword." + , sym: prx.dimensions + } + + renderSpeed = UI.field + { label: "Speed", help: Right "How fast do you want to go?" } + [ speedInput Low, speedInput Medium, speedInput Fast ] + where + speed = F.getField prx.speed form + speedInput speed' = + HH.label + [ class_ "radio" ] + [ HH.input + [ HP.name "speed" + , class_ "radio" + , HP.type_ InputRadio + , HP.checked $ speed.input == speed' + , HE.onClick \_ -> Just $ F.set prx.speed speed' + ] + , HH.text (" " <> show speed') + ] diff --git a/example/real-world/Page.purs b/example/real-world/Page.purs new file mode 100644 index 0000000..16fdee0 --- /dev/null +++ b/example/real-world/Page.purs @@ -0,0 +1,58 @@ +module Example.RealWorld.Page where + +import Prelude + +import Data.Const (Const) +import Data.Maybe (Maybe(..)) +import Effect.Aff (Aff) +import Effect.Console as Console +import Example.App.UI.Element as UI +import Example.RealWorld.GroupForm as GF +import Halogen as H +import Halogen.HTML as HH + +-- Despite being a complex form, all the page component needs to think about +-- is the correct output type. +data Action + = HandleGroupForm GF.Group + +type State = + { group :: Maybe GF.Group } + +type ChildSlots = + ( groupForm :: GF.Slot Unit ) + +component :: H.Component HH.HTML (Const Void) Unit Void Aff +component = H.mkComponent + { initialState: \_ -> initialState + , render + , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } + } + where + initialState :: State + initialState = { group: Nothing } + + handleAction = case _ of + HandleGroupForm group -> do + H.modify_ _ { group = Just group } + H.liftEffect $ Console.logShow group + + render :: State -> H.ComponentHTML Action ChildSlots Aff + render st = + UI.section_ + [ UI.h1_ [ HH.text "Formless" ] + , UI.h2_ [ HH.text "A complex form inspired by real-world use cases." ] + , UI.p_ + """ + This component demonstrates building a large form with complex rendering and validation requirements. Notice how both tabs end up unifying to a single output type after the two forms are combined, how various dropdowns determine the contents (and visibility) of other form elements, the assorted external components, and how validation for many fields depends on the values of other fields in the form. + """ + , HH.br_ + , UI.p_ + """ + Next, review the source code. You'll notice that all of the complex types and state necessary to run this form can be generated from a pair of row types. All that's left for you to handle is to write the validation (with helper functions) and the render function. + """ + , HH.br_ + , HH.slot GF._groupForm unit GF.component unit handler + ] + where + handler = Just <<< HandleGroupForm diff --git a/example/real-world/Render/GroupForm.purs b/example/real-world/Render/GroupForm.purs deleted file mode 100644 index 5af6cc7..0000000 --- a/example/real-world/Render/GroupForm.purs +++ /dev/null @@ -1,150 +0,0 @@ -module Example.RealWorld.Render.GroupForm where - -import Prelude - -import Data.Maybe (Maybe(..)) -import Effect.Aff (Aff) -import Example.App.UI.Dropdown as Dropdown -import Example.App.UI.Element as UI -import Example.App.UI.Typeahead as Typeahead -import Example.RealWorld.Data.Group (Admin(..), GroupId(..), prx) -import Example.RealWorld.Data.Group as G -import Example.RealWorld.Types (GroupCQ, GroupCS, GroupTASlot(..), Query(..)) -import Formless as F -import Halogen as H -import Halogen.Component.ChildPath as CP -import Halogen.HTML as HH -import Halogen.HTML.Events as HE -import Halogen.HTML.Properties (value) as HP - --- | A convenience synonym for the group Formless state -type FormlessState = F.State G.GroupForm Aff - --- | A convenience synonym for the group Formless HTML type -type FormlessHTML = F.HTML Query GroupCQ GroupCS G.GroupForm Aff - --- | The form, grouped by sections. -render :: FormlessState -> FormlessHTML -render state = - UI.formContent_ - [ renderName state - , renderAdmin state - , renderSecretKey1 state - , renderSecretKey2 state - , renderApplications state - , renderPixels state - , renderWhiskey state - ] - ------ --- Built fields - -renderName :: FormlessState -> FormlessHTML -renderName = - UI.formlessField UI.input - { label: "Name" - , help: "Give the group a name." - , placeholder: "January Analytics Seminar" - , sym: prx.name - } - -renderSecretKey1 :: FormlessState -> FormlessHTML -renderSecretKey1 st = - UI.input - { label: "Secret Key 1" - , help: UI.resultToHelp - "Provide a secret identifier for the group" - (F.getResult prx.secretKey1 st.form) - , placeholder: "ia30<>Psncdi3b#$<0423" - } - [ HP.value $ F.getInput prx.secretKey1 st.form - , HE.onValueInput $ HE.input \str -> F.AndThen - (F.setValidate_ prx.secretKey1 str) - (F.validate_ prx.secretKey2) - ] - -renderSecretKey2 :: FormlessState -> FormlessHTML -renderSecretKey2 st = - UI.input - { label: "Secret Key 1" - , help: UI.resultToHelp - "Confirm the secret identifier for the group" - (F.getResult prx.secretKey2 st.form) - , placeholder: "ia30<>Psncdi3b#$<0423" - } - [ HP.value $ F.getInput prx.secretKey2 st.form - , HE.onValueInput $ HE.input \str -> F.AndThen - (F.setValidate_ prx.secretKey2 str) - (F.validate_ prx.secretKey1) - ] - -renderAdmin :: FormlessState -> FormlessHTML -renderAdmin state = - UI.field - { label: "Administrator" - , help: UI.resultToHelp "Choose an administrator for the account" (F.getResult prx.admin state.form) - } - [ HH.slot' CP.cp3 unit Dropdown.component - { items, placeholder: "Choose an admin" } - ( HE.input $ F.Raise <<< H.action <<< AdminDropdown ) - ] - where - items = - [ Admin { id: Nothing } - , Admin { id: Just $ GroupId 10 } - , Admin { id: Just $ GroupId 15 } - , Admin { id: Just $ GroupId 20 } - , Admin { id: Just $ GroupId 25 } - , Admin { id: Just $ GroupId 30 } - , Admin { id: Just $ GroupId 35 } - ] - -renderWhiskey :: FormlessState -> FormlessHTML -renderWhiskey state = - UI.field - { label: "Whiskey" - , help: UI.resultToHelp "Choose a whiskey to be awarded" (F.getResult prx.whiskey state.form) - } - [ HH.slot' CP.cp2 unit Typeahead.single - { placeholder: "Choose a whiskey" - , items: - [ "Laphroiag 10" - , "Lagavulin 12" - , "Lagavulin 16" - , "Oban 16" - , "Kilchoman Blue Label" - ] - } - ( HE.input $ F.Raise <<< H.action <<< TASingle ) - ] - -renderPixels :: FormlessState -> FormlessHTML -renderPixels state = - UI.field - { label: "Tracking Pixels" - , help: UI.resultToHelp "Choose a pixel to track" (F.getResult prx.pixels state.form) - } - [ HH.slot' CP.cp1 Pixels Typeahead.multi - { placeholder: "Search pixels" - , items: - [ "My favorite pixel" - , "Your favorite pixel" - , "Application main pixel" - , "A pixel for you is a pixel for me" - ] - } - ( HE.input $ F.Raise <<< H.action <<< TAMulti Pixels ) - ] - -renderApplications :: FormlessState -> FormlessHTML -renderApplications state = - UI.field - { label: "Application Targets" - , help: UI.resultToHelp "Applications are available in several sizes" (F.getResult prx.applications state.form) - } - [ HH.slot' CP.cp1 Applications Typeahead.multi - { placeholder: "Search one or more applications" - , items: [ "Facebook", "Google", "Twitter", "Pinterest" ] - } - ( HE.input $ F.Raise <<< H.action <<< TAMulti Applications ) - ] diff --git a/example/real-world/Render/OptionsForm.purs b/example/real-world/Render/OptionsForm.purs deleted file mode 100644 index 09cb2dc..0000000 --- a/example/real-world/Render/OptionsForm.purs +++ /dev/null @@ -1,180 +0,0 @@ -module Example.RealWorld.Render.OptionsForm where - -import Prelude - -import DOM.HTML.Indexed.InputType (InputType(..)) -import Data.Either (Either(..)) -import Data.Lens (view) -import Data.Maybe (Maybe(..)) -import Effect.Aff (Aff) -import Example.App.UI.Dropdown as Dropdown -import Example.App.UI.Element (css) -import Example.App.UI.Element as UI -import Example.RealWorld.Data.Options (Metric(..), Speed(..), prx) -import Example.RealWorld.Data.Options as OP -import Example.RealWorld.Types (Query(..)) -import Formless as F -import Halogen as H -import Halogen.HTML as HH -import Halogen.HTML.Events as HE -import Halogen.HTML.Properties as HP - --- | A convenience synonym for the group Formless state -type FormlessState = F.State OP.OptionsForm Aff - --- | A convenience synonym for the group Formless HTML type -type FormlessHTML = F.HTML Query (Dropdown.Query Metric) Unit OP.OptionsForm Aff - --- | The form, grouped by sections. -render :: FormlessState -> FormlessHTML -render state = - UI.formContent_ - [ renderEnabled state - , HH.div - [ if F.getInput prx.enable state.form then css "" else css "is-hidden" ] - ( renderMetrics state <> renderOthers state ) - ] - ------ --- Form parts - -renderMetrics :: FormlessState -> Array FormlessHTML -renderMetrics state = - [ renderMetric state - , renderMetricField (F.getInput prx.metric state.form) - ] - where - renderMetricField = case _ of - Just ViewCost -> renderViewCost state - Just ClickCost -> renderClickCost state - Just InstallCost -> renderInstallCost state - Nothing -> HH.div_ [] - -renderOthers :: FormlessState -> Array FormlessHTML -renderOthers state = - [ renderSize state - , renderDimensions state - , renderSpeed state - ] - ------ --- Fields - -renderEnabled :: FormlessState -> FormlessHTML -renderEnabled state = - UI.field - { label: "Enable" - , help: Right "Do you want to enable this set of options?" - } - [ HH.label - [ css "checkbox" ] - [ HH.input - [ css "checkbox" - , HP.type_ InputCheckbox - , HP.checked $ F.getInput prx.enable state.form - , HE.onChange $ HE.input_ $ F.modify prx.enable not - ] - , HH.text " Enable extra options" - ] - ] - -renderMetric :: FormlessState -> FormlessHTML -renderMetric state = - UI.field - { label: "Metric" - , help: UI.resultToHelp "Choose a metric to optimize for." (F.getResult prx.metric state.form) - } - [ HH.slot unit Dropdown.component - { placeholder: "Choose a metric" - , items: [ ViewCost, ClickCost, InstallCost ] - } - ( HE.input $ F.Raise <<< H.action <<< MetricDropdown ) - ] - -renderViewCost :: FormlessState -> FormlessHTML -renderViewCost = - UI.formlessField UI.input - { label: "View Cost" - , placeholder: "100" - , help: "Enter a dollar amount for view costs." - , sym: prx.viewCost - } - -renderClickCost :: FormlessState -> FormlessHTML -renderClickCost = - UI.formlessField UI.input - { label: "Click Cost" - , placeholder: "1" - , help: "Enter a dollar amount you're willing to pay for a click." - , sym: prx.clickCost - } - -renderInstallCost :: FormlessState -> FormlessHTML -renderInstallCost = - UI.formlessField UI.input - { label: "Install Cost" - , placeholder: "10" - , help: "Enter a dollar amount you're willing to pay for an app instal." - , sym: prx.installCost - } - -renderSize :: FormlessState -> FormlessHTML -renderSize = - UI.formlessField UI.input - { label: "Size" - , placeholder: "10.233" - , help: "Enter a total campaign size." - , sym: prx.size - } - -renderDimensions :: FormlessState -> FormlessHTML -renderDimensions = - UI.formlessField UI.input - { label: "Dimensions" - , placeholder: "1.027" - , help: "Enter a total campaign dimension set ratio buzzword." - , sym: prx.dimensions - } - -renderSpeed :: FormlessState -> FormlessHTML -renderSpeed state = - UI.field - { label: "Speed" - , help: Right "How fast do you want to go?" - } - [ HH.label - [ css "radio" ] - [ HH.input - [ HP.name "speed" - , css "radio" - , HP.type_ InputRadio - , HP.checked $ speed.input == Low - , HE.onClick $ HE.input_ $ F.set prx.speed Low - ] - , HH.text $ " " <> show Low - ] - , HH.label - [ css "radio" ] - [ HH.input - [ HP.name "speed" - , css "radio" - , HP.type_ InputRadio - , HP.checked $ speed.input == Medium - , HE.onClick $ HE.input_ $ F.set prx.speed Medium - ] - , HH.text $ " " <> show Medium - ] - , HH.label - [ css "radio" ] - [ HH.input - [ HP.name "speed" - , css "radio" - , HP.type_ InputRadio - , HP.checked $ speed.input == Fast - , HE.onClick $ HE.input_ $ F.set prx.speed Fast - ] - , HH.text $ " " <> show Fast - ] - ] - where - speed = view (F._Field prx.speed) state.form diff --git a/example/real-world/Spec/GroupForm.purs b/example/real-world/Spec/GroupForm.purs deleted file mode 100644 index 7ecbd23..0000000 --- a/example/real-world/Spec/GroupForm.purs +++ /dev/null @@ -1,56 +0,0 @@ -module Example.RealWorld.Spec.GroupForm where - -import Prelude - -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) -import Data.Newtype (unwrap) -import Data.Symbol (SProxy(..)) -import Example.App.Validation as V -import Example.RealWorld.Data.Group (Group(..), GroupForm(..), GroupId(..), prx) -import Formless as F -import Record as Record - -groupFormSubmit :: ∀ m. Monad m => GroupForm Record F.OutputField -> m Group -groupFormSubmit form = do - -- This could be a server call or something else that is necessary - -- to collect the information to complete your output type. - groupId <- pure (GroupId 10) - pure $ Group - <<< Record.delete (SProxy :: SProxy "secretKey2") - <<< Record.rename (SProxy :: SProxy "secretKey1") (SProxy :: SProxy "secretKey") - <<< Record.insert (SProxy :: SProxy "id") groupId - <<< Record.insert (SProxy :: SProxy "options") Nothing - <<< F.unwrapRecord - $ unwrap form - -groupInputs :: GroupForm Record F.InputField -groupInputs = F.mkInputFields $ F.FormProxy :: F.FormProxy GroupForm - -groupValidators :: ∀ m. Monad m => GroupForm Record (F.Validation GroupForm m) -groupValidators = GroupForm - { name: V.nonEmptyStr - -- Despite being a field-level validation, you can use other fields in the form because the - -- public state is provided as an argument. - , secretKey1: V.nonEmptyStr >>> V.minLength 5 >>> equalsSK2 - , secretKey2: V.nonEmptyStr >>> V.minLength 5 >>> equalsSK1 - , admin: V.exists - , applications: V.nonEmptyArray - , pixels: V.nonEmptyArray - , whiskey: V.exists - } - where - -- A custom validator relying on the form state - equalsSK1 :: F.Validation GroupForm m V.FieldError String String - equalsSK1 = F.hoistFnE \form str1 -> - let str0 = F.getInput prx.secretKey1 form - in if str0 == str1 - then Right str1 - else Left $ V.NotEqual str0 str1 - - equalsSK2 :: F.Validation GroupForm m V.FieldError String String - equalsSK2 = F.hoistFnE \form str1 -> - let str0 = F.getInput prx.secretKey2 form - in if str0 == str1 - then Right str1 - else Left $ V.NotEqual str0 str1 diff --git a/example/real-world/Spec/OptionsForm.purs b/example/real-world/Spec/OptionsForm.purs deleted file mode 100644 index 0404126..0000000 --- a/example/real-world/Spec/OptionsForm.purs +++ /dev/null @@ -1,43 +0,0 @@ -module Example.RealWorld.Spec.OptionsForm where - -import Prelude - -import Data.Int as Int -import Data.Maybe (Maybe(..)) -import Data.Newtype (unwrap) -import Example.App.Validation as V -import Example.RealWorld.Data.Options (Dollars(..), Metric(..), OptionsForm(..), prx) -import Formless as F - -optionsFormInputs :: OptionsForm Record F.InputField -optionsFormInputs = F.mkInputFields $ F.FormProxy :: F.FormProxy OptionsForm - --- In the case the user has not toggled the options on, we'll provide them with --- valid default values. -defaultInputs :: OptionsForm Record F.InputField -defaultInputs = OptionsForm $ inputs - { metric = F.InputField $ Just ViewCost - , viewCost = F.InputField "1" - , size = F.InputField "21" - , dimensions = F.InputField "3005" - } - where - inputs = unwrap optionsFormInputs - -optionsFormValidators :: ∀ m. Monad m => OptionsForm Record (F.Validation OptionsForm m) -optionsFormValidators = OptionsForm - { enable: F.hoistFn_ identity - , metric: V.exists - , viewCost: validateMetric ViewCost - , clickCost: validateMetric ClickCost - , installCost: validateMetric InstallCost - , size: Int.toNumber <$> V.strIsInt - , dimensions: Int.toNumber <$> V.strIsInt - , speed: F.hoistFn_ identity - } - where - validateMetric metric = F.Validation \form i -> - if (F.getInput prx.metric form) == Just metric - then (map (Just <<< Dollars)) <$> F.runValidation V.strIsInt form i - else pure (pure Nothing) - diff --git a/example/real-world/Types.purs b/example/real-world/Types.purs deleted file mode 100644 index e0ece76..0000000 --- a/example/real-world/Types.purs +++ /dev/null @@ -1,70 +0,0 @@ -module Example.RealWorld.Types where - -import Prelude - -import Data.Either.Nested (Either2, Either3) -import Data.Functor.Coproduct.Nested (Coproduct2, Coproduct3) -import Data.Maybe (Maybe) -import Effect.Aff (Aff) -import Example.App.UI.Dropdown as Dropdown -import Example.App.UI.Typeahead as TA -import Example.RealWorld.Data.Group (Admin, Group, GroupForm) -import Example.RealWorld.Data.Options (Metric, OptionsForm) -import Formless as Formless - ----------- --- Component - --- | This component will only handle output from Formless to keep --- | things simple. -data Query a - = GroupForm (Formless.Message Query GroupForm) a - | OptionsForm (Formless.Message Query OptionsForm) a - | TASingle (TA.Message Maybe String) a - | TAMulti GroupTASlot (TA.Message Array String) a - | AdminDropdown (Dropdown.Message Admin) a - | MetricDropdown (Dropdown.Message Metric) a - | Select Tab a - | Reset a - | Submit a - --- | We'll keep track of both form errors so we can show them in tabs --- | and our ultimate goal is to result in a Group we can send to the --- | server. -type State = - { focus :: Tab -- Which tab is the user on? - , groupFormErrors :: Int -- Count of the group form errors - , groupFormDirty :: Boolean -- Is the group form in a dirty state? - , optionsFormErrors :: Int -- Count of the options form errors - , optionsFormDirty :: Boolean -- Is the options form in a dirty state? - , optionsEnabled :: Boolean -- Is the options form enabled? - , group :: Maybe Group -- Our ideal result type from form submission - } - --- | Now we can create _this_ component's child query and child slot pairing. -type ChildQuery = Coproduct2 - (Formless.Query Query GroupCQ GroupCS GroupForm Aff) - (Formless.Query Query (Dropdown.Query Metric) Unit OptionsForm Aff) - -type ChildSlot = Either2 Unit Unit - ----------- --- Formless - --- | Types for the group form -type GroupCQ = Coproduct3 (TA.Query String) (TA.Query String) (Dropdown.Query Admin) -type GroupCS = Either3 GroupTASlot Unit Unit - ----------- --- Slots - -data GroupTASlot = Applications | Pixels -derive instance eqGroupTASlot :: Eq GroupTASlot -derive instance ordGroupTASlot :: Ord GroupTASlot - ----------- --- Navigation - -data Tab = GroupTab | OptionsTab -derive instance eqTab :: Eq Tab -derive instance ordTab :: Ord Tab diff --git a/package.json b/package.json index 9a323fb..ad50da7 100644 --- a/package.json +++ b/package.json @@ -6,7 +6,7 @@ "license": "MIT", "scripts": { "postinstall": "bower i --silent", - "clean": "rm -rf bower_components node_modules output", + "clean": "rm -rf bower_components output", "build": "pulp build", "watch": "pulp -w build", "test": "pulp test", @@ -14,8 +14,8 @@ "watch-all": "pulp -w build -I example --to dist/app.js" }, "devDependencies": { - "bower": "^1.8.4", - "pulp": "^12.3.0", - "purescript": "^0.12.0" + "bower": "^1.8.8", + "pulp": "^12.4.2", + "purescript": "0.12.5" } } diff --git a/readme.md b/readme.md index 69c6e7b..fe07f7c 100644 --- a/readme.md +++ b/readme.md @@ -4,393 +4,115 @@ [![Latest release](http://img.shields.io/github/release/thomashoneyman/purescript-halogen-formless.svg)](https://github.com/thomashoneyman/purescript-halogen-formless/releases) [![Maintainer: thomashoneyman](https://img.shields.io/badge/maintainer-thomashoneyman-lightgrey.svg)](http://github.com/thomashoneyman) -Formless is a [renderless component](https://github.com/thomashoneyman/purescript-halogen-renderless) which helps you build forms in Halogen. Provide Formless with some initial inputs, validation to run on those inputs, and a render function, and the component will handle the tedious parts of managing form state, errors, submission, and more. +Formless is a flexible, extensible, type-safe Halogen component for building forms without boilerplate. -You can write a complete Halogen form component with multiple fields, validation, parsing, and errors in less than 100 lines of code (only ~20 lines of which are from Formless). - -- [Live examples / docs site](https://thomashoneyman.github.io/purescript-halogen-formless/) +- [Examples & documentation site](https://thomashoneyman.github.io/purescript-halogen-formless/) - [Source code for examples](https://github.com/thomashoneyman/purescript-halogen-formless/tree/master/example) -Have any comments about the library or any ideas to improve it for your use case? Please file an issue, send me an email, or reach out on the [PureScript user group](https://discourse.purescript.org). - -### Installation - -Install with Bower: - -```sh -bower i --save purescript-halogen-formless -``` - -# Overview +> You're viewing the readme for the upcoming 1.0 release, based on Halogen 5. If you're using Halogen 4, you should browse the [v0.5.2 release instead](https://github.com/thomashoneyman/purescript-halogen-formless/tree/v0.5.2). -The default approach to forms in Halogen is to write a component and, for every field in your form, queries to handle changes on those fields and validation. Each form field lives in the state type along with validation results, summary information (like whether fields have been edited), and a possible form output. +## Quick Start -Formless helps abstract away most of the messy details of managing form state without imposing any restrictions on how you render your form. +You can write a basic Formless form in just a few lines of code. You are responsible for providing just a few pieces of information. -To demonstrate, let's build a signup form in Formless. - -## Data Types - -We'll start with the data type we want our form to result in: a `User`. +First, a form type that describes the fields in your form, along with their validation error type, user input type, and validated output type. Note: you can provide whatever custom error types you'd like, use `Void` to represent no possible errors, parse to whatever type you want, and none of your fields need to share any types. ```purescript -type User = - { id :: Int - , name :: String - , email :: Email - } -``` - -This is the data type we'll use throughout our application, but our form will have different fields altogether: we want them to provide two email addresses for confirmation purposes, and we don't have an ID for them until the form has been submitted. - -Formless requires a specific shape from your `Form` data type. You are expected to write a newtype that takes two arguments, `r` and `f` below, and a row containing the fields in your form. - -
- Expand to read about these two type arguments -The first argument has the kind `(# Type -> Type)` and turns a row of types into a concrete type. For example, you can fill in `Record` to get a record; `Record (name :: String)` is the same as `{ name :: String }`. However, Formless will often fill in `Variant` internally. This lets the library access the entire form at once (`Record`) or a single field (`Variant`) to perform various operations. The important thing is that you make sure this variable is left free in your `Form` newtype. +type Dog = { name :: String, age :: Age } -The second argument has the kind `(Type -> Type -> Type -> Type)` and will be filled in with one of many types Formless uses internally to manage your form. It expects an error type, an input type, and an output type for the field in question. +newtype Age = Age Int -
+data AgeError = TooLow | TooHigh | InvalidInt -Every field should use the second argument, `f`, and provide it with three type arguments: - -- an `error` type, which represents possible validation errors for the field -- an `input` type, which represents the value the user will provide when interacting with the field -- an `output` type, which represents the type you'd like to result from successful validation - -Here's what our form type looks like: - -```purescript --- Note: Common practice to use `Void` to represent "no error possible" -newtype Form r f = Form (r - ( name :: f Error String String -- | String input to String output, or Error on failed validation - , email1 :: f Error String Email -- | String input to Email output, or Error on failed validation - , email2 :: f Error String Email -- | String input to Email output, or Error on failed validation +newtype DogForm r f = DogForm (r + -- error input output + ( name :: f Void String String + , age :: f AgeError String Age )) -derive instance newtypeForm :: Newtype (Form r f) _ -``` - -Formless will use this type to perform all kinds of transformations and track data about your form over time. You simply need to decide what fields will exist and what their error, input, and output types are. - -
- Expand to read a longer explanation of this form type - -This can be a scary type to look at, but it's not so bad once you provide concrete types for `r` and `f`. For example, let's try providing `Record` and the `OutputType` type from Formless: - -```purescript --- This type synonym will throw away most of its arguments, preserving only the last type. Since --- it takes three arguments, it fits the kind (Type -> Type -> Type -> Type), which is exactly what --- we need to provide as our `Form` newtype's second argument. -type OutputType e i o = o - --- Let's fill in each occurrence of `f` with `OutputType` -myForm :: Form Record OutputType -myForm = Form - { name :: OutputType Error String String - , email1 :: OutputType Error String Email - , email2 :: OutputType Error String Email - } - --- This isn't much less confusing, so let's take things a step further. What if we act as the --- compiler does and erase the type synonym? After all, OutputType is equivalent to only the --- third type argument from each field. -myForm2 :: Form Record OutputType -myForm2 = Form - { name :: String - , email1 :: Email - , email2 :: Email - } - --- `myForm` and `myForm2` are exactly equivalent! Accepting a type that itself accepts three --- arguments allows us to represent several different sorts of records and variants from the --- same underlying row and can result in quite simple data types despite the admittedly --- complicated-looking original type. +derive instance newtypeDogForm :: Newtype (DogForm r f) _ ``` -
+Next, the component input, which is made up of initial values and validation functions for each field in your form. Note: with your form type complete, the compiler will verify that your inputs are of the right type, that your validation takes the right input type, produces the right error type, and parses to the right output type, that fields exist at these proper keys, and more. There's no loss in type safety here! Plus, your validation functions can easily reference the value of other fields in the form, perform monadic effects, get debounced before running, and more. -
- Expand to see the definition of the Error and Email types - -```purescript -newtype Email = Email String - -data Error - = Required - | NotEqual String String - | EmailIsUsed - | EmailInvalid -``` - -
- -## Component Inputs - -Now that we have a form type and an output type we can produce the `Input` type that the Formless component requires. While we'll take a closer look at each of these types in the next few sections, here's a quick primer on what these types are: - -- `initialInputs`: Your `Form` newtype around a record, where each field contains its initial, starting value -- `validators`: Your `Form` newtype around a record, where each field contains a validation function which will process its input value -- `render`: The render function the component will use, which is the standard `State -> HTML` type in Halogen +You can generate sensible defaults for all input fields in your form by setting `initialInputs` to `Nothing`, or you can manually provide the starting value for each field in your form. ```purescript import Formless as F -type FormlessInput m = - { initialInputs :: Form Record F.InputField - , validators :: Form Record (F.Validation Form m) - , render :: F.State Form m -> F.HTML' Form m - } -``` - -### Form Inputs - -The first thing Formless requires is a record of the fields in your form with their initial values. It has the type `Form Record F.InputField`. Remember: `Form` is our custom newtype we defined a moment ago, and it was awaiting a type that would be applied to the error, input, and output types we defined for each field -- like `F.InputField`! - -```purescript -newtype InputField error input output = InputField input -``` - -Applied to our form, an `InputField` represents the input type only. We can give Formless a valid record of inputs by just supplying concrete input values for each field: - -```purescript -inputs :: Form Record F.InputField -inputs = Form - { name: InputField "" - , email1: InputField "" - , email2: InputField "" +input :: forall m. Monad m => F.Input' DogForm m +input = + { initialInputs: Nothing -- same as: Just (F.wrapInputFields { name: "", age: "" }) + , validators: DogForm + { name: F.noValidation + , age: F.hoistFnE_ \str -> case fromString str of + Nothing -> Left InvalidInt + Just n + | n < 0 -> Left TooLow + | n > 30 -> Left TooHigh + | otherwise -> Right (Age n) + } } ``` -It's a little tedious writing out all those newtypes, so `Formless.Spec.Transform` provides helper functions to generate them for you: +Finally, the component spec, which is made up of a number of optional functions and types you can use to extend the Formless component. At minimum you will need to provide your own render function that describes how your form should be presented to the user. But you can also freely extend the Formless state, query, action, child slots, and message types, as well as provide your own handlers for your extended queries, actions, and child slots, and handle Formless messages internally without leaking information to a parent. You can extend Formless to an incredible degree -- or you can keep things simple and just provide render function. All extensions are optional. -```purescript -inputs :: Form Record F.InputField -inputs = F.wrapInputFields - { name: "" - , email1: "" - , email2: "" - } -``` +For our small form, we'll do two things: we'll provide a render function, and when the form is submitted, we'll output a `Dog` to parent components. Along the way we'll wire things up so that input fields display their current value from form state; typing into an input field updates its value in state, also running the correct validation function; we'll display the validation error for `age` if there is one; and we'll wire up a submit button. -In fact, you don't even have to do this: if your input types belong to the `Formless.Initial` type class (all monoidal values do), it can generate the values for you from a proxy for your form: +Note: If you would like to have your form raise no messages (rare), do not supply a `handleMessage` function. If you would like to raise the usual Formless messages (`Changed`, `Submitted`), then provide `H.raise` as your `handleMessage` function. If you would like to simply raise your form's validated output type (`Dog`, in this example), then provide `F.raiseResult` as your `handleMessage` function. Finally, if you want to do something else, you can write a custom function that does whatever you would like. ```purescript -proxy = F.FormProxy :: F.FormProxy Form - -inputs :: Form Record F.InputField -inputs = F.mkInputFields proxy -``` - -### Validation - -The next thing Formless requires is a record of validators: functions that will be run on the form to validate the inputs and produce the specified output types. Every field in this record ought to use the Formless `Validation` type: - -```purescript -newtype Validation form m error input output - = Validation (form Record FormField -> input -> m (Either error output)) -``` - -This type represents a function which takes your entire form, the input for this particular field, and produces either an error or result. - -- This function can be monadic, so you can do things like confirm with a server that an email is not already in use. -- This function takes your entire form as an argument, so you can use the values of other fields during validation. For example, you could verify that two password fields are equal to one another. -- If you are using `purescript-validation` and already have a composed validation function that results in `V`, then you can convert it into a Formless validator with `hoistFnE_ <<< Data.Validation.Semigroup.toEither` (or the `Semiring` module). - -The `FormField` newtype represents the state of every field in the form: - -```purescript -newtype FormField error input output = FormField - { -- The value the user will input - input :: input - -- Whether the field has been modified yet (validators ignore untouched fields) - , touched :: Boolean - -- The result of validation, IF validation has been run on this field - , result :: FormFieldResult error output - } -``` - -A field's result can be in one of several states, represented by the `FormFieldResult` type: - -```purescript -data FormFieldResult e o - = NotValidated - | Validating -- Useful to display a loading spinner during asynchronous / long validations - | Error e - | Success o -``` - -Let's see some examples of validators written in this style: - -```purescript --- This helper function lets you take any function from `input` to `output` and turns it into --- the Validation type from Formless. -hoistFn_ :: ∀ form m e i o. Monad m => (i -> o) -> Validation form m e i o - --- For example, this validator simply transforms the input `Int` into a `String` using `hoistFn_` --- output. -myStringValidator :: ∀ form m. Monad m => Validation form m Void Int String -myStringValidator = hoistFn_ show - --- This helper function lets you take any function from `input` to `Either error output` and turns --- it into the Validation type from Formless. -hoistFnE_ :: ∀ form m e i o. Monad m => (i -> Either e o) -> Validation form m e i o - --- For example, this validator makes sure that the string is not empty -isNonEmpty :: ∀ form m. Monad m => Validation form m Error String String -isNonEmpty = hoistFnE_ $ \str -> - if null str - then Left Required - else Right str - --- This validator transforms the input into an `Email` type if successful. -validEmail :: ∀ form m. Monad m => Validation form m Error String Email -validEmail = hoistFnE_ $ \str -> - if contains (Pattern "@") str - then Right (Email str) - else Left EmailInvalid - --- Continuing the trend, this helper takes a function from `input` to a monad `m (Either error output)` and --- turns it into the Validation type from Formless. -hoistFnME_ :: ∀ form m e i o. Monad m => (i -> m (Either e o)) -> Validation form m e i o - --- For example, this validator makes sure that an email address is not in use. Notice how it relies --- on the input value already being an `Email` -- we'll see how to chain validators together so this --- can be used with `validEmail` in a moment. -emailNotUsed :: ∀ form. Validation form Aff Error Email Email -emailNotUsed = hoistFnME_ $ \email -> do - isUsed <- checkEmailIsUsed :: Email -> Aff Boolean - pure $ - if isUsed - then Right email - else Left EmailIsUsed - --- Now, let's do something a little more complex. Let's validate that two fields are equal to one another. - --- This time, we want to rely on our existing `Form` as an argument for our validation, so instead of using --- `hoistFnE_` we'll reach for `hoistFnE`, which doesn't throw away the form argument. -hoistFnE :: ∀ form m e i o. Monad m => (form Record FormField -> i -> Either e o) -> Validation form m e i o - --- We'll use `getInput` from Formless to retrieve the input value of the field "email1" from the form, and then --- we'll validate that the current field is equal to it. Formless can prove that a "email1" field exists using --- your form row, so you'll never access a value you don't have. -equalsEmail1 :: ∀ m. Monad m => Validation Form m Error String String -equalsEmail1 = hoistFnE $ \form str -> - let e1 = F.getInput (SProxy :: SProxy "email1") form - in if str == e1 - then Right str - else Left $ NotEqual str e1 -``` - -These validators are building blocks that you can compose together to validate any particular field. Now that we've got some validation functions we can provide our `validators` record to Formless: - -```purescript -validators :: Form Record (F.Validation Form Aff) -validators = Form - { name: isNonEmpty - , email1: isNonEmpty >>> validEmail >>> emailNotUsed - , email2: isNonEmpty >>> equalsEmail1 >>> emailNotUsed - } -``` - -Note how validators can be composed: `validEmail` takes a `String` and produces an `Email`, which is then passed to `emailNotUsed`, which takes an `Email` and produces an `Email`. You can use this to build up validators that change a field's output type over time. Composition with `>>>` will short-circuit on the first failure. - -### Render Function - -The last thing you're expected to provide is a render function. Formless is a renderless component, so it provides no rendering at all and expects you to provide an entire render function of the type `∀ m. F.State Form m -> F.HTML' Form m`. To learn more about renderless components, see the [purescript-halogen-renderless](https://github.com/thomashoneyman/purescript-halogen-renderless) library. - -The main things to keep in mind when writing a render function for Formless: - -- You can pass arguments to the function before it is given to Formless (like your parent state). When the parent component re-renders, these values will be given to Formless anew. -- You can extend Formless' functionality by embedding your own queries in the render function with `Raise` -- You can mount external components inside Formless and control them from the parent with `send` and `send'` -- You should use `F.set` to set a field's value, `F.modify` to modify a field with a function, `F.validate` to validate fields, and `F.setValidate` or `F.modifyValidate` to do both at the same time -- If you want to avoid running expensive or long-running validations on each key press, use the asynchronous versions (`F.asyncSetValidate`, etc.) and provide a number of milliseconds to debounce. You can use `getResult` to show a loading spinner when the result is `Validating`. -- If you need to chain multiple operations, you can use `F.andThen` to provide multiple Formless queries -- There are functions to get various parts of a field, given a symbol; these include `getInput`, `getResult`, `getError`, and more. - -Let's write a render function using `setValidate`, `asyncSetValidate`, and `getInput`, using symbol proxies we've defined in the `where` clause: +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP +import Formless as F -```purescript -renderFormless :: ∀ m. F.State Form m -> F.HTML' Form m -renderFormless fstate = - HH.div_ - [ HH.input - [ HP.value $ F.getInput _name fstate.form - , HE.onValueInput $ HE.input $ F.setValidate _name - ] - , HH.input - [ HP.value $ F.getInput _email1 fstate.form - -- This will help us avoid hitting the server on every single key press. - , HE.onValueInput $ HE.input $ F.asyncSetValidate debounceTime _email1 - ] - , HH.input - [ HP.value $ F.getInput _email2 fstate.form - , HE.onValueInput $ HE.input $ F.asyncSetValidate debounceTime _email2 - ] - ] +spec :: forall m. Monad m => F.Spec' DogForm Dog m +spec = F.defaultSpec { render, handleMessage = F.raiseResult } where + render st@{ form } = + HH.form_ + [ HH.input + [ HP.value $ F.getInput _name form + , HE.onValueInput $ Just <<< F.set _name + ] + , HH.input + [ HP.value $ F.getInput _age form + , HE.onValueInput $ Just <<< F.setValidate _age + ] + , HH.text case F.getError _age form of + Nothing -> "" + Just InvalidInt -> "Age must be an integer" + Just TooLow -> "Age cannot be negative" + Just TooHigh -> "No dog has lived past 30 before" + , HH.button + [ HE.onClick \_ -> Just F.submit ] + [ HH.text "Submit" ] + ] + where _name = SProxy :: SProxy "name" - _email1 SProxy :: SProxy "email1" - _email2 = SProxy :: SProxy "email2" - debounceTime = Milliseconds 300.0 + _age = SProxy :: SProxy "age" ``` -It can be tedious to write out symbol proxies for every field you want to access in a form. You can instead generate a record of these proxies automatically using the `mkSProxies` function: - -```purescript -prx :: F.SProxies Form -prx = F.mkSProxies (F.FormProxy :: F.FormProxy Form) - --- These are now equivalent -x = SProxy :: SProxy "name" -x = prx.name -``` - -Now, instead of writing out proxies over and over, you can just import the proxies record! - -## Mounting The Component - -Whew! With those three functions and the `Form` type, we've now got everything necessary to run Formless. Let's bring it all together by mounting the component and handling its `Submitted` output message: +Our form is now complete. It's easy to put this form in a parent page component: ```purescript +import Halogen as H import Formless as F -data Query a - = Formless (F.Message' Form) a - -type ChildQuery = F.Query' Form Aff -type ChildSlot = Unit +data Action = HandleDogForm Dog -component :: H.Component HH.HTML Query Unit Void Aff -component = H.parentComponent +page = H.mkComponent { initialState: const unit - , render - , eval - , receiver: const Nothing + , render: const render + , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } } - where + handleAction (HandleDogForm dog) = logShow (dog :: Dog) - render :: Unit -> H.ParentHTML Query ChildQuery ChildSlot Aff - render st = - HH.div_ - [ HH.h1 "My Form" - , HH.slot unit F.component - { initialInputs, validators, render: renderFormless } - (HE.input Formless) - ] - - eval :: Query ~> H.ParentDSL Unit Query ChildQuery ChildSlot Void Aff - eval (Formless m a) = case m of - F.Submitted formOutput -> a <$ do - let form = F.unwrapOutputFields formOutput - -- Assuming some effectful computation to receive the ID - id <- registerUser { name: form.name, email: form.email1 } - let user = { name: form.name, email: form.email, id } - liftEffect $ Console.log $ "Got a user! " <> show (user :: User) - _ -> pure a + render = HH.slot F._formless unit (F.component spec) input handler + where + handler = Just <<< HandleDogForm ``` # Next Steps @@ -400,6 +122,4 @@ Ready to move past this simple example? Check out the examples, which vary in th - [Live examples / docs site](https://thomashoneyman.github.io/purescript-halogen-formless/) - [Source code for examples](https://github.com/thomashoneyman/purescript-halogen-formless/tree/master/example) -If you're curious to learn more about how to use renderless components effectively, or build your own: - -- [purescript-halogen-renderless](https://github.com/thomashoneyman/purescript-halogen-renderless) +Have any comments about the library or any ideas to improve it for your use case? Please file an issue or reach out on the [PureScript user group](https://discourse.purescript.org). diff --git a/src/Formless.purs b/src/Formless.purs index 009aa8b..0138bb7 100644 --- a/src/Formless.purs +++ b/src/Formless.purs @@ -7,25 +7,27 @@ -- | import Formless as F -- | ``` module Formless - ( module Formless.Class.Initial + ( module Formless.Action + , module Formless.Class.Initial , module Formless.Component , module Formless.Data.FormFieldResult + , module Formless.Query , module Formless.Retrieve , module Formless.Transform.Record , module Formless.Transform.Row , module Formless.Types.Component , module Formless.Types.Form , module Formless.Validation - , module Formless.Query ) where -import Formless.Class.Initial (class Initial, initial) -import Formless.Component (component) -import Formless.Data.FormFieldResult (FormFieldResult(..), _Error, _Success, fromEither, toMaybe) -import Formless.Retrieve (FormFieldGet, FormFieldLens, GetAll, GetError(..), GetInputField(..), GetOutput(..), GetResultField(..), GetTouchedField(..), _Field, _FieldError, _FieldInput, _FieldOutput, _FieldResult, _FieldTouched, getError, getErrorAll, getField, getInput, getInputAll, getOutput, getOutputAll, getResult, getResultAll, getTouched, getTouchedAll) -import Formless.Transform.Record (UnwrapField(..), WrapField(..), unwrapOutputFields, unwrapRecord, wrapInputFields, wrapInputFunctions, wrapRecord) -import Formless.Transform.Row (class MakeInputFieldsFromRow, class MakeSProxies, SProxies, makeSProxiesBuilder, mkInputFields, mkInputFieldsFromRowBuilder, mkSProxies) -import Formless.Types.Component (Component, DSL, Debouncer, HTML, HTML', Input, Input', InternalState(..), Message(..), Message', PublicState, Query(..), Query', State, StateRow, StateStore, ValidStatus(..)) -import Formless.Types.Form (ErrorType, FormField(..), FormFieldRow, FormProxy(..), InputField(..), InputFunction(..), InputType, OutputField(..), OutputType, U(..)) -import Formless.Validation (EmptyValidators(..), Validation(..), hoistFn, hoistFnE, hoistFnE_, hoistFnME, hoistFnME_, hoistFn_, noValidation, runValidation) -import Formless.Query (andThen, andThen_, asyncModifyValidate, asyncModifyValidate_, asyncSetValidate, asyncSetValidate_, getState, loadForm, loadForm_, modify, modifyAll, modifyAll_, modifyValidate, modifyValidateAll, modifyValidateAll_, modifyValidate_, modify_, raise, raise_, reset, resetAll, resetAll_, reset_, send, send', set, setAll, setAll_, setValidate, setValidateAll, setValidateAll_, setValidate_, set_, submit, submitReply, submit_, validate, validateAll, validateAll_, validate_) +import Formless.Action (asyncModifyValidate, asyncSetValidate, injAction, loadForm, modify, modifyAll, modifyValidate, modifyValidateAll, reset, resetAll, set, setAll, setValidate, setValidateAll, submit, validate, validateAll) +import Formless.Class.Initial (class Initial, initial) +import Formless.Component (component, defaultSpec, handleAction, handleQuery, raiseResult) +import Formless.Data.FormFieldResult (FormFieldResult(..), _Error, _Success, fromEither, toMaybe) +import Formless.Query (asQuery, injQuery, sendQuery, submitReply) +import Formless.Retrieve (FormFieldGet, FormFieldLens, GetAll, GetError(..), GetInputField(..), GetOutput(..), GetResultField(..), GetTouchedField(..), _Field, _FieldError, _FieldInput, _FieldOutput, _FieldResult, _FieldTouched, getError, getErrorAll, getField, getInput, getInputAll, getOutput, getOutputAll, getResult, getResultAll, getTouched, getTouchedAll) +import Formless.Transform.Record (UnwrapField(..), WrapField(..), unwrapOutputFields, unwrapRecord, wrapInputFields, wrapInputFunctions, wrapRecord) +import Formless.Transform.Row (class MakeInputFieldsFromRow, class MakeSProxies, SProxies, makeSProxiesBuilder, mkInputFields, mkInputFieldsFromRowBuilder, mkSProxies) +import Formless.Types.Component (Action, Action', Component, Component', ComponentHTML, ComponentHTML', Debouncer, HalogenM, HalogenM', Input, Input', InternalAction, InternalState(..), Event(..), Event', PublicAction, PublicState, Query, Query', QueryF(..), Slot, Slot', Spec, Spec', State, State', StateRow, ValidStatus(..), _formless) +import Formless.Types.Form (ErrorType, FormField(..), FormFieldRow, FormProxy(..), InputField(..), InputFunction(..), InputType, OutputField(..), OutputType, U(..)) +import Formless.Validation (EmptyValidators(..), Validation(..), hoistFn, hoistFnE, hoistFnE_, hoistFnME, hoistFnME_, hoistFn_, noValidation, noValidators, runValidation) diff --git a/src/Formless/Action.purs b/src/Formless/Action.purs new file mode 100644 index 0000000..5af5f72 --- /dev/null +++ b/src/Formless/Action.purs @@ -0,0 +1,291 @@ +-- | This module exports helpers for working with Formless actions, which you +-- | will use in your render function to attach to appropriate fields. Prefer +-- | these over using data constructors from the Formless action type. You can +-- | also freely extend Formless with more actions of your own using `injAction`. +module Formless.Action where + +import Prelude + +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype, wrap) +import Data.Symbol (class IsSymbol, SProxy(..)) +import Data.Time.Duration (Milliseconds) +import Data.Tuple (Tuple(..)) +import Data.Variant (Variant, inj) +import Formless.Class.Initial (class Initial, initial) +import Formless.Transform.Record (WrapField, wrapInputFields, wrapInputFunctions) +import Formless.Types.Component (Action) +import Formless.Types.Form (InputField, InputFunction, U(..)) +import Heterogeneous.Mapping as HM +import Prim.Row as Row + +-- | Inject your own action into the Formless component so it can be used in HTML +injAction :: forall form act. act -> Action form act +injAction = inj (SProxy :: _ "userAction") + +-- | Set the input value of a form field at the specified label. +-- | +-- | ```purescript +-- | [ HE.onValueInput $ Just <<< F.set _name ] +-- | ``` +set + :: forall form v sym inputs r e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) r inputs + => SProxy sym + -> i + -> Variant (modify :: form Variant InputFunction | v) +set sym i = + inj (SProxy :: _ "modify") (wrap (inj sym (wrap (const i)))) + +-- | Modify the input value of a form field at the specified label with the +-- | provided function. +-- | +-- | ```purescript +-- | [ HE.onChange \_ -> Just $ F.modify _enabled not ] +-- | ``` +modify + :: forall form v sym inputs r e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) r inputs + => SProxy sym + -> (i -> i) + -> Variant (modify :: form Variant InputFunction | v) +modify sym f = + inj (SProxy :: _ "modify") (wrap (inj sym (wrap f))) + +-- | Trigger validation on a form field +-- | +-- | ```purescript +-- | [ HE.onBlur \_ -> Just $ F.validate _name ] +-- | ``` +validate + :: forall form v sym us r e i o + . IsSymbol sym + => Newtype (form Variant U) (Variant us) + => Row.Cons sym (U e i o) r us + => SProxy sym + -> Variant (validate :: form Variant U | v) +validate sym = + inj (SProxy :: _ "validate") (wrap (inj sym U)) + +-- | Set the input value of a form field at the specified label, also triggering +-- | validation to run on the field. +-- | +-- | ```purescript +-- | [ HE.onValueInput $ Just <<< F.setValidate _name ] +-- | ``` +setValidate + :: forall form v sym inputs r e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) r inputs + => SProxy sym + -> i + -> Variant (modifyValidate :: Tuple (Maybe Milliseconds) (form Variant InputFunction) | v) +setValidate sym i = + inj (SProxy :: _ "modifyValidate") (Tuple Nothing (wrap (inj sym (wrap (const i))))) + +-- | Modify the input value of a form field at the specified label, also triggering +-- | validation to run on the field, with the provided function. +-- | +-- | ```purescript +-- | [ HE.onChange \_ -> Just $ F.modifyValidate _enabled not ] +-- | ``` +modifyValidate + :: forall form v sym inputs r e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) r inputs + => SProxy sym + -> (i -> i) + -> Variant (modifyValidate :: Tuple (Maybe Milliseconds) (form Variant InputFunction) | v) +modifyValidate sym f = + inj (SProxy :: _ "modifyValidate") (Tuple Nothing (wrap (inj sym (wrap f)))) + +-- | Set the input value of a form field at the specified label, while debouncing +-- | validation so that it only runs after the specified amount of time has elapsed +-- | since the last modification. Useful when you need to avoid expensive validation +-- | but do not want to wait for a blur event to validate. +-- | +-- | ```purescript +-- | [ HE.onValueInput $ Just <<< F.asncSetValidate (Milliseconds 300.0) _name ] +-- | ``` +asyncSetValidate + :: forall form v sym inputs r e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) r inputs + => Milliseconds + -> SProxy sym + -> i + -> Variant (modifyValidate :: Tuple (Maybe Milliseconds) (form Variant InputFunction) | v) +asyncSetValidate ms sym i = + inj (SProxy :: _ "modifyValidate") (Tuple (Just ms) (wrap (inj sym (wrap (const i))))) + +-- | Modify the input value of a form field at the specified label, while debouncing +-- | validation so that it only runs after the specified amount of time has elapsed +-- | since the last modification. Useful when you need to avoid expensive validation +-- | but do not want to wait for a blur event to validate. +-- | +-- | ```purescript +-- | [ HE.onChange \_ -> Just $ F.asncModifyValidate (Milliseconds 300.0) _enabled not ] +-- | ``` +asyncModifyValidate + :: forall form v sym inputs r e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) r inputs + => Milliseconds + -> SProxy sym + -> (i -> i) + -> Variant (modifyValidate :: Tuple (Maybe Milliseconds) (form Variant InputFunction) | v) +asyncModifyValidate ms s f = + inj (SProxy :: _ "modifyValidate") (Tuple (Just ms) (wrap (inj s (wrap f)))) + +-- | Reset the value of the specified form field to its default value +-- | according to the `Initial` type class. +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just $ F.reset _name ] +-- | ``` +reset + :: forall form v sym inputs r e i o + . IsSymbol sym + => Initial i + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) r inputs + => SProxy sym + -> Variant (reset :: form Variant InputFunction | v) +reset sym = + inj (SProxy :: _ "reset") (wrap (inj sym (wrap (const initial)))) + +-- | Provide a record of input fields to overwrite all current +-- | inputs. Unlike `loadForm`, this does not otherwise reset +-- | the form as if it were new. Similar to calling `set` on every +-- | field in the form. Does not run validation. +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just $ F.setAll +-- | { name: "Default Name" +-- | , enabled: false +-- | } +-- | ] +-- | ``` +setAll + :: forall form v is is' + . Newtype (form Record InputField) { | is' } + => HM.HMap WrapField { | is } { | is' } + => { | is } + -> Variant (setAll :: Tuple (form Record InputField) Boolean | v) +setAll is = + inj (SProxy :: _ "setAll") (Tuple (wrapInputFields is) false) + +-- | Provide a record of input functions to modify all current +-- | inputs. Similar to calling `modify` on every field in the form. +-- | Does not run validation. +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just $ F.modifyAll +-- | { name: \str -> "User: " <> str +-- | , enabled: \bool -> not bool +-- | } +-- | ] +-- | ``` +modifyAll + :: forall form v ifs' ifs + . Newtype (form Record InputFunction) { | ifs' } + => HM.HMap WrapField { | ifs } { | ifs' } + => { | ifs } + -> Variant (modifyAll :: Tuple (form Record InputFunction) Boolean | v) +modifyAll fs = + inj (SProxy :: _ "modifyAll") (Tuple (wrapInputFunctions fs) false) + +-- | Validate all fields in the form, collecting errors +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just F.validateAll ] +-- | ``` +validateAll :: forall v. Variant (validateAll :: Unit | v) +validateAll = + inj (SProxy :: _ "validateAll") unit + +-- | Provide a record of inputs to overwrite all current inputs without +-- | resetting the form (as `loadForm` does), and then validate the +-- | entire new set of fields. Similar to calling `setValidate` on every +-- | field in the form. +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just $ F.setValidateAll +-- | { name: "Default Name" +-- | , enabled: false +-- | } +-- | ] +-- | ``` +setValidateAll + :: forall form v is' is + . Newtype (form Record InputField) { | is' } + => HM.HMap WrapField { | is } { | is' } + => { | is } + -> Variant (setAll :: Tuple (form Record InputField) Boolean | v) +setValidateAll is = + inj (SProxy :: _ "setAll") (Tuple (wrapInputFields is) true) + +-- | Provide a record of input functions to modify all current +-- | inputs, and then validate all fields. Similar to calling +-- | `modifyValidate` on every field in the form. +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just $ F.modifyValidateAll +-- | { name: \str -> "User: " <> str +-- | , enabled: \bool -> not bool +-- | } +-- | ] +-- | ``` +modifyValidateAll + :: forall form v ifs' ifs + . Newtype (form Record InputFunction) { | ifs' } + => HM.HMap WrapField { | ifs } { | ifs' } + => { | ifs } + -> Variant (modifyAll :: Tuple (form Record InputFunction) Boolean | v) +modifyValidateAll ifs = + inj (SProxy :: _ "modifyAll") (Tuple (wrapInputFunctions ifs) true) + +-- | Reset all fields to their initial values, and reset the form +-- | to its initial pristine state, no touched fields. +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just F.resetAll ] +-- | ``` +resetAll :: forall v. Variant (resetAll :: Unit | v) +resetAll = + inj (SProxy :: _ "resetAll") unit + +-- | Submit the form, which will trigger a `Submitted` result if the +-- | form validates successfully. +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just F.submit ] +-- | ``` +submit :: forall v. Variant (submit :: Unit | v) +submit = + inj (SProxy :: _ "submit") unit + +-- | Load a form from a set of existing inputs. Useful for when you need to mount +-- | Formless, perform some other actions like request data from the server, and +-- | then load an existing set of inputs. +-- | +-- | ```purescript +-- | [ HE.onClick \_ -> Just $ F.loadForm $ F.wrapInputFields +-- | { name: "" +-- | , enabled: false +-- | } +-- | ] +-- | ``` +loadForm + :: forall form v + . form Record InputField + -> Variant (loadForm :: form Record InputField | v) +loadForm = inj (SProxy :: _ "loadForm") diff --git a/src/Formless/Class/Initial.purs b/src/Formless/Class/Initial.purs index e0b9563..47da2cb 100644 --- a/src/Formless/Class/Initial.purs +++ b/src/Formless/Class/Initial.purs @@ -57,4 +57,3 @@ instance initialTuple :: (Initial a, Initial b) => Initial (Tuple a b) where instance initialRecord :: (RL.RowToList row list, MonoidRecord list row row) => Initial (Record row) where initial = mempty - diff --git a/src/Formless/Component.purs b/src/Formless/Component.purs index 9faf2c4..27b8b22 100644 --- a/src/Formless/Component.purs +++ b/src/Formless/Component.purs @@ -2,48 +2,102 @@ module Formless.Component where import Prelude -import Control.Comonad (extract) -import Control.Comonad.Store (store) import Control.Monad.Free (liftF) -import Data.Coyoneda (liftCoyoneda) import Data.Eq (class EqRecord) +import Data.Functor.Variant as VF import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, over, unwrap) import Data.Symbol (SProxy(..)) import Data.Traversable (traverse_) -import Data.Variant (Variant) +import Data.Tuple (Tuple(..)) +import Data.Variant (Variant, match, inj, expand) import Effect.Aff.Class (class MonadAff) import Effect.Ref as Ref +import Formless.Action as FA import Formless.Data.FormFieldResult (FormFieldResult(..)) +import Formless.Internal.Component as IC import Formless.Internal.Debounce (debounceForm) -import Formless.Internal.Transform as Internal -import Formless.Types.Component (Component, DSL, Input, InternalState(..), Message(..), PublicState, Query(..), State, StateStore, ValidStatus(..)) -import Formless.Types.Form (FormField, InputField, InputFunction, OutputField, U) +import Formless.Internal.Transform as IT +import Formless.Transform.Record (UnwrapField, unwrapOutputFields) +import Formless.Transform.Row (mkInputFields, class MakeInputFieldsFromRow) +import Formless.Types.Component (Action, Component, HalogenM, Input, InternalState(..), Event(..), PublicAction, Query, QueryF(..), Spec, State, ValidStatus(..)) +import Formless.Types.Form (FormField, InputField, InputFunction, OutputField, U, FormProxy(..)) import Formless.Validation (Validation) import Halogen as H -import Halogen.HTML.Events as HE +import Halogen.HTML as HH +import Heterogeneous.Mapping as HM +import Prim.Row as Row import Prim.RowList as RL -import Record as Record -import Renderless.State (getState, modifyState, modifyState_, modifyStore_) +import Record.Builder as Builder import Unsafe.Coerce (unsafeCoerce) --- | The Formless component +-- | The default spec, which can be overridden by whatever functions you need +-- | to extend the component. For example: +-- | +-- | ```purescript +-- | mySpec = F.defaultSpec { render = myRender } +-- | ``` +defaultSpec :: forall form st query act slots input msg m. Spec form st query act slots input msg m +defaultSpec = + { render: const (HH.text mempty) + , handleAction: const (pure unit) + , handleQuery: const (pure Nothing) + , handleEvent: const (pure unit) + , receive: const Nothing + , initialize: Nothing + , finalize: Nothing + } + +-- | A convenience function for raising a form's validated and unwrapped outputs +-- | as its only message to a parent component. Useful when you only want to be +-- | notified with a form's successfully-parsed data. For example: +-- | +-- | ```purescript +-- | type User = { name :: String, email :: Email } +-- | +-- | newtype UserForm r f = UserForm (r +-- | ( name :: f Void String String +-- | , email :: f EmailError String Email +-- | )) +-- | derive instance newtypeUserForm :: Newtype (UserForm r f) _ +-- | +-- | -- we only want to handle our `User` type on successful submission; we can +-- | -- use `raiseResult` as our `handleEvent` function to do this conveniently. +-- | formSpec = F.defaultSpec { handleEvent = raiseResult } +-- | +-- | -- the parent can now just handle the `User` output +-- | data ParentAction = HandleForm User +-- | +-- | type ChildSlots = ( formless :: F.Slot' UserForm User Unit ) +-- | ``` +raiseResult + :: forall form st act slots wrappedOutput output m + . Newtype (form Record OutputField) { | wrappedOutput } + => HM.HMap UnwrapField { | wrappedOutput } { | output } + => Event form st + -> HalogenM form st act slots { | output } m Unit +raiseResult = case _ of + Submitted out -> H.raise (unwrapOutputFields out) + _ -> pure unit + +-- | The Formless component, which takes a `spec` and provides a running form +-- | component from it. component - :: ∀ pq cq cs form m is ixs ivs fs fxs us vs os ifs ivfs - . Ord cs - => MonadAff m + :: forall form st query act slots input msg m is ixs ivs fs fxs us vs os ifs ivfs + . MonadAff m => RL.RowToList is ixs => RL.RowToList fs fxs => EqRecord ixs is - => Internal.InputFieldsToFormFields ixs is fs - => Internal.FormFieldsToInputFields fxs fs is - => Internal.CountErrors fxs fs - => Internal.AllTouched fxs fs - => Internal.SetFormFieldsTouched fxs fs fs - => Internal.ReplaceFormFieldInputs is fxs fs fs - => Internal.ModifyAll ifs fxs fs fs - => Internal.ValidateAll vs fxs fs fs m - => Internal.FormFieldToMaybeOutput fxs fs os + => IT.InputFieldsToFormFields ixs is fs + => IT.FormFieldsToInputFields fxs fs is + => IT.CountErrors fxs fs + => IT.AllTouched fxs fs + => IT.SetFormFieldsTouched fxs fs fs + => IT.ReplaceFormFieldInputs is fxs fs fs + => IT.ModifyAll ifs fxs fs fs + => IT.ValidateAll vs fxs fs fs m + => IT.FormFieldToMaybeOutput fxs fs os + => MakeInputFieldsFromRow ixs is is => Newtype (form Record InputField) { | is } => Newtype (form Record InputFunction) { | ifs } => Newtype (form Record FormField) { | fs } @@ -52,248 +106,280 @@ component => Newtype (form Variant InputField) (Variant ivs) => Newtype (form Variant InputFunction) (Variant ivfs) => Newtype (form Variant U) (Variant us) - => Component pq cq cs form m -component = - H.lifecycleParentComponent - { initialState - , render: extract - , eval - , receiver: HE.input Receive - , initializer: Just $ H.action Initialize - , finalizer: Nothing - } + => Row.Lacks "validators" st + => Row.Lacks "initialInputs" st + => Row.Lacks "validity" st + => Row.Lacks "dirty" st + => Row.Lacks "errors" st + => Row.Lacks "submitAttempts" st + => Row.Lacks "submitting" st + => Row.Lacks "form" st + => Row.Lacks "internal" st + => (input -> Input form st m) + -> Spec form st query act slots input msg m + -> Component form query slots input msg m +component mkInput spec = H.mkComponent + { initialState: initialState <<< mkInput + , render: IC.getPublicState >>> spec.render + , eval: H.mkEval + { handleQuery: \q -> handleQuery spec.handleQuery spec.handleEvent q + , handleAction: \act -> handleAction spec.handleAction spec.handleEvent act + , initialize: Just (inj (SProxy :: _ "initialize") spec.initialize) + , receive: map (map FA.injAction) spec.receive + , finalize: map FA.injAction spec.finalize + } + } where - - initialState :: Input pq cq cs form m -> StateStore pq cq cs form m - initialState { initialInputs, validators, render } = store render $ - { validity: Incomplete - , dirty: false - , errors: 0 - , submitAttempts: 0 - , submitting: false - , form: Internal.inputFieldsToFormFields initialInputs - , internal: InternalState - { allTouched: false - , initialInputs - , validators - , debounceRef: Nothing - , validationRef: Nothing - } - } - - eval :: Query pq cq cs form m ~> DSL pq cq cs form m - eval = case _ of - Initialize a -> do + -- It's necessary to build from the original input because we have no idea + -- what additional fields may have been provided by the user. + initialState :: Input form st m -> State form st m + initialState input = Builder.build pipeline input + where + initialInputs = case input.initialInputs of + Nothing -> mkInputFields (FormProxy :: FormProxy form) + Just inputs -> inputs + initialForm = IT.inputFieldsToFormFields initialInputs + internalState = InternalState + { allTouched: false + , initialInputs + , validators: input.validators + , debounceRef: Nothing + , validationRef: Nothing + } + pipeline = + Builder.delete (SProxy :: _ "validators") + >>> Builder.delete (SProxy :: _ "initialInputs") + >>> Builder.insert (SProxy :: _ "validity") Incomplete + >>> Builder.insert (SProxy :: _ "dirty") false + >>> Builder.insert (SProxy :: _ "errors") 0 + >>> Builder.insert (SProxy :: _ "submitAttempts") 0 + >>> Builder.insert (SProxy :: _ "submitting") false + >>> Builder.insert (SProxy :: _ "form") initialForm + >>> Builder.insert (SProxy :: _ "internal") internalState + +handleAction + :: forall form st act slots msg m is ixs ivs fs fxs us vs os ifs ivfs + . MonadAff m + => RL.RowToList is ixs + => RL.RowToList fs fxs + => EqRecord ixs is + => IT.InputFieldsToFormFields ixs is fs + => IT.FormFieldsToInputFields fxs fs is + => IT.CountErrors fxs fs + => IT.AllTouched fxs fs + => IT.SetFormFieldsTouched fxs fs fs + => IT.ReplaceFormFieldInputs is fxs fs fs + => IT.ModifyAll ifs fxs fs fs + => IT.ValidateAll vs fxs fs fs m + => IT.FormFieldToMaybeOutput fxs fs os + => Newtype (form Record InputField) { | is } + => Newtype (form Record InputFunction) { | ifs } + => Newtype (form Record FormField) { | fs } + => Newtype (form Record OutputField) { | os } + => Newtype (form Record (Validation form m)) { | vs } + => Newtype (form Variant InputField) (Variant ivs) + => Newtype (form Variant InputFunction) (Variant ivfs) + => Newtype (form Variant U) (Variant us) + => Row.Lacks "internal" st + => (act -> HalogenM form st act slots msg m Unit) + -> (Event form st -> HalogenM form st act slots msg m Unit) + -> Action form act + -> HalogenM form st act slots msg m Unit +handleAction handleAction' handleEvent action = flip match action + { initialize: \mbAction -> do dr <- H.liftEffect $ Ref.new Nothing vr <- H.liftEffect $ Ref.new Nothing - modifyState_ \st -> st - { internal = over InternalState - (_ - { debounceRef = Just dr - , validationRef = Just vr - } - ) - st.internal - } - pure a - - Modify variant a -> do - modifyState_ \st -> st - { form = Internal.unsafeModifyInputVariant identity variant st.form } - eval $ SyncFormData a - - Validate variant a -> do - st <- getState - form <- H.lift - $ Internal.unsafeRunValidationVariant variant (unwrap st.internal).validators st.form - modifyState_ _ { form = form } - eval $ SyncFormData a + let setFields rec = rec { debounceRef = Just dr, validationRef = Just vr } + H.modify_ \st -> st { internal = over InternalState setFields st.internal } + traverse_ handleAction' mbAction - -- Provided as a separate query to minimize state updates / re-renders - ModifyValidate milliseconds variant a -> do + , syncFormData: \_ -> do + st <- H.get let - modifyWith - :: (forall e o. FormFieldResult e o -> FormFieldResult e o) - -> DSL pq cq cs form m (form Record FormField) - modifyWith f = do - s <- modifyState \st -> st { form = Internal.unsafeModifyInputVariant f variant st.form } - pure s.form - - validate = do - st <- getState - let vs = (unwrap st.internal).validators - form <- H.lift $ Internal.unsafeRunValidationVariant (unsafeCoerce variant) vs st.form - modifyState_ _ { form = form } - pure form - - case milliseconds of - Nothing -> do - _ <- modifyWith identity - _ <- validate - eval (SyncFormData a) - Just ms -> do - debounceForm - ms - (modifyWith identity) - (modifyWith (const Validating) *> validate) - (eval $ SyncFormData a) - pure a - - Reset variant a -> do - modifyState_ \st -> st - { form = Internal.unsafeModifyInputVariant identity variant st.form - , internal = over InternalState (_ { allTouched = false }) st.internal - } - eval $ SyncFormData a - - SetAll formInputs a -> do - new <- modifyState \st -> st - { form = Internal.replaceFormFieldInputs formInputs st.form } - H.raise $ Changed $ getPublicState new - eval $ SyncFormData a - - ModifyAll formInputs a -> do - new <- modifyState \st -> st - { form = Internal.modifyAll formInputs st.form } - H.raise $ Changed $ getPublicState new - eval $ SyncFormData a - - ValidateAll a -> do - st <- getState - form <- H.lift $ Internal.validateAll (unwrap st.internal).validators st.form - modifyState_ _ { form = form } - eval $ SyncFormData a - - -- A query to sync the overall state of the form after an individual field change - -- or overall validation. - SyncFormData a -> do - st <- getState - - let errors = Internal.countErrors st.form - dirty = not $ eq - (unwrap (Internal.formFieldsToInputFields st.form)) - (unwrap (unwrap st.internal).initialInputs) + errors = IT.countErrors st.form + dirty = not $ eq + (unwrap (IT.formFieldsToInputFields st.form)) + (unwrap (unwrap st.internal).initialInputs) -- Need to verify the validity status of the form. newState <- case (unwrap st.internal).allTouched of - true -> modifyState _ - { validity = if not (st.errors == 0) then Invalid else Valid + true -> H.modify _ + { validity = if errors == 0 then Valid else Invalid , errors = errors , dirty = dirty } -- If not all fields are touched, then we need to quickly sync the form state -- to verify this is actually the case. - _ -> case Internal.allTouched st.form of + _ -> case IT.allTouched st.form of -- The sync revealed all fields really have been touched - true -> modifyState _ - { validity = if not (st.errors == 0) then Invalid else Valid + true -> H.modify _ + { validity = if errors == 0 then Valid else Invalid , internal = over InternalState (_ { allTouched = true }) st.internal , errors = errors , dirty = dirty } -- The sync revealed that not all fields have been touched - _ -> modifyState _ { validity = Incomplete, errors = errors, dirty = dirty } + _ -> H.modify _ { validity = Incomplete, errors = errors, dirty = dirty } + + handleEvent $ Changed $ IC.getPublicState newState - H.raise $ Changed $ getPublicState newState - pure a + , userAction: \act -> + handleAction' act - -- Submit, also raising a message to the user - Submit a -> do - mbForm <- runSubmit - traverse_ (H.raise <<< Submitted) mbForm - pure a + , modify: \variant -> do + H.modify_ \st -> st + { form = IT.unsafeModifyInputVariant identity variant st.form } + handleAction handleAction' handleEvent sync - -- Submit, not raising a message - SubmitReply reply -> do - mbForm <- runSubmit - pure $ reply mbForm + , validate: \variant -> do + st <- H.get + let validators = (unwrap st.internal).validators + form <- H.lift do + IT.unsafeRunValidationVariant variant validators st.form + H.modify_ _ { form = form } + handleAction handleAction' handleEvent sync - -- | Should completely reset the form to its initial state - ResetAll a -> do - new <- modifyState \st -> st + , modifyValidate: \(Tuple milliseconds variant) -> do + let + modifyWith + :: (forall e o. FormFieldResult e o -> FormFieldResult e o) + -> HalogenM form st act slots msg m (form Record FormField) + modifyWith f = do + st <- H.modify \s -> s + { form = IT.unsafeModifyInputVariant f variant s.form } + pure st.form + + validate = do + st <- H.get + let vs = (unwrap st.internal).validators + form <- H.lift do + IT.unsafeRunValidationVariant (unsafeCoerce variant) vs st.form + H.modify_ _ { form = form } + pure form + + case milliseconds of + Nothing -> + modifyWith identity *> validate *> handleAction handleAction' handleEvent sync + Just ms -> + debounceForm + ms + (modifyWith identity) + (modifyWith (const Validating) *> validate) + (handleAction handleAction' handleEvent sync) + + , reset: \variant -> do + H.modify_ \st -> st + { form = IT.unsafeModifyInputVariant identity variant st.form + , internal = over InternalState (_ { allTouched = false }) st.internal + } + handleAction handleAction' handleEvent sync + + , setAll: \(Tuple formInputs shouldValidate) -> do + new <- H.modify \st -> st + { form = IT.replaceFormFieldInputs formInputs st.form } + handleEvent $ Changed $ IC.getPublicState new + case shouldValidate of + true -> handleAction handleAction' handleEvent FA.validateAll + _ -> handleAction handleAction' handleEvent sync + + , modifyAll: \(Tuple formInputs shouldValidate) -> do + new <- H.modify \st -> st + { form = IT.modifyAll formInputs st.form } + handleEvent $ Changed $ IC.getPublicState new + case shouldValidate of + true -> handleAction handleAction' handleEvent FA.validateAll + _ -> handleAction handleAction' handleEvent sync + + , validateAll: \_ -> do + st <- H.get + form <- H.lift $ IT.validateAll (unwrap st.internal).validators st.form + H.modify_ _ { form = form } + handleAction handleAction' handleEvent sync + + , resetAll: \_ -> do + new <- H.modify \st -> st { validity = Incomplete , dirty = false , errors = 0 , submitAttempts = 0 , submitting = false - , form = Internal.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form - , internal = over InternalState (_ { allTouched = false }) st.internal + , form = + IT.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form + , internal = + over InternalState (_ { allTouched = false }) st.internal } - H.raise $ Changed $ getPublicState new - pure a - - GetState reply -> do - st <- getState - pure $ reply $ getPublicState st - - Send cs cq -> H.HalogenM $ liftF $ H.ChildQuery cs $ liftCoyoneda cq + handleEvent $ Changed $ IC.getPublicState new - Raise query a -> do - H.raise (Emit query) - pure a + , submit: \_ -> do + _ <- IC.preSubmit + _ <- handleAction handleAction' handleEvent FA.validateAll + IC.submit >>= traverse_ (Submitted >>> handleEvent) - LoadForm formInputs a -> do - st <- getState - new <- modifyState _ + , loadForm: \formInputs -> do + let setFields rec = rec { allTouched = false, initialInputs = formInputs } + st <- H.get + new <- H.modify _ { validity = Incomplete , dirty = false , errors = 0 , submitAttempts = 0 , submitting = false - , form = Internal.replaceFormFieldInputs formInputs st.form - , internal = over - InternalState - (_ - { allTouched = false - , initialInputs = formInputs - } - ) - st.internal + , form = IT.replaceFormFieldInputs formInputs st.form + , internal = over InternalState setFields st.internal } + handleEvent $ Changed $ IC.getPublicState new + } + where + sync :: Action form act + sync = inj (SProxy :: SProxy "syncFormData") unit - H.raise $ Changed $ getPublicState new - pure a - - Receive { render, validators } a -> do - let applyOver = over InternalState (_ { validators = validators }) - modifyStore_ render (\st -> st { internal = applyOver st.internal }) - pure a - - AndThen q1 q2 a -> do - void (eval q1) - void (eval q2) - pure a - - -- Remove internal fields and return the public state - getPublicState :: State form m -> PublicState form - getPublicState = Record.delete (SProxy :: SProxy "internal") - - -- Run submission without raising messages or replies - runSubmit :: DSL pq cq cs form m (Maybe (form Record OutputField)) - runSubmit = do - init <- modifyState \st -> st - { submitAttempts = st.submitAttempts + 1 - , submitting = true - } - - -- For performance purposes, avoid running this if possible - let internal = unwrap init.internal - when (not internal.allTouched) do - modifyState_ _ - { form = Internal.setFormFieldsTouched init.form - , internal = over InternalState (_ { allTouched = true }) init.internal - } - - -- Necessary to validate after fields are touched, but before parsing - _ <- eval $ ValidateAll unit - - -- For performance purposes, only attempt to submit if the form is valid - validated <- getState - modifyState_ \st -> st { submitting = false } - pure $ - if validated.validity == Valid - then Internal.formFieldsToMaybeOutputFields validated.form - else Nothing +handleQuery + :: forall form st query act slots msg m a is ixs ivs fs fxs us vs os ifs ivfs + . MonadAff m + => RL.RowToList is ixs + => RL.RowToList fs fxs + => EqRecord ixs is + => IT.InputFieldsToFormFields ixs is fs + => IT.FormFieldsToInputFields fxs fs is + => IT.CountErrors fxs fs + => IT.AllTouched fxs fs + => IT.SetFormFieldsTouched fxs fs fs + => IT.ReplaceFormFieldInputs is fxs fs fs + => IT.ModifyAll ifs fxs fs fs + => IT.ValidateAll vs fxs fs fs m + => IT.FormFieldToMaybeOutput fxs fs os + => Newtype (form Record InputField) { | is } + => Newtype (form Record InputFunction) { | ifs } + => Newtype (form Record FormField) { | fs } + => Newtype (form Record OutputField) { | os } + => Newtype (form Record (Validation form m)) { | vs } + => Newtype (form Variant InputField) (Variant ivs) + => Newtype (form Variant InputFunction) (Variant ivfs) + => Newtype (form Variant U) (Variant us) + => Row.Lacks "internal" st + => (forall b. query b -> HalogenM form st act slots msg m (Maybe b)) + -> (Event form st -> HalogenM form st act slots msg m Unit) + -> Query form query slots a + -> HalogenM form st act slots msg m (Maybe a) +handleQuery handleQuery' handleEvent = VF.match + { query: case _ of + SubmitReply reply -> do + _ <- IC.preSubmit + _ <- handleAction (const (pure unit)) handleEvent FA.validateAll + mbForm <- IC.submit + pure $ Just $ reply mbForm + + SendQuery box -> + H.HalogenM $ liftF $ H.ChildQuery box + + AsQuery (act :: Variant (PublicAction form)) a -> Just a <$ + handleAction + (const (pure unit)) + handleEvent + ((expand act) :: Action form act) + + , userQuery: \q -> handleQuery' q + } diff --git a/src/Formless/Data/FormFieldResult.purs b/src/Formless/Data/FormFieldResult.purs index 4e3274d..f483ec8 100644 --- a/src/Formless/Data/FormFieldResult.purs +++ b/src/Formless/Data/FormFieldResult.purs @@ -58,4 +58,4 @@ _Error = prism' Error case _ of _Success :: forall e o. Prism' (FormFieldResult e o) o _Success = prism' Success case _ of Success o -> Just o - _ -> Nothing \ No newline at end of file + _ -> Nothing diff --git a/src/Formless/Internal/Component.purs b/src/Formless/Internal/Component.purs new file mode 100644 index 0000000..c3999f5 --- /dev/null +++ b/src/Formless/Internal/Component.purs @@ -0,0 +1,73 @@ +module Formless.Internal.Component where + +import Prelude + +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype, over, unwrap) +import Data.Symbol (SProxy(..)) +import Effect.Aff.Class (class MonadAff) +import Formless.Internal.Transform as Internal +import Formless.Types.Component (HalogenM, InternalState(..), PublicState, State, ValidStatus(..)) +import Formless.Types.Form (FormField, OutputField) +import Formless.Validation (Validation) +import Halogen as H +import Prim.Row as Row +import Prim.RowList as RL +import Record.Builder as Builder + +-- Remove internal fields and user-supplied fields to return the public state +getPublicState + :: forall form st m + . Row.Lacks "internal" st + => State form st m + -> PublicState form st +getPublicState = Builder.build (Builder.delete (SProxy :: SProxy "internal")) + +preSubmit + :: forall form st act ps msg m fs fxs os vs + . MonadAff m + => RL.RowToList fs fxs + => Internal.AllTouched fxs fs + => Internal.SetFormFieldsTouched fxs fs fs + => Internal.ValidateAll vs fxs fs fs m + => Internal.FormFieldToMaybeOutput fxs fs os + => Internal.ValidateAll vs fxs fs fs m + => Newtype (form Record FormField) { | fs } + => Newtype (form Record OutputField) { | os } + => Newtype (form Record (Validation form m)) { | vs } + => HalogenM form st act ps msg m Unit +preSubmit = do + init <- H.modify \st -> st + { submitAttempts = st.submitAttempts + 1 + , submitting = true + } + + -- For performance purposes, avoid running this if possible + let internal = unwrap init.internal + when (not internal.allTouched) do + H.modify_ _ + { form = Internal.setFormFieldsTouched init.form + , internal = over InternalState (_ { allTouched = true }) init.internal + } + +submit + :: forall form st act ps msg m fs fxs os vs + . MonadAff m + => RL.RowToList fs fxs + => Internal.AllTouched fxs fs + => Internal.SetFormFieldsTouched fxs fs fs + => Internal.ValidateAll vs fxs fs fs m + => Internal.FormFieldToMaybeOutput fxs fs os + => Internal.ValidateAll vs fxs fs fs m + => Newtype (form Record FormField) { | fs } + => Newtype (form Record OutputField) { | os } + => Newtype (form Record (Validation form m)) { | vs } + => HalogenM form st act ps msg m (Maybe (form Record OutputField)) +submit = do + -- For performance purposes, only attempt to submit if the form is valid + validated <- H.get + H.modify_ _ { submitting = false } + + pure case validated.validity of + Valid -> Internal.formFieldsToMaybeOutputFields validated.form + _ -> Nothing diff --git a/src/Formless/Internal/Debounce.purs b/src/Formless/Internal/Debounce.purs index 2081175..f65b582 100755 --- a/src/Formless/Internal/Debounce.purs +++ b/src/Formless/Internal/Debounce.purs @@ -4,38 +4,37 @@ import Prelude import Data.Maybe (Maybe(..)) import Data.Newtype (unwrap) -import Data.Traversable (traverse, traverse_) -import Effect.Aff (Error, Fiber, Milliseconds, delay, error, forkAff, killFiber) +import Data.Traversable (traverse, traverse_, for_) +import Effect.Aff (Fiber, Milliseconds, delay, error, forkAff, killFiber) import Effect.Aff.AVar (AVar) import Effect.Aff.AVar as AVar import Effect.Aff.Class (class MonadAff) import Effect.Ref (Ref) import Effect.Ref as Ref -import Formless.Types.Component (DSL) +import Formless.Types.Component (HalogenM) import Formless.Types.Form (FormField) import Halogen as H -import Renderless.State (getState, modifyState_) -- | A helper function to debounce actions on the form and form fields. Implemented -- | to reduce type variables necessary in the `State` type -debounceForm - :: forall pq cq cs form m a +debounceForm + :: forall form st act ps msg m a . MonadAff m => Milliseconds - -> DSL pq cq cs form m (form Record FormField) - -> DSL pq cq cs form m (form Record FormField) - -> DSL pq cq cs form m a - -> DSL pq cq cs form m Unit + -> HalogenM form st act ps msg m (form Record FormField) + -> HalogenM form st act ps msg m (form Record FormField) + -> HalogenM form st act ps msg m a + -> HalogenM form st act ps msg m Unit debounceForm ms pre post last = do - state <- getState + state <- H.get - let + let dbRef = (unwrap state.internal).debounceRef vdRef = (unwrap state.internal).validationRef -- if there is a running validation, cancel it - traverse_ (\f -> H.lift $ f $ error "times' up!") =<< readRef vdRef + readRef vdRef >>= traverse_ H.kill debouncer <- H.liftEffect $ map join $ traverse Ref.read dbRef case debouncer of @@ -43,51 +42,47 @@ debounceForm ms pre post last = do var <- H.liftAff $ AVar.empty fiber <- mkFiber var - _ <- H.fork do - _ <- H.liftAff (AVar.take var) + _ <- H.fork do + void $ H.liftAff (AVar.take var) H.liftEffect $ traverse_ (Ref.write Nothing) dbRef atomic post (Just last) - H.liftEffect $ traverse_ (Ref.write $ Just { var, fiber }) dbRef + H.liftEffect $ for_ dbRef $ Ref.write (Just { var, fiber }) atomic pre Nothing Just db -> do let var = db.var void $ killFiber' db.fiber fiber <- mkFiber var - H.liftEffect $ traverse_ (Ref.write $ Just { var, fiber }) dbRef - - where + H.liftEffect $ for_ dbRef $ Ref.write (Just { var, fiber }) - mkFiber :: AVar Unit -> DSL pq cq cs form m (Fiber Unit) - mkFiber v = H.liftAff $ forkAff do - delay ms + where + mkFiber :: AVar Unit -> HalogenM form st act ps msg m (Fiber Unit) + mkFiber v = H.liftAff $ forkAff do + delay ms AVar.put unit v killFiber' :: forall x n. MonadAff n => Fiber x -> n Unit killFiber' = H.liftAff <<< killFiber (error ("time's up!")) - readRef :: forall x n. MonadAff n => Maybe (Ref (Maybe x)) -> n (Maybe x) + readRef :: forall x n. MonadAff n => Maybe (Ref (Maybe x)) -> n (Maybe x) readRef = H.liftEffect <<< map join <<< traverse Ref.read - atomic + atomic :: forall n - . MonadAff n - => DSL pq cq cs form n (form Record FormField) - -> Maybe (DSL pq cq cs form n a) - -> DSL pq cq cs form n Unit + . MonadAff n + => HalogenM form st act ps msg n (form Record FormField) + -> Maybe (HalogenM form st act ps msg n a) + -> HalogenM form st act ps msg n Unit atomic process maybeLast = do - state <- getState + state <- H.get let ref = (unwrap state.internal).validationRef - canceller <- readRef ref - traverse_ (\(f :: Error -> n Unit) -> H.lift $ f $ error "new action") canceller - H.liftEffect $ traverse_ (Ref.write Nothing) ref - - cancel <- H.fork do + mbRef <- readRef ref + for_ mbRef H.kill + H.liftEffect $ for_ ref $ Ref.write Nothing + forkId <- H.fork do form <- process - modifyState_ _ { form = form } - H.liftEffect $ traverse_ (Ref.write Nothing) ref - traverse_ identity maybeLast - - H.liftEffect $ traverse_ (Ref.write (Just cancel)) ref - pure unit \ No newline at end of file + H.modify_ _ { form = form } + H.liftEffect $ for_ ref $ Ref.write Nothing + for_ maybeLast identity + H.liftEffect $ for_ ref $ Ref.write (Just forkId) diff --git a/src/Formless/Internal/Transform.purs b/src/Formless/Internal/Transform.purs index 9d7a374..93b9aeb 100644 --- a/src/Formless/Internal/Transform.purs +++ b/src/Formless/Internal/Transform.purs @@ -17,7 +17,7 @@ import Record as Record import Record.Builder (Builder) import Record.Builder as Builder import Record.Unsafe (unsafeGet, unsafeSet) -import Type.Row (RLProxy(..)) +import Type.Data.RowList (RLProxy(..)) import Unsafe.Coerce (unsafeCoerce) ---------- @@ -169,8 +169,11 @@ unsafeModifyInputVariant f var rec = wrap $ unsafeSet (fst rep) val (unwrap rec) val :: ∀ e i o. FormField e i o val = case unsafeGet (fst rep) (unwrap rec) of - FormField x -> FormField $ x - { input = unwrap (snd rep) $ x.input, result = f x.result } + FormField x -> FormField $ x + { input = unwrap (snd rep) $ x.input + , touched = true + , result = f x.result + } unsafeRunValidationVariant :: ∀ form x y z m @@ -429,7 +432,7 @@ instance replaceFormFieldInputsTouchedCons ) => ReplaceFormFieldInputs is (RL.Cons name (FormField e i o) tail) row to where replaceFormFieldInputsBuilder ir _ fr = first <<< rest - where + where _name = SProxy :: SProxy name i = Record.get _name ir f = unwrap $ Record.get _name fr diff --git a/src/Formless/Query.purs b/src/Formless/Query.purs index c3bf546..68469e1 100644 --- a/src/Formless/Query.purs +++ b/src/Formless/Query.purs @@ -1,449 +1,87 @@ --- | This module exports helpers for working with Formless queries. --- | Since many queries are used as actions and may involve injecting --- | variants, these helpers are provided to remove any associated --- | boilerplate. Prefer these over using data constructors from the --- | Formless query algebra. +-- | This module exports helpers for working with Formless queries. Action-style +-- | queries are already specialized to `Unit` for you. Prefer these over using +-- | data constructors from the Formless query algebra. Remember that you can +-- | freely extend the Formless query algebra with your own queries by using the +-- | `injQuery` function. module Formless.Query where import Prelude -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype, wrap) -import Data.Symbol (class IsSymbol, SProxy) -import Data.Time.Duration (Milliseconds) -import Data.Variant (Variant, inj) -import Formless.Class.Initial (class Initial, initial) -import Formless.Transform.Record (WrapField, wrapInputFields, wrapInputFunctions) -import Formless.Types.Component (Query(..), PublicState) -import Formless.Types.Form (InputField, InputFunction, OutputField, U(..)) -import Halogen (request) as H -import Halogen.Component.ChildPath (ChildPath, injQuery, injSlot) -import Heterogeneous.Mapping as HM +import Data.Functor.Variant as VF +import Data.Maybe (Maybe(..), maybe) +import Data.Symbol (class IsSymbol, SProxy(..)) +import Data.Variant (Variant) +import Formless.Types.Component (QueryF(..), Query, PublicAction) +import Formless.Types.Form (OutputField) +import Halogen as H +import Halogen.Data.Slot as Slot +import Halogen.Query.ChildQuery as CQ import Prim.Row as Row --- | Send a query transparently through Formless, when you only have one kind of child --- | component. Use when you would use `Halogen.query`. -send :: ∀ pq cs cq form m a - . cs - -> cq a - -> Query pq cq cs form m a -send p q = Send p q - --- | Send a query transparently through Formless, when you are using several --- | different types of child components and the component needs a child path --- | to dispatch the query to. Use when you would use `Halogen.query'`. -send' :: ∀ pq cq' cs' cs cq form m a - . ChildPath cq cq' cs cs' - -> cs - -> cq a - -> Query pq cq' cs' form m a -send' path p q = Send (injSlot path p) (injQuery path q) - --- | Submit the form, which will trigger a `Submitted` result if the --- | form validates successfully. -submit - :: ∀ pq cq cs form m a - . a - -> Query pq cq cs form m a -submit = Submit - --- | `submit` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -submit_ - :: ∀ pq cq cs form m - . Query pq cq cs form m Unit -submit_ = Submit unit - --- | Imperatively submit the form and collect the result of submission, without --- | triggering a `Submitted` message. Useful when you need to submit multiple --- | forms together without listening to submission events. +-- | Inject your own query into the Formless component. You will need to derive +-- | a `Functor` instance for your query type. +-- | +-- | ```purescript +-- | data MyQuery a = DoSomething a +-- | derive instance functorMyQuery :: Functor MyQuery +-- | ``` +injQuery :: forall form q ps a. Functor q => q a -> Query form q ps a +injQuery = VF.inj (SProxy :: SProxy "userQuery") + +-- | Convert a Formless public action to an action-style query. Any action from +-- | Formless.Action will work, but no others. +asQuery :: forall form q ps. Variant (PublicAction form) -> Query form q ps Unit +asQuery = VF.inj (SProxy :: SProxy "query") <<< H.tell <<< AsQuery + +-- | Submit the form, returning the output of validation if successful +-- | and `Nothing` otherwise. submitReply - :: ∀ pq cq cs form m - . Query pq cq cs form m (Maybe (form Record OutputField)) -submitReply = H.request SubmitReply - --- | Imperatively receive the current state of the form. -getState - :: ∀ pq cq cs form m - . Query pq cq cs form m (PublicState form) -getState = H.request GetState - --- | Replace all form inputs with a new set of inputs, and re-initialize --- | the form to a new state. Useful to set a new "initial state" for a form, --- | especially when filling a form with data loaded asynchronously. -loadForm - :: ∀ pq cq cs form m a - . form Record InputField - -> a - -> Query pq cq cs form m a -loadForm = LoadForm - --- | `initialize` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -loadForm_ - :: ∀ pq cq cs form m - . form Record InputField - -> Query pq cq cs form m Unit -loadForm_ = flip LoadForm unit - --- | Perform two Formless actions in sequence. Can be chained arbitrarily. --- | Useful when a field needs to modify itself on change and also trigger --- | validation on one or more other fields, or when a modification on one --- | field should also modify another field. -andThen - :: ∀ pq cq cs form m a - . Query pq cq cs form m Unit - -> Query pq cq cs form m Unit - -> a - -> Query pq cq cs form m a -andThen = AndThen - --- | `andThen` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -andThen_ - :: ∀ pq cq cs form m - . Query pq cq cs form m Unit - -> Query pq cq cs form m Unit - -> Query pq cq cs form m Unit -andThen_ a b = AndThen a b unit - --- | Wrap a query from an external component embedded in Formless so it fits --- | the Formless query algebra. Any time this query is triggered, Formless --- | will then pass it up to your parent component via the `Emit` message. -raise - :: ∀ pq cq cs form m a - . pq Unit - -> a - -> Query pq cq cs form m a -raise = Raise - --- | `raise` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -raise_ - :: ∀ pq cq cs form m - . pq Unit - -> Query pq cq cs form m Unit -raise_ = flip Raise unit - --- | Set the input value of a form field at the specified label -set - :: ∀ pq cq cs form inputs m sym t0 e i o a - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> i - -> a - -> Query pq cq cs form m a -set sym i = Modify (wrap (inj sym (wrap (const i)))) - --- | `set` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -set_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> i - -> Query pq cq cs form m Unit -set_ sym i = Modify (wrap (inj sym (wrap (const i)))) unit - --- | Set the input value of a form field at the specified label, also triggering --- | validation to run on the field. -setValidate - :: ∀ pq cq cs form inputs m sym t0 e i o a - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> i - -> a - -> Query pq cq cs form m a -setValidate sym i = ModifyValidate Nothing (wrap (inj sym (wrap (const i)))) - --- | `setValidate` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -setValidate_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> i - -> Query pq cq cs form m Unit -setValidate_ sym i = ModifyValidate Nothing (wrap (inj sym (wrap (const i)))) unit - --- | Set the input value of a form field at the specified label, while debouncing --- | validation so that it only runs after the specified amount of time has elapsed --- | since the last modification. Useful when you need to avoid expensive validation --- | but do not want to wait for a blur event to validate. -asyncSetValidate - :: ∀ pq cq cs form inputs m sym t0 e i o a - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => Milliseconds - -> SProxy sym - -> i - -> a - -> Query pq cq cs form m a -asyncSetValidate ms sym i = ModifyValidate (Just ms) (wrap (inj sym (wrap (const i)))) - --- | `asyncSetValidate` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -asyncSetValidate_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => Milliseconds - -> SProxy sym - -> i - -> Query pq cq cs form m Unit -asyncSetValidate_ ms sym i = ModifyValidate (Just ms) (wrap (inj sym (wrap (const i)))) unit - --- | Modify the input value of a form field at the specified label with the --- | provided function. -modify - :: ∀ pq cq cs form inputs m sym t0 e i o a - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> (i -> i) - -> a - -> Query pq cq cs form m a -modify sym f = Modify (wrap (inj sym (wrap f))) - --- | `modify` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -modify_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> (i -> i) - -> Query pq cq cs form m Unit -modify_ sym f = Modify (wrap (inj sym (wrap f))) unit - --- | Modify the input value of a form field at the specified label, also triggering --- | validation to run on the field, with the provided function. -modifyValidate - :: ∀ pq cq cs form inputs m sym t0 e i o a - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> (i -> i) - -> a - -> Query pq cq cs form m a -modifyValidate sym f = ModifyValidate Nothing (wrap (inj sym (wrap f))) - --- | `modifyValidate` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -modifyValidate_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> (i -> i) - -> Query pq cq cs form m Unit -modifyValidate_ sym f = ModifyValidate Nothing (wrap (inj sym (wrap f))) unit - --- | Modify the input value of a form field at the specified label, while debouncing --- | validation so that it only runs after the specified amount of time has elapsed --- | since the last modification. Useful when you need to avoid expensive validation --- | but do not want to wait for a blur event to validate. -asyncModifyValidate - :: ∀ pq cq cs form inputs m sym t0 e i o a - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => Milliseconds - -> SProxy sym - -> (i -> i) - -> a - -> Query pq cq cs form m a -asyncModifyValidate ms sym f = ModifyValidate (Just ms) (wrap (inj sym (wrap f))) - --- | `asyncModifyValidate` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -asyncModifyValidate_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => Milliseconds - -> SProxy sym - -> (i -> i) - -> Query pq cq cs form m Unit -asyncModifyValidate_ ms sym f = ModifyValidate (Just ms) (wrap (inj sym (wrap f))) unit - --- | Reset the value of the specified form field to its default value --- | according to the `Initial` type class. -reset - :: ∀ pq cq cs form inputs m sym a t0 e i o - . IsSymbol sym - => Initial i - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> a - -> Query pq cq cs form m a -reset sym = Reset (wrap (inj sym (wrap (const initial)))) - --- | `reset` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -reset_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Initial i - => Newtype (form Variant InputFunction) (Variant inputs) - => Row.Cons sym (InputFunction e i o) t0 inputs - => SProxy sym - -> Query pq cq cs form m Unit -reset_ sym = Reset (wrap (inj sym (wrap (const initial)))) unit - --- | A helper to create the correct `Validate` query for Formless, given --- | a label -validate - :: ∀ pq cq cs form us m sym a t0 e i o - . IsSymbol sym - => Newtype (form Variant U) (Variant us) - => Row.Cons sym (U e i o) t0 us - => SProxy sym - -> a - -> Query pq cq cs form m a -validate sym = Validate (wrap (inj sym U)) - --- | `validate` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -validate_ - :: ∀ pq cq cs form us m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant U) (Variant us) - => Row.Cons sym (U e i o) t0 us - => SProxy sym - -> Query pq cq cs form m Unit -validate_ sym = Validate (wrap (inj sym U)) unit - --- | Provide a record of input fields to overwrite all current --- | inputs. Unlike `initialize`, this does not otherwise reset --- | the form as if it were new. Similar to calling `set` on every --- | field in the form. -setAll - :: ∀ pq cq cs form m a is is' - . Newtype (form Record InputField) { | is' } - => HM.HMap WrapField { | is } { | is' } - => { | is } - -> a - -> Query pq cq cs form m a -setAll = SetAll <<< wrapInputFields - --- | `setAll` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -setAll_ - :: ∀ pq cq cs form m is is' - . Newtype (form Record InputField) { | is' } - => HM.HMap WrapField { | is } { | is' } - => { | is } - -> Query pq cq cs form m Unit -setAll_ is = SetAll (wrapInputFields is) unit - --- | Provide a record of input functions to modify all current --- | inputs. Similar to calling `modify` on every field in the form. -modifyAll - :: ∀ pq cq cs form m ifs ifs' a - . Newtype (form Record InputFunction) { | ifs' } - => HM.HMap WrapField { | ifs } { | ifs' } - => { | ifs } - -> a - -> Query pq cq cs form m a -modifyAll = ModifyAll <<< wrapInputFunctions - --- | `modifyAll` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -modifyAll_ - :: ∀ pq cq cs form m ifs ifs' - . Newtype (form Record InputFunction) { | ifs' } - => HM.HMap WrapField { | ifs } { | ifs' } - => { | ifs } - -> Query pq cq cs form m Unit -modifyAll_ ifs = ModifyAll (wrapInputFunctions ifs) unit - --- | Reset all fields to their initial values, and reset the form --- | to its initial pristine state, no touched fields. -resetAll - :: ∀ pq cq cs form m a - . a - -> Query pq cq cs form m a -resetAll = ResetAll - --- | `resetAll` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -resetAll_ - :: ∀ pq cq cs form m - . Query pq cq cs form m Unit -resetAll_ = ResetAll unit - --- | Validate all fields in the form, collecting errors -validateAll - :: ∀ pq cq cs form m a - . a - -> Query pq cq cs form m a -validateAll = ValidateAll - --- | `validateAll` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -validateAll_ - :: ∀ pq cq cs form m - . Query pq cq cs form m Unit -validateAll_ = ValidateAll unit - --- | Provide a record of inputs to overwrite all current inputs without --- | resetting the form (as `initialize` does), and then validate the --- | entire new set of fields. Similar to calling `setValidate` on every --- | field in the form. -setValidateAll - :: ∀ pq cq cs form m a is is' - . Newtype (form Record InputField) { | is' } - => HM.HMap WrapField { | is } { | is' } - => { | is } - -> a - -> Query pq cq cs form m a -setValidateAll is = setAll_ is `andThen` validateAll_ - --- | `setValidateAll` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -setValidateAll_ - :: ∀ pq cq cs form m is is' - . Newtype (form Record InputField) { | is' } - => HM.HMap WrapField { | is } { | is' } - => { | is } - -> Query pq cq cs form m Unit -setValidateAll_ is = setAll_ is `andThen_` validateAll_ - --- | Provide a record of input functions to modify all current --- | inputs, and then validate all fields. Similar to calling --- | `modifyValidate` on every field in the form. -modifyValidateAll - :: ∀ pq cq cs form m ifs ifs' a - . Newtype (form Record InputFunction) { | ifs' } - => HM.HMap WrapField { | ifs } { | ifs' } - => { | ifs } - -> a - -> Query pq cq cs form m a -modifyValidateAll ifs = modifyAll_ ifs `andThen` validateAll_ - --- | `modifyValidateAll` as an action, so you don't need to specify a `Unit` --- | result. Use to skip a use of `Halogen.action`. -modifyValidateAll_ - :: ∀ pq cq cs form m ifs ifs' - . Newtype (form Record InputFunction) { | ifs' } - => HM.HMap WrapField { | ifs } { | ifs' } - => { | ifs } - -> Query pq cq cs form m Unit -modifyValidateAll_ ifs = modifyAll_ ifs `andThen_` validateAll_ + :: forall form query ps a + . (Maybe (form Record OutputField) -> a) + -> Query form query ps a +submitReply = VF.inj (SProxy :: SProxy "query") <<< SubmitReply + +-- | When you have specified a child component within Formless and need to query it, +-- | you can do so in two ways. +-- | +-- | First, you can use `H.query` as usual within the `handleExtraQuery` function +-- | you provide to Formless as input. You can, for example, write your own query +-- | which manages the child component, write it into the render function you +-- | supply Formless, and then when that query is triggered, query the child +-- | component. +-- | +-- | Second, you can use the `sendQuery` function within your parent component's +-- | `handleAction` or `handleQuery` functions. Given the slot for Formless, the +-- | slot for the child component within Formless, and the query you'd like to +-- | send the child component, `sendQuery` will run through Formless and return +-- | the query result to the parent. +-- | +-- | For example, this is how you would query a dropdown component being run +-- | within a Formless form from the parent component. +-- | +-- | ```purescript +-- | -- in the parent component which mounts Formless +-- | handleAction = case _ of +-- | SendDropdown (dropdownQuery -> do +-- | result <- F.sendQuery _formless unit _dropdown 10 dropdownQuery +-- | ``` +sendQuery + :: forall outS outL inS inL form msg q ps cq cm pps r0 r1 st pmsg act m a + . IsSymbol outL + => IsSymbol inL + => Row.Cons outL (Slot.Slot (Query form q ps) msg outS) r0 pps + => Row.Cons inL (Slot.Slot cq cm inS) r1 ps + => Ord outS + => Ord inS + => SProxy outL + -> outS + -> SProxy inL + -> inS + -> cq a + -> H.HalogenM st act pps pmsg m (Maybe a) +sendQuery ol os il is cq = + H.query ol os + $ VF.inj (SProxy :: _ "query") + $ SendQuery + $ CQ.mkChildQueryBox + $ CQ.ChildQuery (\k -> maybe (pure Nothing) k <<< Slot.lookup il is) cq identity diff --git a/src/Formless/Retrieve.purs b/src/Formless/Retrieve.purs index dc598de..6e80f9d 100644 --- a/src/Formless/Retrieve.purs +++ b/src/Formless/Retrieve.purs @@ -31,7 +31,7 @@ getTouched :: ∀ e i o. FormFieldGet e i o Boolean getTouched sym = view (_FieldTouched sym) -- | Given a form, get the result at the specified symbol -getResult :: ∀ e i o. FormFieldGet e i o (FormFieldResult e o) +getResult :: ∀ e i o. FormFieldGet e i o (FormFieldResult e o) getResult sym = view (_FieldResult sym) -- | Given a form, get the error (if it exists) at the specified symbol @@ -165,7 +165,7 @@ data GetError = GetError -- | Heterogeneous type class for the getError function instance getErrorResult' :: Mapping GetError (FormField e i o) (Maybe e) where - mapping GetError (FormField { result }) = case result of + mapping GetError (FormField { result }) = case result of Error e -> Just e _ -> Nothing diff --git a/src/Formless/Transform/Record.purs b/src/Formless/Transform/Record.purs index a7569a0..ed080ed 100644 --- a/src/Formless/Transform/Record.purs +++ b/src/Formless/Transform/Record.purs @@ -56,4 +56,3 @@ wrapInputFunctions => { | ifs } -> form Record InputFunction wrapInputFunctions = wrap <<< wrapRecord - diff --git a/src/Formless/Transform/Row.purs b/src/Formless/Transform/Row.purs index f782ff0..601f60f 100644 --- a/src/Formless/Transform/Row.purs +++ b/src/Formless/Transform/Row.purs @@ -10,7 +10,8 @@ import Formless.Internal.Transform (class Row1Cons, FromScratch, fromScratch) import Prim.Row as Row import Prim.RowList as RL import Record.Builder as Builder -import Type.Row (RLProxy(..), RProxy(..)) +import Type.Data.Row (RProxy(..)) +import Type.Data.RowList (RLProxy(..)) ---------- -- Construction from rows diff --git a/src/Formless/Types/Component.purs b/src/Formless/Types/Component.purs index 142ba70..5d679ef 100644 --- a/src/Formless/Types/Component.purs +++ b/src/Formless/Types/Component.purs @@ -2,84 +2,146 @@ module Formless.Types.Component where import Prelude -import Control.Comonad.Store (Store) import Data.Const (Const) +import Data.Functor.Variant (VariantF, FProxy) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Maybe (Maybe) import Data.Newtype (class Newtype) +import Data.Symbol (SProxy(..)) +import Data.Tuple (Tuple) import Data.Variant (Variant) -import Effect.Aff (Error, Fiber, Milliseconds) +import Effect.Aff (Fiber, Milliseconds) import Effect.Aff.AVar (AVar) import Effect.Ref (Ref) import Formless.Types.Form (FormField, InputField, InputFunction, OutputField, U) import Formless.Validation (Validation) +import Type.Row (type (+)) import Halogen as H import Halogen.HTML as HH +import Halogen.Query.ChildQuery (ChildQueryBox) + +-- | A type representing the various functions that can be provided to extend +-- | the Formless component. Usually only the `render` function is required, +-- | but you may also provide others. For example, if you have child components, +-- | you can tell Formless how to manage those child components by adding a +-- | handler action and `handleAction` case. +type Spec form st query act slots input msg m = + { render :: PublicState form st -> ComponentHTML form act slots m + , handleAction :: act -> HalogenM form st act slots msg m Unit + , handleQuery :: forall a. query a -> HalogenM form st act slots msg m (Maybe a) + , handleEvent :: Event form st -> HalogenM form st act slots msg m Unit + , receive :: input -> Maybe act + , initialize :: Maybe act + , finalize :: Maybe act + } + +-- | A simplified type when the component has only a form spec, some output, and runs +-- | in some monad `m` +type Spec' form msg input m = Spec form () (Const Void) Void () input msg m + +-- | The component action type. While actions are typically considered +-- | internal to a component, in Formless you write the render function and will +-- | need to be able to use these directly. Many of these are shared with queries +-- | of the same name so they can be used either as queries or as actions. See +-- | `Formless.Action` and `Formless.Query`. +-- | +-- | You can freely extend this type with your own actions using `injAction`. +type Action form act = Variant + ( userAction :: act + | InternalAction act + + PublicAction form + ) --- | The component query type. See Formless.Query for helpers related --- | to constructing and using these queries. -data Query pq cq cs form m a - = Modify (form Variant InputFunction) a - | Validate (form Variant U) a - | ModifyValidate (Maybe Milliseconds) (form Variant InputFunction) a - | Reset (form Variant InputFunction) a - | SetAll (form Record InputField) a - | ModifyAll (form Record InputFunction) a - | ResetAll a - | ValidateAll a - | Submit a - | SubmitReply (Maybe (form Record OutputField) -> a) - | GetState (PublicState form -> a) - | Send cs (cq a) - | LoadForm (form Record InputField) a - | SyncFormData a - | Raise (pq Unit) a - | Initialize a - | Receive (Input pq cq cs form m) a - | AndThen (Query pq cq cs form m Unit) (Query pq cq cs form m Unit) a - --- | The overall component state type, which contains the local state type --- | and also the render function -type StateStore pq cq cs form m = Store (State form m) (HTML pq cq cs form m) +type PublicAction form = + ( modify :: form Variant InputFunction + , validate :: form Variant U + , modifyValidate :: Tuple (Maybe Milliseconds) (form Variant InputFunction) + , reset :: form Variant InputFunction + , setAll :: Tuple (form Record InputField) Boolean + , modifyAll :: Tuple (form Record InputFunction) Boolean + , validateAll :: Unit + , resetAll :: Unit + , submit :: Unit + , loadForm :: form Record InputField + ) + +type InternalAction act r = + ( initialize :: Maybe act + , syncFormData :: Unit + | r + ) + +-- | A simple action type when the component does not need extension +type Action' form = Action form Void + +-- | The internals of the public component query type. Many of these are shared +-- | with actions of the same name so they can be used in rendering. See +-- | `Formless.Action` and `Formless.Query` for more. +data QueryF form slots a + = SubmitReply (Maybe (form Record OutputField) -> a) + -- Query a child component of Formless through Formless + | SendQuery (ChildQueryBox slots (Maybe a)) + -- Run a Formless action as a query + | AsQuery (Variant (PublicAction form)) a + +derive instance functorQueryF :: Functor (QueryF form slots) + +-- | The component query type, which you can freely extend with your own queries +-- | using `injQuery` from `Formless.Query`. +type Query form query slots = VariantF + ( query :: FProxy (QueryF form slots) + , userQuery :: FProxy query + ) + +-- | A simple query type when the component does not need extension +type Query' form = Query form (Const Void) () -- | The component type -type Component pq cq cs form m - = H.Component - HH.HTML - (Query pq cq cs form m) - (Input pq cq cs form m) - (Message pq form) - m +type Component form query slots input msg m = + H.Component HH.HTML (Query form query slots) input msg m + +-- | A simple component type when the component does not need extension +type Component' form input m = + Component form (Const Void) () input Void m -- | The component's HTML type, the result of the render function. -type HTML pq cq cs form m = H.ParentHTML (Query pq cq cs form m) cq cs m - --- | The component's DSL type, the result of the eval function. -type DSL pq cq cs form m - = H.ParentDSL - (StateStore pq cq cs form m) - (Query pq cq cs form m) - cq - cs - (Message pq form) - m +type ComponentHTML form act slots m = + H.ComponentHTML (Action form act) slots m + +-- | A simple component HTML type when the component does not need extension +type ComponentHTML' form m = + ComponentHTML form Void () m + +-- | The component's eval type +type HalogenM form st act slots msg m = + H.HalogenM (State form st m) (Action form act) slots msg m + +-- | A simple component eval type when the component does not need extension +type HalogenM' form msg m = + HalogenM form () Void () msg m -- | The component local state -type State form m = Record (StateRow form (internal :: InternalState form m)) +type State form st m = + { | StateRow form (internal :: InternalState form m | st) } --- | The component's public state -type PublicState form = Record (StateRow form ()) +-- | A simple state type when the component does not need extension +type State' form m = + State form () m -- | The component's public state -type StateRow form r = +type PublicState form st = + { | StateRow form st } + +-- | The component's public state, as an extensible row +type StateRow form st = ( validity :: ValidStatus , dirty :: Boolean , submitting :: Boolean , errors :: Int , submitAttempts :: Int , form :: form Record FormField - | r + | st ) -- | A newtype to make easier type errors for end users to @@ -89,8 +151,9 @@ newtype InternalState form m = InternalState , validators :: form Record (Validation form m) , allTouched :: Boolean , debounceRef :: Maybe (Ref (Maybe Debouncer)) - , validationRef :: Maybe (Ref (Maybe (Error -> m Unit))) + , validationRef :: Maybe (Ref (Maybe H.ForkId)) } + derive instance newtypeInternalState :: Newtype (InternalState form m) _ -- | A type to represent a running debouncer @@ -112,31 +175,42 @@ derive instance ordValidStatus :: Ord ValidStatus instance showValidStatus :: Show ValidStatus where show = genericShow --- | The component's input type -type Input pq cq cs form m = - { initialInputs :: form Record InputField +-- | The component's input type. If you provide `Nothing` as your `initialInputs` +-- | then the form will fill in values based on the `Initial` type class for the +-- | field's input type. Otherwise, the form will contain the values you provide. +-- | +-- | Validators can be created using the Formless.Validation module. +type Input form st m = + { initialInputs :: Maybe (form Record InputField) , validators :: form Record (Validation form m) - , render :: State form m -> HTML pq cq cs form m + | st } +-- | A simple Input type when the component does not need extension +type Input' form m = Input form () m + -- | The component tries to require as few messages to be handled as possible. You -- | can always use the *Reply variants of queries to perform actions and receive --- | a result out the other end. -data Message pq form +-- | a result out the other end, or extend these messages. +data Event form st = Submitted (form Record OutputField) - | Changed (PublicState form) - | Emit (pq Unit) - --- | Simple types - --- | A simple query type when you have no child slots in use -type Query' form m = Query (Const Void) (Const Void) Void form m - --- | A simple HTML type when the component does not need embedding -type HTML' form m = H.ParentHTML (Query' form m) (Const Void) Void m - --- | A simple Message type when the component does not need embedding -type Message' form = Message (Const Void) form - --- | A simple Input type when the component does not need embedding -type Input' form m = Input (Const Void) (Const Void) Void form m + | Changed (PublicState form st) + +type Event' form = Event form () + +-- | A slot type that can be used in the ChildSlots definition for your parent +-- | component +type Slot form query slots msg = H.Slot (Query form query slots) msg + +-- | A simple Slot type when the component does not need extension, besides a +-- | custom output message +type Slot' form msg = H.Slot (Query' form) msg + +-- | A convenience export of formless as a symbol for use when mounting Formless +-- | as a child component +-- | +-- | ```purescript +-- | type ChildSlots = (formless :: F.Slot' Form FormResult) +-- | HH.slot F._formless unit (F.component spec) input handler +-- | ``` +_formless = SProxy :: SProxy "formless" diff --git a/src/Formless/Validation.purs b/src/Formless/Validation.purs index 0a70414..4122aa8 100644 --- a/src/Formless/Validation.purs +++ b/src/Formless/Validation.purs @@ -58,19 +58,6 @@ instance categoryValidation :: Monad m => Category (Validation form m e) where runValidation :: ∀ form m e i o. Monad m => Validation form m e i o -> form Record FormField -> i -> m (Either e o) runValidation = unwrap --- | A function to create a record of validators that simply pass through all inputs --- | for when no validation is needed. Provide this as your `validators` function. -noValidation - :: ∀ form fields m vs xs - . Monad m - => RowToList fields xs - => Newtype (form Record (Validation form m)) { | vs } - => Newtype (form Record InputField) { | fields } - => MapRecordWithIndex xs (ConstMapping EmptyValidators) fields vs - => form Record InputField - -> form Record (Validation form m) -noValidation = wrap <<< hmap EmptyValidators <<< unwrap - -- | Turn a function from (form Record FormField -> i -> o) into a proper Validation hoistFn :: ∀ form m e i o. Monad m => (form Record FormField -> i -> o) -> Validation form m e i o hoistFn f = Validation $ \form -> pure <<< pure <<< f form @@ -95,6 +82,26 @@ hoistFnME = Validation hoistFnME_ :: ∀ form m e i o. Monad m => (i -> m (Either e o)) -> Validation form m e i o hoistFnME_ = Validation <<< const +---------- +-- Common validation + +-- | A function to create a record of validators that simply pass through all inputs +-- | for when no validation is needed. Provide this as your `validators` function. +noValidators + :: ∀ form fields m vs xs + . Monad m + => RowToList fields xs + => Newtype (form Record (Validation form m)) { | vs } + => Newtype (form Record InputField) { | fields } + => MapRecordWithIndex xs (ConstMapping EmptyValidators) fields vs + => form Record InputField + -> form Record (Validation form m) +noValidators = wrap <<< hmap EmptyValidators <<< unwrap + +-- | A validation function which simply passes through its input value as its +-- | output value. Use on individual fields which do not need any validation. +noValidation :: ∀ form m e i. Monad m => Validation form m e i i +noValidation = hoistFn_ identity ---------- -- Helper Types diff --git a/template/DataAndValidation.purs b/template/DataAndValidation.purs new file mode 100644 index 0000000..3812c17 --- /dev/null +++ b/template/DataAndValidation.purs @@ -0,0 +1,54 @@ +module Template.DataAndValidation where + +import Prelude + +import Data.Either (Either(..)) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Lens (preview) +import Data.Maybe (Maybe) +import Data.Newtype (class Newtype) +import Data.String.CodeUnits (length) +import Data.Symbol (SProxy(..)) +import Formless (class Initial, FormFieldResult, Validation, _Error, hoistFnE_) + +-- Data type for one of our fields + +newtype Name = Name String +derive instance newtypeName :: Newtype Name _ +derive newtype instance showName :: Show Name + + -- input output +type NAME_FIELD f r = ( name :: f FieldError String Name | r) + +-- The value following 'SProxy' must be the same as the +-- label in the above row kind, so that we can use `_name` +-- to refer to same label in a record or Variant +_name :: SProxy "name" +_name = SProxy + +-- Specifies the initial value that the field will have when it is initialized. +instance initialName :: Initial Name where + initial = Name "Nobody" + +-- Error type for one of our fields +data FieldError + = TooShort Int + +derive instance genericFieldError :: Generic FieldError _ +instance showFieldError :: Show FieldError where + show x = genericShow x + +-- | Function for validating one of our field's data +minLength :: ∀ form m. Monad m => Int -> Validation form m FieldError String Name +minLength n = hoistFnE_ $ \str -> + let n' = length str + in if n' < n then Left (TooShort n) else Right (Name str) + +-- | This could be a type class, but we'll just use a function instead. +toErrorText :: FieldError -> String +toErrorText (TooShort n) = "You must enter at least " <> show n <> " characters." + +-- | Unpacks errors to render as a string +showError :: ∀ o. FormFieldResult FieldError o -> Maybe String +showError = map toErrorText <<< preview _Error diff --git a/template/FormlessTemplate.purs b/template/FormlessTemplate.purs new file mode 100644 index 0000000..c7c80e2 --- /dev/null +++ b/template/FormlessTemplate.purs @@ -0,0 +1,171 @@ +module FormlessTemplate where + +import Prelude + +import DOM.HTML.Indexed.InputType (InputType(..)) +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype) +import Effect.Aff.Class (class MonadAff) +import Formless as F +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP +import Template.DataAndValidation (NAME_FIELD, _name, minLength) +import Type.Row (type (+)) + +type FormFieldsRow f = + ( NAME_FIELD f + + () + ) + +type FormFields = { | FormFieldsRow F.OutputType } + +newtype Form r f = Form (r (FormFieldsRow f)) +derive instance newtypeForm' :: Newtype (Form r f) _ + +-- Form component types + +type Input = Unit +type AddedState = ( additionalState :: Maybe Int ) +data Action + = DoStuff + | Initialize + | Finalize + | Receive Input + +data Query a + = Command a + | Reply (Unit -> a) + +type Message = FormFields +type ChildSlots = + () +type SelfSlot index = F.Slot Form Query ChildSlots Message index + +component + :: forall m + . MonadAff m + => F.Component Form Query ChildSlots Input FormFields m +component = F.component mkInput $ F.defaultSpec + { render = render + , handleAction = handleAction + , handleEvent = handleEvent + , handleQuery = handleQuery + , initialize = Just Initialize + , finalize = Just Finalize + , receive = Just <<< Receive + } + where + -- Converts the Input value passed in by the parent component + -- into the Formless' Input value. + mkInput :: Input -> F.Input Form AddedState m + mkInput _ = + -- the two values here are for Formless + { validators: Form + { name: minLength 7 + } + , initialInputs: Nothing -- when Nothing, will use `Initial` type class + + -- everything else below comes from our `AddedState` rows: + , additionalState: Just 5 + } + + render + :: F.PublicState Form AddedState + -> F.ComponentHTML Form Action ChildSlots m + render st = + HH.div_ + -- Indicates whether the form's values are valid + -- (i.e. validation has passed for all fields) + [ HH.p_ [ HH.text $ "Validity: " <> show st.validity ] + + -- Indicates whether any field in the form has been changed from + -- its initial state + , HH.p_ [ HH.text $ "Dirty: " <> show st.dirty ] + + -- Indicates whether the 'submit' button has been clicked and the + -- form's content is still being validated one last time before + -- submission is accepted. + , HH.p_ [ HH.text $ "Being Submitted: " <> show st.submitting ] + + -- Indicates the number of errors due to validation failing that + -- need to be fixed before submission is accepted + , HH.p_ [ HH.text $ "Number of Errors: " <> show st.errors ] + + -- Indicates the number of times user has attempted to submit the form + , HH.p_ [ HH.text $ "Number of Submit attempts: " <> show st.submitAttempts ] + + -- We can also refer to any additional labels we used to extend the + -- form's state; in this case, that means any field from our + -- `AddedState` type. + , HH.p_ [ HH.text $ "Additional state was: " <> show st.additionalState ] + + , HH.div_ + [ HH.text "Label" ] + , HH.input + [ HP.type_ InputText + , HP.placeholder "Michael" + + -- gets the value of `_name` in the form's state + , HP.value (F.getInput _name st.form) + + -- sets the value of `_name` and then validates it + , HE.onValueInput (Just <<< F.setValidate _name) + ] + , HH.button + [ if st.submitting || st.validity /= F.Valid + then HP.disabled true + else HE.onClick \_ -> Just F.submit + ] + [ HH.text "Submit" ] + ] + + -- Decide what, if anything, to do when Formless events occur. + -- For example, if you would like to raise events as messages, + -- then use `F.raiseResult` as your `handleEvent` function. + handleEvent + :: F.Event Form AddedState + -> F.HalogenM Form AddedState Action ChildSlots Message m Unit + handleEvent = case _ of + -- Indicates that the form has been successfully submitted. + F.Submitted formContent -> do + -- This is how to get the output values of the form. + let formFields = F.unwrapOutputFields formContent + + -- We won't do this here, but this is how most will handle a form + -- submission: raise it as an event to their parent. + -- H.raise formFields + + -- Alternatively, one could do something custom with the output values. + + -- This line exists so the code compiles. + pure unit + + -- Indicates that the form's content has been changed. + -- This event is triggered anytime a field is changed, + -- whether it passes validation or not. + F.Changed formState -> do + void $ pure formState + + handleAction + :: Action + -> F.HalogenM Form AddedState Action ChildSlots Message m Unit + handleAction = case _ of + DoStuff -> do + pure unit + Initialize -> do + pure unit + Receive input -> do + pure unit + Finalize -> do + pure unit + + handleQuery + :: forall a + . Query a + -> F.HalogenM Form AddedState Action ChildSlots Message m (Maybe a) + handleQuery = case _ of + Reply reply -> do + pure $ Just $ reply unit + Command next -> do + pure $ Just next