From 12a527a9d53472e8a41791198779426c4aa880d0 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 11 Mar 2014 17:08:41 -0300 Subject: [PATCH 1/5] New Yesod.Form.Bootstrap3 module. The original renderBootstrap code was heavily modified by Mladen Srdic [1]. I took his code and modified it as well, and the result is this commit. [1] https://www.fpcomplete.com/user/msrdic/bootstrap-3-forms-with-yesod-1 --- yesod-form/Yesod/Form/Bootstrap3.hs | 243 ++++++++++++++++++++++++++++ yesod-form/yesod-form.cabal | 1 + 2 files changed, 244 insertions(+) create mode 100644 yesod-form/Yesod/Form/Bootstrap3.hs diff --git a/yesod-form/Yesod/Form/Bootstrap3.hs b/yesod-form/Yesod/Form/Bootstrap3.hs new file mode 100644 index 00000000..ceec0da6 --- /dev/null +++ b/yesod-form/Yesod/Form/Bootstrap3.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Helper functions for creating forms when using Bootstrap v3. +module Yesod.Form.Bootstrap3 + ( -- * Rendering forms + renderBootstrap3 + , BootstrapFormLayout(..) + , BootstrapGridOptions(..) + -- * Field settings + , bfs + , withPlaceholder + , withAutofocus + , withLargeInput + , withSmallInput + -- * Submit button + , bootstrapSubmit + , mbootstrapSubmit + , BootstrapSubmit(..) + ) where + +import Control.Arrow (second) +import Control.Monad (liftM) +import Data.Text (Text) +import Data.String (IsString(..)) +import Yesod.Core + +import Yesod.Form.Types +import Yesod.Form.Functions + +-- | Create a new 'FieldSettings' with the classes that are +-- required by Bootstrap v3. +bfs :: RenderMessage site msg => msg -> FieldSettings site +bfs msg = + FieldSettings (SomeMessage msg) Nothing Nothing Nothing [("class", "form-control")] + + +-- | Add a placeholder attribute to a field. If you need i18n +-- for the placeholder, currently you\'ll need to do a hack and +-- use 'getMessageRender' manually. +withPlaceholder :: Text -> FieldSettings site -> FieldSettings site +withPlaceholder placeholder fs = fs { fsAttrs = newAttrs } + where newAttrs = ("placeholder", placeholder) : fsAttrs fs + + +-- | Add an autofocus attribute to a field. +withAutofocus :: FieldSettings site -> FieldSettings site +withAutofocus fs = fs { fsAttrs = newAttrs } + where newAttrs = ("autofocus", "autofocus") : fsAttrs fs + + +-- | Add the @input-lg@ CSS class to a field. +withLargeInput :: FieldSettings site -> FieldSettings site +withLargeInput fs = fs { fsAttrs = newAttrs } + where newAttrs = ("class", " input-lg ") : fsAttrs fs + + +-- | Add the @input-sm@ CSS class to a field. +withSmallInput :: FieldSettings site -> FieldSettings site +withSmallInput fs = fs { fsAttrs = newAttrs } + where newAttrs = ("class", " input-sm ") : fsAttrs fs + + +-- | How many bootstrap grid columns should be taken (see +-- 'BootstrapFormLayout'). +data BootstrapGridOptions = + ColXs !Int + | ColSm !Int + | ColMd !Int + | ColLg !Int + deriving (Eq, Ord, Show) + +toColumn :: BootstrapGridOptions -> String +toColumn (ColXs 0) = "" +toColumn (ColSm 0) = "" +toColumn (ColMd 0) = "" +toColumn (ColLg 0) = "" +toColumn (ColXs columns) = "col-xs-" ++ show columns +toColumn (ColSm columns) = "col-sm-" ++ show columns +toColumn (ColMd columns) = "col-md-" ++ show columns +toColumn (ColLg columns) = "col-lg-" ++ show columns + +toOffset :: BootstrapGridOptions -> String +toOffset (ColXs 0) = "" +toOffset (ColSm 0) = "" +toOffset (ColMd 0) = "" +toOffset (ColLg 0) = "" +toOffset (ColXs columns) = "col-xs-offset-" ++ show columns +toOffset (ColSm columns) = "col-sm-offset-" ++ show columns +toOffset (ColMd columns) = "col-md-offset-" ++ show columns +toOffset (ColLg columns) = "col-lg-offset-" ++ show columns + +addGO :: BootstrapGridOptions -> BootstrapGridOptions -> BootstrapGridOptions +addGO (ColXs a) (ColXs b) = ColXs (a+b) +addGO (ColSm a) (ColSm b) = ColSm (a+b) +addGO (ColMd a) (ColMd b) = ColMd (a+b) +addGO (ColLg a) (ColLg b) = ColLg (a+b) +addGO a b | a > b = addGO b a +addGO (ColXs a) other = addGO (ColSm a) other +addGO (ColSm a) other = addGO (ColMd a) other +addGO (ColMd a) other = addGO (ColLg a) other +addGO (ColLg _) _ = error "Yesod.Form.Bootstrap.addGO: never here" + + +-- | The layout used for the bootstrap form. +data BootstrapFormLayout = + BootstrapBasicForm + | BootstrapInlineForm + | BootstrapHorizontalForm + { bflLabelOffset :: !BootstrapGridOptions + , bflLabelSize :: !BootstrapGridOptions + , bflInputOffset :: !BootstrapGridOptions + , bflInputSize :: !BootstrapGridOptions + } + deriving (Show) + + +-- | Render the given form using Bootstrap v3 conventions. +-- +-- Sample Hamlet for 'BootstrapHorizontalForm': +-- +-- >
+-- > ^{formWidget} +-- > ^{bootstrapSubmit MsgSubmit} +renderBootstrap3 :: Monad m => BootstrapFormLayout -> FormRender m a +renderBootstrap3 formLayout aform fragment = do + (res, views') <- aFormToForm aform + let views = views' [] + has (Just _) = True + has Nothing = False + widget = [whamlet| + $newline never + #{fragment} + ^{formFailureWidget res} + $forall view <- views +
+ $case formLayout + $of BootstrapBasicForm + $if fvId view /= bootstrapSubmitId +