Minimal test app
This commit is contained in:
parent
d170771d64
commit
2bbab50acb
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Yesod.Form.Types
|
||||
( -- * Helpers
|
||||
Enctype (..)
|
||||
@ -100,7 +101,7 @@ data FieldSettings msg = FieldSettings
|
||||
, fsName :: Maybe Text
|
||||
}
|
||||
|
||||
instance IsString a => IsString (FieldSettings a) where
|
||||
instance (a ~ Text) => IsString (FieldSettings a) where
|
||||
fromString s = FieldSettings (fromString s) Nothing Nothing Nothing
|
||||
|
||||
data FieldView xml = FieldView
|
||||
|
||||
48
hello-forms.hs
Normal file
48
hello-forms.hs
Normal file
@ -0,0 +1,48 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
|
||||
import Yesod.Core
|
||||
import Yesod.Form
|
||||
import Control.Applicative
|
||||
import Data.Text (Text, pack)
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
|
||||
data Fruit = Apple | Banana | Pear
|
||||
deriving (Show, Enum, Bounded, Eq)
|
||||
|
||||
fruits :: [(Text, Fruit)]
|
||||
fruits = map (\x -> (pack $ show x, x)) [minBound..maxBound]
|
||||
|
||||
myForm = fixType $ runFormGet $ renderDivs $ pure (,,,,)
|
||||
<*> areq textField "Text field" Nothing
|
||||
<*> areq (selectField fruits) "Select field" Nothing
|
||||
<*> aopt (selectField fruits) "Opt select field" Nothing
|
||||
<*> aopt intField "Opt int field" Nothing
|
||||
<*> aopt (radioField fruits) "Opt radio" Nothing
|
||||
|
||||
data HelloForms = HelloForms
|
||||
type Handler = GHandler HelloForms HelloForms
|
||||
|
||||
fixType :: Handler a -> Handler a
|
||||
fixType = id
|
||||
|
||||
instance RenderMessage HelloForms FormMessage where
|
||||
renderMessage _ _ = defaultFormMessage
|
||||
|
||||
instance Yesod HelloForms where
|
||||
approot _ = ""
|
||||
|
||||
mkYesod "HelloForms" [parseRoutes|
|
||||
/ RootR GET
|
||||
|]
|
||||
|
||||
getRootR = do
|
||||
((res, form), enctype) <- myForm
|
||||
defaultLayout [whamlet|
|
||||
<p>Result: #{show res}
|
||||
<form enctype=#{enctype}>
|
||||
^{form}
|
||||
<div>
|
||||
<input type=submit>
|
||||
|]
|
||||
|
||||
main = toWaiApp HelloForms >>= run 3000
|
||||
Loading…
Reference in New Issue
Block a user