diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,19 @@ +# Changelog for yesod-form-bulma + +## Unreleased changes + +- Upgrade to yesod-core 1.6 +- Add bulmaTextField +- Add bulmaTextareaField +- Add bulmaEmailField +- Add bulmaCheckBoxField +- Add bulmaSelectField +- Add bulmaSelectFieldList +- Add bulmaRadioField +- Add bulmaRadioFieldList +- Add bulmaIntField +- Add bulmaCheckboxesFieldList +- Add bulmaCheckboxesField +- Add bulmaMultiSelectFieldList +- Add bulmaMultiSelectField +- Add Showcases diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Shinya Yamaguchi (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Shinya Yamaguchi nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,64 @@ +[![CircleCI](https://circleci.com/gh/waddlaw/yesod-form-bulma/tree/master.svg?style=svg)](https://circleci.com/gh/waddlaw/yesod-form-bulma/tree/master) + +# yesod-form-bulma + +- [Bulma](https://bulma.io/documentation/form/) +- [Bulma-Extensions](https://wikiki.github.io/form/checkradio/) + + +## Screenshot + +![a](https://i.imgur.com/SZnv42b.png) + +## Run + +simple example. + +```sh +$ stack build +$ stack exec example +``` + +full components showcase. + +```sh +$ stack build +$ stack exec showcase +``` + +Access to [localhost:3100](http://localhost:3100) + +## Implemented status + +### Yesod.Form.Fields + +#### Fields + +- [x] bulmaTextField +- [ ] bulmaPasswordField +- [x] bulmaTextareaField +- [ ] bulmaHiddenField +- [x] bulmaIntField +- [ ] bulmaDayField +- [ ] bulmaTimeFieldTypeTime +- [ ] bulmaTimeFieldTypeText +- [ ] bulmaHtmlField +- [x] bulmaEmailField +- [ ] bulmaMultiEmailField +- [ ] bulmaSearchField +- [ ] bulmaUrlField +- [ ] bulmaDoubleField +- [ ] bulmaBoolField +- [x] bulmaCheckBoxField +- [ ] bulmaFileField + +#### Options + +- [x] bulmaSelectField +- [x] bulmaSelectFieldList +- [x] bulmaRadioField +- [x] bulmaRadioFieldList +- [x] bulmaCheckboxesField +- [x] bulmaCheckboxesFieldList +- [x] bulmaMultiSelectField +- [x] bulmaMultiSelectFieldList diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Example/Main.hs b/app/Example/Main.hs new file mode 100644 --- /dev/null +++ b/app/Example/Main.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} +module Main (main) where + +import Data.Text (Text) +import Yesod +import Yesod.Form.Bulma + +data App = App + +mkYesod "App" [parseRoutes| +/ HomeR GET POST +|] + +instance Yesod App +instance YesodBulma App + +instance RenderMessage App FormMessage where + renderMessage _ _ = defaultFormMessage + +data Basic = Basic + { name :: Text + , username :: Text + , email :: Text + , subject :: Text + , message :: Textarea + , agree :: Bool + , question :: Text + } + +basicForm :: Html -> MForm Handler (FormResult Basic, Widget) +basicForm = renderBulma BulmaBasicForm $ Basic + <$> areq bulmaTextField ("Text input" `withPlaceholder` "Name") Nothing + <*> areq bulmaTextField ("bulma" `withPlaceholder` "Username") Nothing + <*> areq bulmaEmailField ("Email input" `withPlaceholder` "Email") Nothing + <*> areq (bulmaSelectFieldList [("Select dropdown" :: Text, "v1"), ("With options", "v2")] ) "Subject" Nothing + <*> areq bulmaTextareaField ("Textarea" `withPlaceholder` "Message") Nothing + <*> areq (bulmaCheckBoxField "I agree to the terms and conditions") "" Nothing + <*> areq (bulmaRadioFieldList [("yes" :: Text, "y"), ("no", "n")]) "" Nothing + <* bulmaSubmit (BulmaSubmit ("Submit" :: Text) "btn-default" [("attribute-name", "attribute-value")]) + +getHomeR :: Handler Html +getHomeR = do + ((result, form1), enctype) <- runFormPost basicForm + + defaultLayout $ + case result of + FormSuccess res -> + [whamlet| +
+
+
+ ^{form1} + +
+ + + + + + + + + |] + _ -> + [whamlet| +
+
+ + ^{form1} + |] + +postHomeR :: Handler Html +postHomeR = getHomeR + +main :: IO () +main = warp 3100 App diff --git a/app/Showcase/Main.hs b/app/Showcase/Main.hs new file mode 100644 --- /dev/null +++ b/app/Showcase/Main.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} +module Main (main) where + +import Control.Arrow ((&&&)) +import Data.Text (Text, pack) +import Yesod +import Yesod.Form.Bulma + +data App = App + +mkYesod "App" [parseRoutes| +/ HomeR GET POST +|] + +instance Yesod App +instance YesodBulma App + +instance RenderMessage App FormMessage where + renderMessage _ _ = defaultFormMessage + +data Basic = Basic + { getTextField :: Text + -- , getPasswordField :: Text + , getTextareaField :: Textarea + -- , getHiddenField :: Text + , getIntField :: Int + -- , getDayField :: Day + -- , getTimeFieldTypeTime :: Text + -- , getTimeFieldTypeText + -- , getHtmlField + , getEmailField :: Text + -- , getMultiEmailField + -- , getSearchField + -- , getUrlField + -- , getDoubleField + -- , getBoolField + , getCheckBoxField :: Bool + -- , getFileField + , getSelectField :: Color + , getSelectFieldList :: Color + , getRadioField :: Color + , getRadioFieldList :: Color + , getCheckboxesField :: [Color] + , getCheckboxesFieldList :: [Color] + , getMultiSelectField :: [Color] + , getMultiSelectFieldList :: [Color] + } + +data Color = Red | Blue | Gray | Black + deriving (Show, Eq, Enum, Bounded) + +colors :: [(Text, Color)] +colors = map (pack . show &&& id) [minBound .. maxBound] + +basicForm :: Html -> MForm Handler (FormResult Basic, Widget) +basicForm = renderBulma BulmaBasicForm $ Basic + <$> areq bulmaTextField "bulmaTextField" Nothing + <*> areq bulmaTextareaField "bulmaTextareaField" Nothing + <*> areq bulmaIntField "bulmaIntField" Nothing + <*> areq bulmaEmailField "bulmaEmailField" Nothing + <*> areq (bulmaCheckBoxField "bulmaCheckBoxField") "" Nothing + <*> areq (bulmaSelectField optionsEnum) "bulmaSelectField" Nothing + <*> areq (bulmaSelectFieldList colors) "bulmaSelectFieldList" Nothing + <*> areq (bulmaRadioFieldList colors) "bulmaRadioList" Nothing + <*> areq (bulmaRadioFieldList colors) "bulmaRadioFieldList" Nothing + <*> areq (bulmaCheckboxesField optionsEnum) "bulmaCheckboxesField" Nothing + <*> areq (bulmaCheckboxesFieldList colors) "bulmaCheckboxesFieldList" Nothing + <*> areq (bulmaMultiSelectField optionsEnum) "bulmaMultiSelectField" Nothing + <*> areq (bulmaMultiSelectFieldList colors) "bulmaMultiSelectFieldList" Nothing + <* bulmaSubmit (BulmaSubmit ("Submit" :: Text) "btn-default" [("attribute-name", "attribute-value")]) + +getHomeR :: Handler Html +getHomeR = do + ((_result, form1), enctype) <- runFormPost basicForm + + defaultLayout + [whamlet| $newline never +
+
+ + ^{form1} + |] + +postHomeR :: Handler Html +postHomeR = getHomeR + +main :: IO () +main = warp 3100 App diff --git a/src/Yesod/Form/Bulma.hs b/src/Yesod/Form/Bulma.hs new file mode 100644 --- /dev/null +++ b/src/Yesod/Form/Bulma.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeFamilies #-} +module Yesod.Form.Bulma + ( module Yesod.Form.Bulma.Fields + , module Yesod.Form.Bulma.Class + , renderBulma + , bulmaSubmit + , BulmaSubmit(..) + , BulmaFormLayout(..) + , withPlaceholder + ) where + +import Data.Bifunctor +import Data.Text (Text) +import Text.Shakespeare.I18N +import Yesod.Core +import Yesod.Form.Bulma.Class +import Yesod.Form.Bulma.Fields +import Yesod.Form.Bulma.Utils +import Yesod.Form.Functions +import Yesod.Form.Types + +data BulmaFormLayout = BulmaBasicForm + +data BulmaSubmit msg = + BulmaSubmit + { _bulmaValue :: msg -- ^ The text of the submit button. + , _bulmaClasses :: Text -- ^ Classes added to the @\
Name#{name res}
Username#{username res}
Email#{email res}
Subject#{subject res}
Message#{message res}
Agree#{agree res}
Question#{question res}