From 9f215cbddf12334dd05a7544b9192cc3720cb302 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Sat, 25 Feb 2017 15:10:29 +0100 Subject: [PATCH 1/3] First attempt using type-level repr --- src/Hyper/Form.purs | 6 +++ src/Hyper/Form/Safe.purs | 68 +++++++++++++++++++++++++ src/Hyper/Routing/ContentType/HTML.purs | 3 ++ src/Hyper/Routing/Links.purs | 2 +- 4 files changed, 78 insertions(+), 1 deletion(-) create mode 100644 src/Hyper/Form/Safe.purs diff --git a/src/Hyper/Form.purs b/src/Hyper/Form.purs index 453a76c..4f97779 100644 --- a/src/Hyper/Form.purs +++ b/src/Hyper/Form.purs @@ -73,3 +73,9 @@ parseForm = ipure (Form <$> splitPairs conn.request.body) Just mediaType -> ipure (throwError (error ("Cannot parse media of type: " <> show mediaType))) + +class ToForm a where + toForm ∷ a → Form + +class FromForm a where + fromForm ∷ Form → Either String Form diff --git a/src/Hyper/Form/Safe.purs b/src/Hyper/Form/Safe.purs new file mode 100644 index 0000000..d97d7d5 --- /dev/null +++ b/src/Hyper/Form/Safe.purs @@ -0,0 +1,68 @@ +module Hyper.Form.Safe where + +import Prelude +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) +import Text.Smolder.HTML (input, label) +import Text.Smolder.HTML.Attributes (name, placeholder, type') +import Text.Smolder.Markup (MarkupM, text, (!)) +import Text.Smolder.Renderer.String (render) +import Type.Proxy (Proxy(..)) + +-- + +data FAppend a b = FAppend a b + +infixl 4 type FAppend as :<> +infixl 4 FAppend as :<> + +-- + +data InputText (name ∷ Symbol) = InputText +data InputHidden (name ∷ Symbol) = InputHidden +data InputNumber (name ∷ Symbol) = InputNumber + +-- + +class ToFormHTML f o | f → o where + toForm ∷ Proxy f → o + +instance toFormHtmlInputText ∷ IsSymbol name ⇒ ToFormHTML (InputText name) (MarkupM Unit Unit) where + toForm _ = input ! name n ! type' "text" + where n = reflectSymbol (SProxy ∷ SProxy name) + +instance toFormHtmlInputNumber ∷ IsSymbol name ⇒ ToFormHTML (InputNumber name) (MarkupM Unit Unit) where + toForm _ = input ! name n ! type' "number" + where n = reflectSymbol (SProxy ∷ SProxy name) + +instance toFormHtmlInputHidden ∷ IsSymbol name ⇒ ToFormHTML (InputHidden name) (MarkupM Unit Unit) where + toForm _ = input ! name n ! type' "hidden" + where n = reflectSymbol (SProxy ∷ SProxy name) + +instance toFormHtmlFConcat ∷ (ToFormHTML f1 m1, ToFormHTML f2 m2) + ⇒ ToFormHTML (f1 :<> f2) (m1 :<> m2) where + toForm _ = toForm p1 :<> toForm p2 + where + p1 = Proxy ∷ Proxy f1 + p2 = Proxy ∷ Proxy f2 + +-- + +type PersonForm = + InputText "id" + :<> InputText "name" + :<> InputNumber "age" + +test ∷ String +test = + render $ + case toForm (Proxy :: Proxy PersonForm) of + idField :<> nameField :<> ageField → do + idField + label do + text "Name: " + nameField ! placeholder "Jane Doe…" + label do + text "Age: " + ageField diff --git a/src/Hyper/Routing/ContentType/HTML.purs b/src/Hyper/Routing/ContentType/HTML.purs index d095966..a7bfcfe 100644 --- a/src/Hyper/Routing/ContentType/HTML.purs +++ b/src/Hyper/Routing/ContentType/HTML.purs @@ -17,6 +17,9 @@ import Text.Smolder.Renderer.String (render) data HTML +-- TODO: Enforce that URI comes from a GET-able resource, +-- perhaps by wrapping the URI type and adding some phantom +-- type parameter for the HTTP method. linkTo :: URI -> Markup Unit -> Markup Unit linkTo uri = a ! href (printURI uri) diff --git a/src/Hyper/Routing/Links.purs b/src/Hyper/Routing/Links.purs index 58783ab..14b7cd1 100644 --- a/src/Hyper/Routing/Links.purs +++ b/src/Hyper/Routing/Links.purs @@ -67,7 +67,7 @@ instance hasLinksCaptureAll :: (HasLinks sub subMk, IsSymbol c, ToPathPiece t) toLinks _ l = toLinks (Proxy :: Proxy sub) <<< append l <<< Link <<< map toPathPiece -instance hasLinksHandler :: HasLinks (Handler m ct b) URI where +instance hasLinksHandlerGet :: HasLinks (Handler m ct b) URI where toLinks _ = linkToURI instance hasLinksRaw :: HasLinks (Raw m) URI where From 244d6cd89a114bbaddbe193a9f9a384c26d0f8a1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Sun, 26 Feb 2017 08:32:27 +0100 Subject: [PATCH 2/3] Render something --- examples/SafeForm.purs | 103 +++++++++++++++++++++++++++++++++++++++ src/Hyper/Form/Safe.purs | 62 +++++++++-------------- 2 files changed, 127 insertions(+), 38 deletions(-) create mode 100644 examples/SafeForm.purs diff --git a/examples/SafeForm.purs b/examples/SafeForm.purs new file mode 100644 index 0000000..b1b82a8 --- /dev/null +++ b/examples/SafeForm.purs @@ -0,0 +1,103 @@ +module Examples.SafeForm where + +import Control.IxMonad ((:*>)) +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE) +import Control.Monad.Except (ExceptT) +import Data.Foldable (traverse_) +import Data.Maybe (Maybe(..), maybe) +import Data.MediaType.Common (textHTML) +import Hyper.Form.Safe (type (:<>), InputHidden, InputNumber, InputText, toForm, (:<>)) +import Hyper.Node.Server (defaultOptions, runServer) +import Hyper.Response (closeHeaders, contentType, respond, writeStatus) +import Hyper.Routing (type (:/), type (:<|>), type (:>), Capture, (:<|>)) +import Hyper.Routing.ContentType.HTML (class EncodeHTML, HTML, linkTo) +import Hyper.Routing.Links (linksTo) +import Hyper.Routing.Method (Get) +import Hyper.Routing.Router (RoutingError, router) +import Node.Buffer (BUFFER) +import Node.HTTP (HTTP) +import Text.Smolder.HTML (h1, label, p, table, tbody, td, th, thead, tr) +import Text.Smolder.HTML.Attributes (placeholder) +import Text.Smolder.Markup (text, (!)) +import Type.Proxy (Proxy(..)) +import Prelude hiding (div) + +type Site = + Get HTML Persons + :<|> "new" :/ Get HTML NewPerson + :<|> Capture "id" Int :> Get HTML EditPerson + +newtype Person = Person { id :: Int, name ∷ String, age ∷ Int } + +data Persons = Persons (Array Person) +data NewPerson = NewPerson +data EditPerson = EditPerson Person + +type PersonForm = + InputHidden "id" Int + :<> InputText "name" + :<> InputNumber "age" + +instance encodeHTMLPersons :: EncodeHTML Persons where + encodeHTML (Persons ps) = + table do + thead do + tr do + th (text "Name") + th (text "Age") + th (text "Actions") + tbody (traverse_ encodePerson ps) + where + encodePerson (Person person) = + case linksTo site of + _ :<|> _ :<|> getPerson' → + tr do + td (text person.name) + td (text (show person.age)) + td (linkTo (getPerson' person.id) (text "Edit")) + +instance encodeHTMLNewPerson :: EncodeHTML NewPerson where + encodeHTML _ = + case toForm (Proxy :: Proxy PersonForm) of + idField :<> nameField :<> ageField → do + idField 0 + label do + text "Name: " + nameField Nothing ! placeholder "Jane Doe..." + label do + text "Age: " + ageField Nothing + +instance encodeHTMLPerson :: EncodeHTML EditPerson where + encodeHTML (EditPerson (Person person)) = do + h1 (text "Edit Person") + p (text "TODO") + +allPersons ∷ ∀ m. Monad m ⇒ ExceptT RoutingError m Persons +allPersons = + [Person { id: 1, name: "Alice", age: 41 }] + # Persons + # pure + +newPerson ∷ ∀ m. Monad m ⇒ ExceptT RoutingError m NewPerson +newPerson = pure NewPerson + +editPerson ∷ ∀ m. Monad m ⇒ Int → ExceptT RoutingError m EditPerson +editPerson i = + Person { id: 0, name: "John", age: 41 } + # EditPerson + # pure + +site :: Proxy Site +site = Proxy + +main :: forall e. Eff (http :: HTTP, console :: CONSOLE, buffer :: BUFFER | e) Unit +main = + let onRoutingError status msg = + writeStatus status + :*> contentType textHTML + :*> closeHeaders + :*> respond (maybe "" id msg) + appRouter = router site (allPersons :<|> newPerson :<|> editPerson) onRoutingError + in runServer defaultOptions {} appRouter diff --git a/src/Hyper/Form/Safe.purs b/src/Hyper/Form/Safe.purs index d97d7d5..e66d87d 100644 --- a/src/Hyper/Form/Safe.purs +++ b/src/Hyper/Form/Safe.purs @@ -1,13 +1,11 @@ module Hyper.Form.Safe where import Prelude -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) +import Data.Maybe (Maybe, maybe) import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) -import Text.Smolder.HTML (input, label) -import Text.Smolder.HTML.Attributes (name, placeholder, type') -import Text.Smolder.Markup (MarkupM, text, (!)) -import Text.Smolder.Renderer.String (render) +import Text.Smolder.HTML (input) +import Text.Smolder.HTML.Attributes (name, type', value) +import Text.Smolder.Markup (MarkupM, (!)) import Type.Proxy (Proxy(..)) -- @@ -19,26 +17,34 @@ infixl 4 FAppend as :<> -- -data InputText (name ∷ Symbol) = InputText -data InputHidden (name ∷ Symbol) = InputHidden -data InputNumber (name ∷ Symbol) = InputNumber +data InputText (name ∷ Symbol) = InputText String +data InputHidden (name ∷ Symbol) a = InputHidden a +data InputNumber (name ∷ Symbol) = InputNumber Int -- class ToFormHTML f o | f → o where toForm ∷ Proxy f → o -instance toFormHtmlInputText ∷ IsSymbol name ⇒ ToFormHTML (InputText name) (MarkupM Unit Unit) where - toForm _ = input ! name n ! type' "text" - where n = reflectSymbol (SProxy ∷ SProxy name) +instance toFormHtmlInputText ∷ IsSymbol name + ⇒ ToFormHTML (InputText name) (Maybe String → MarkupM Unit Unit) where + toForm _ s = maybe field (\x → field ! value x) s + where + n = reflectSymbol (SProxy ∷ SProxy name) + field = input ! name n ! type' "text" -instance toFormHtmlInputNumber ∷ IsSymbol name ⇒ ToFormHTML (InputNumber name) (MarkupM Unit Unit) where - toForm _ = input ! name n ! type' "number" - where n = reflectSymbol (SProxy ∷ SProxy name) +instance toFormHtmlInputNumber ∷ IsSymbol name + ⇒ ToFormHTML (InputNumber name) (Maybe Int → MarkupM Unit Unit) where + toForm _ x = maybe field (\x' → field ! value (show x')) x + where + n = reflectSymbol (SProxy ∷ SProxy name) + field = input ! name n ! type' "number" -instance toFormHtmlInputHidden ∷ IsSymbol name ⇒ ToFormHTML (InputHidden name) (MarkupM Unit Unit) where - toForm _ = input ! name n ! type' "hidden" - where n = reflectSymbol (SProxy ∷ SProxy name) +instance toFormHtmlInputHidden ∷ (IsSymbol name, Show a) + ⇒ ToFormHTML (InputHidden name a) (a → MarkupM Unit Unit) where + toForm _ x = input ! name n ! type' "hidden" ! value (show x) + where + n = reflectSymbol (SProxy ∷ SProxy name) instance toFormHtmlFConcat ∷ (ToFormHTML f1 m1, ToFormHTML f2 m2) ⇒ ToFormHTML (f1 :<> f2) (m1 :<> m2) where @@ -46,23 +52,3 @@ instance toFormHtmlFConcat ∷ (ToFormHTML f1 m1, ToFormHTML f2 m2) where p1 = Proxy ∷ Proxy f1 p2 = Proxy ∷ Proxy f2 - --- - -type PersonForm = - InputText "id" - :<> InputText "name" - :<> InputNumber "age" - -test ∷ String -test = - render $ - case toForm (Proxy :: Proxy PersonForm) of - idField :<> nameField :<> ageField → do - idField - label do - text "Name: " - nameField ! placeholder "Jane Doe…" - label do - text "Age: " - ageField From c7a635b3616607c0a30bdc230f48adcf8809abb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Mon, 27 Feb 2017 08:27:40 +0100 Subject: [PATCH 3/3] Add toForms construct, which gives a structure of rendering functions --- examples/SafeForm.purs | 40 ++++++++------ src/Hyper/Form/Safe.purs | 54 ------------------ src/Hyper/Routing.purs | 7 +++ src/Hyper/Routing/Form.purs | 107 ++++++++++++++++++++++++++++++++++++ 4 files changed, 136 insertions(+), 72 deletions(-) delete mode 100644 src/Hyper/Form/Safe.purs create mode 100644 src/Hyper/Routing/Form.purs diff --git a/examples/SafeForm.purs b/examples/SafeForm.purs index b1b82a8..20170ec 100644 --- a/examples/SafeForm.purs +++ b/examples/SafeForm.purs @@ -5,27 +5,28 @@ import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Except (ExceptT) import Data.Foldable (traverse_) -import Data.Maybe (Maybe(..), maybe) +import Data.Maybe (maybe) import Data.MediaType.Common (textHTML) -import Hyper.Form.Safe (type (:<>), InputHidden, InputNumber, InputText, toForm, (:<>)) -import Hyper.Node.Server (defaultOptions, runServer) +import Data.Monoid (mempty) +import Hyper.Node.Server (defaultOptionsWithLogging, runServer) import Hyper.Response (closeHeaders, contentType, respond, writeStatus) import Hyper.Routing (type (:/), type (:<|>), type (:>), Capture, (:<|>)) import Hyper.Routing.ContentType.HTML (class EncodeHTML, HTML, linkTo) +import Hyper.Routing.Form (type (:<>), InputHidden, InputNumber, InputText, toForms) import Hyper.Routing.Links (linksTo) -import Hyper.Routing.Method (Get) +import Hyper.Routing.Method (Get, Post) import Hyper.Routing.Router (RoutingError, router) import Node.Buffer (BUFFER) import Node.HTTP (HTTP) -import Text.Smolder.HTML (h1, label, p, table, tbody, td, th, thead, tr) -import Text.Smolder.HTML.Attributes (placeholder) -import Text.Smolder.Markup (text, (!)) +import Text.Smolder.HTML (h1, p, table, tbody, td, th, thead, tr) +import Text.Smolder.Markup (text) import Type.Proxy (Proxy(..)) import Prelude hiding (div) type Site = Get HTML Persons :<|> "new" :/ Get HTML NewPerson + :<|> Post HTML PersonSaved :<|> Capture "id" Int :> Get HTML EditPerson newtype Person = Person { id :: Int, name ∷ String, age ∷ Int } @@ -33,6 +34,7 @@ newtype Person = Person { id :: Int, name ∷ String, age ∷ Int } data Persons = Persons (Array Person) data NewPerson = NewPerson data EditPerson = EditPerson Person +data PersonSaved = PersonSaved type PersonForm = InputHidden "id" Int @@ -59,21 +61,19 @@ instance encodeHTMLPersons :: EncodeHTML Persons where instance encodeHTMLNewPerson :: EncodeHTML NewPerson where encodeHTML _ = - case toForm (Proxy :: Proxy PersonForm) of - idField :<> nameField :<> ageField → do - idField 0 - label do - text "Name: " - nameField Nothing ! placeholder "Jane Doe..." - label do - text "Age: " - ageField Nothing + case toForms site of + _ :<|> _ :<|> savePersonForm :<|> _ → do + p (text "New Person") + savePersonForm instance encodeHTMLPerson :: EncodeHTML EditPerson where encodeHTML (EditPerson (Person person)) = do h1 (text "Edit Person") p (text "TODO") +instance encodeHTMLPersonSaved :: EncodeHTML PersonSaved where + encodeHTML _ = mempty + allPersons ∷ ∀ m. Monad m ⇒ ExceptT RoutingError m Persons allPersons = [Person { id: 1, name: "Alice", age: 41 }] @@ -89,6 +89,9 @@ editPerson i = # EditPerson # pure +savePerson ∷ ∀ m. Monad m ⇒ ExceptT RoutingError m PersonSaved +savePerson = pure PersonSaved + site :: Proxy Site site = Proxy @@ -99,5 +102,6 @@ main = :*> contentType textHTML :*> closeHeaders :*> respond (maybe "" id msg) - appRouter = router site (allPersons :<|> newPerson :<|> editPerson) onRoutingError - in runServer defaultOptions {} appRouter + handlers = allPersons :<|> newPerson :<|> savePerson :<|> editPerson + appRouter = router site handlers onRoutingError + in runServer defaultOptionsWithLogging {} appRouter diff --git a/src/Hyper/Form/Safe.purs b/src/Hyper/Form/Safe.purs deleted file mode 100644 index e66d87d..0000000 --- a/src/Hyper/Form/Safe.purs +++ /dev/null @@ -1,54 +0,0 @@ -module Hyper.Form.Safe where - -import Prelude -import Data.Maybe (Maybe, maybe) -import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) -import Text.Smolder.HTML (input) -import Text.Smolder.HTML.Attributes (name, type', value) -import Text.Smolder.Markup (MarkupM, (!)) -import Type.Proxy (Proxy(..)) - --- - -data FAppend a b = FAppend a b - -infixl 4 type FAppend as :<> -infixl 4 FAppend as :<> - --- - -data InputText (name ∷ Symbol) = InputText String -data InputHidden (name ∷ Symbol) a = InputHidden a -data InputNumber (name ∷ Symbol) = InputNumber Int - --- - -class ToFormHTML f o | f → o where - toForm ∷ Proxy f → o - -instance toFormHtmlInputText ∷ IsSymbol name - ⇒ ToFormHTML (InputText name) (Maybe String → MarkupM Unit Unit) where - toForm _ s = maybe field (\x → field ! value x) s - where - n = reflectSymbol (SProxy ∷ SProxy name) - field = input ! name n ! type' "text" - -instance toFormHtmlInputNumber ∷ IsSymbol name - ⇒ ToFormHTML (InputNumber name) (Maybe Int → MarkupM Unit Unit) where - toForm _ x = maybe field (\x' → field ! value (show x')) x - where - n = reflectSymbol (SProxy ∷ SProxy name) - field = input ! name n ! type' "number" - -instance toFormHtmlInputHidden ∷ (IsSymbol name, Show a) - ⇒ ToFormHTML (InputHidden name a) (a → MarkupM Unit Unit) where - toForm _ x = input ! name n ! type' "hidden" ! value (show x) - where - n = reflectSymbol (SProxy ∷ SProxy name) - -instance toFormHtmlFConcat ∷ (ToFormHTML f1 m1, ToFormHTML f2 m2) - ⇒ ToFormHTML (f1 :<> f2) (m1 :<> m2) where - toForm _ = toForm p1 :<> toForm p2 - where - p1 = Proxy ∷ Proxy f1 - p2 = Proxy ∷ Proxy f2 diff --git a/src/Hyper/Routing.purs b/src/Hyper/Routing.purs index 60b04c1..03c32ff 100644 --- a/src/Hyper/Routing.purs +++ b/src/Hyper/Routing.purs @@ -4,6 +4,7 @@ module Hyper.Routing ( Lit , Capture , CaptureAll + , ReqBody , Handler , Raw , Sub @@ -30,6 +31,12 @@ data Capture (v :: Symbol) t -- | is a `Symbol` that describes data CaptureAll (v :: Symbol) t +-- | Captures and parses the request body in any of the specified content +-- | types. The `ct` type parmeter can be a single content type, or an `AltE` +-- | list of content types to allow. There has to be implementations of +-- | `FromFormData` for `t` and all specified content types. +data ReqBody ct t + -- | A type-level description of the handler function, terminating a chain of -- | path literals, captures, and other endpoint type constructs. The `m` symbol -- | is the HTTP method that is handled. `ct` is the content type. diff --git a/src/Hyper/Routing/Form.purs b/src/Hyper/Routing/Form.purs new file mode 100644 index 0000000..21b1429 --- /dev/null +++ b/src/Hyper/Routing/Form.purs @@ -0,0 +1,107 @@ +module Hyper.Routing.Form where + +import Prelude +import Data.String as String +import Data.Maybe (Maybe, maybe) +import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) +import Hyper.Routing (type (:<|>), type (:>), Capture, CaptureAll, Handler, Lit, (:<|>)) +import Hyper.Routing.PathPiece (class ToPathPiece, toPathPiece) +import Text.Smolder.HTML (form, input) +import Text.Smolder.HTML.Attributes (action, method, name, type', value) +import Text.Smolder.Markup (MarkupM, (!)) +import Type.Proxy (Proxy(..)) + +data FAppend a b = FAppend a b + +infixl 4 type FAppend as :<> +infixl 4 FAppend as :<> + +data InputText (name ∷ Symbol) = InputText String +data InputHidden (name ∷ Symbol) a = InputHidden a +data InputNumber (name ∷ Symbol) = InputNumber Int + +class ToFormFields f o | f → o where + toFields ∷ Proxy f → o + +instance toFormFieldsInputText ∷ IsSymbol name + ⇒ ToFormFields (InputText name) (Maybe String → MarkupM Unit Unit) where + toFields _ s = maybe field (\x → field ! value x) s + where + n = reflectSymbol (SProxy ∷ SProxy name) + field = input ! name n ! type' "text" + +instance toFormFieldsInputNumber ∷ IsSymbol name + ⇒ ToFormFields (InputNumber name) (Maybe Int → MarkupM Unit Unit) where + toFields _ x = maybe field (\x' → field ! value (show x')) x + where + n = reflectSymbol (SProxy ∷ SProxy name) + field = input ! name n ! type' "number" + +instance toFormFieldsInputHidden ∷ (IsSymbol name, Show a) + ⇒ ToFormFields (InputHidden name a) (a → MarkupM Unit Unit) where + toFields _ x = input ! name n ! type' "hidden" ! value (show x) + where + n = reflectSymbol (SProxy ∷ SProxy name) + +instance toFormFieldsFConcat ∷ (ToFormFields f1 m1, ToFormFields f2 m2) + ⇒ ToFormFields (f1 :<> f2) (m1 :<> m2) where + toFields _ = toFields p1 :<> toFields p2 + where + p1 = Proxy ∷ Proxy f1 + p2 = Proxy ∷ Proxy f2 + +data FormContext + = FormContext (Array String) + +class ToForm e r | e -> r where + toForm :: Proxy e -> FormContext -> r + +instance toFormAltE :: (ToForm e1 r1, ToForm e2 r2) + => ToForm (e1 :<|> e2) (r1 :<|> r2) where + toForm _ ctx = + toForm p1 ctx :<|> toForm p2 ctx + where + p1 = Proxy ∷ Proxy e1 + p2 = Proxy ∷ Proxy e2 + +instance toFormLit :: (ToForm sub r, IsSymbol lit) + => ToForm (Lit lit :> sub) r where + toForm _ (FormContext segments) = + toForm (Proxy ∷ Proxy sub) ctx + where + ctx = FormContext (segments <> [segment]) + segment = reflectSymbol (SProxy ∷ SProxy lit) + +instance toFormCapture :: (ToForm sub r, IsSymbol c, ToPathPiece t) + => ToForm (Capture c t :> sub) (t → r) where + toForm _ (FormContext segments) x = + toForm (Proxy ∷ Proxy sub) ctx + where + ctx = FormContext (segments <> [toPathPiece x]) + +instance toFormCaptureAll :: (ToForm sub r, IsSymbol c, ToPathPiece t) + => ToForm (CaptureAll c t :> sub) (Array t → r) where + toForm _ (FormContext segments) x = + toForm (Proxy ∷ Proxy sub) ctx + where + ctx = FormContext (segments <> (map toPathPiece x)) + +-- TODO: Consider supporting GET with forms and query params. +instance toFormHandlerGet :: ToForm + (Handler "GET" ct b) + Unit where + toForm _ (FormContext segments) = unit + +instance toFormHandlerPost :: ToForm + (Handler "POST" ct b) + (MarkupM Unit Unit) where + toForm _ (FormContext segments) = + form ! method "POST" ! action path $ pure unit + where + path = "/" <> String.joinWith "/" segments + +toForms + ∷ ∀ e m. ToForm e m + ⇒ Proxy e + → m +toForms p = toForm p (FormContext [])