Created
July 26, 2018 19:44
-
-
Save nmk/adbd511ecd1144ed64dd75f9bcccbd4e to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env stack | |
-- stack --resolver lts-11.15 script --package text --package yesod | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE QuasiQuotes #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
{-# LANGUAGE TypeFamilies #-} | |
module SelTest where | |
import Control.Arrow ((&&&)) | |
import Data.Text (Text, pack) | |
import Prelude | |
import Yesod | |
data App = App | |
data Fruit = Apple | Banana | Coconut deriving (Show, Eq, Bounded, Enum) | |
data FormData = FormData | |
{ foo :: [Fruit] | |
} deriving (Show) | |
mkYesod "App" [parseRoutes| | |
/ HomeR GET POST | |
|] | |
instance Yesod App | |
instance RenderMessage App FormMessage where | |
renderMessage _ _ = defaultFormMessage | |
form :: Html -> MForm Handler (FormResult FormData, Widget) | |
form = renderDivs $ FormData <$> areq (check checkFruits (checkboxesField optionsEnum)) "Selecting fruits: " Nothing | |
checkFruits :: [Fruit] -> Either Text [Fruit] | |
checkFruits xs | Banana `elem` xs = Left "no bananas allowed" | |
| otherwise = Right xs | |
checkRange :: Int -> Either Text Int | |
checkRange n | n < 3 || n > 7 = Left "out of range" | |
| otherwise = Right n | |
getHomeR, postHomeR :: Handler Html | |
getHomeR = postHomeR | |
postHomeR = do | |
((result, widget), enctype) <- runFormPost form | |
case result of | |
FormSuccess formData -> defaultLayout [whamlet|<p>#{show formData}|] | |
_ -> defaultLayout | |
[whamlet| | |
<p>Invalid input, let's try again. | |
<form method=post action=@{HomeR} enctype=#{enctype}> | |
^{widget} | |
<button>Submit | |
|] | |
main = warp 3040 App |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment