1{-# LANGUAGE QuasiQuotes #-} 2{-# LANGUAGE TypeFamilies #-} 3{-# LANGUAGE OverloadedStrings #-} 4-- | Helper functions for creating forms when using <http://getbootstrap.com/ Bootstrap 3>. 5-- 6 7module Yesod.Form.Bootstrap3 8 ( -- * Example: Rendering a basic form 9 -- $example 10 11 -- * Example: Rendering a horizontal form 12 -- $example2 13 14 -- * Rendering forms 15 renderBootstrap3 16 , BootstrapFormLayout(..) 17 , BootstrapGridOptions(..) 18 -- * Field settings 19 -- $fieldSettings 20 , bfs 21 , withPlaceholder 22 , withAutofocus 23 , withLargeInput 24 , withSmallInput 25 -- * Submit button 26 , bootstrapSubmit 27 , mbootstrapSubmit 28 , BootstrapSubmit(..) 29 ) where 30 31import Control.Arrow (second) 32import Control.Monad (liftM) 33import Data.Text (Text) 34import Data.String (IsString(..)) 35import qualified Text.Blaze.Internal as Blaze 36import Yesod.Core 37import Yesod.Form.Types 38import Yesod.Form.Functions 39 40-- | Create a new 'FieldSettings' with the @form-control@ class that is 41-- required by Bootstrap v3. 42-- 43-- Since: yesod-form 1.3.8 44bfs :: RenderMessage site msg => msg -> FieldSettings site 45bfs msg = 46 FieldSettings (SomeMessage msg) Nothing Nothing Nothing [("class", "form-control")] 47 48 49-- | Add a placeholder attribute to a field. If you need i18n 50-- for the placeholder, currently you\'ll need to do a hack and 51-- use 'getMessageRender' manually. 52-- 53-- Since: yesod-form 1.3.8 54withPlaceholder :: Text -> FieldSettings site -> FieldSettings site 55withPlaceholder placeholder fs = fs { fsAttrs = newAttrs } 56 where newAttrs = ("placeholder", placeholder) : fsAttrs fs 57 58 59-- | Add an autofocus attribute to a field. 60-- 61-- Since: yesod-form 1.3.8 62withAutofocus :: FieldSettings site -> FieldSettings site 63withAutofocus fs = fs { fsAttrs = newAttrs } 64 where newAttrs = ("autofocus", "autofocus") : fsAttrs fs 65 66 67-- | Add the @input-lg@ CSS class to a field. 68-- 69-- Since: yesod-form 1.3.8 70withLargeInput :: FieldSettings site -> FieldSettings site 71withLargeInput fs = fs { fsAttrs = newAttrs } 72 where newAttrs = addClass "input-lg" (fsAttrs fs) 73 74 75-- | Add the @input-sm@ CSS class to a field. 76-- 77-- Since: yesod-form 1.3.8 78withSmallInput :: FieldSettings site -> FieldSettings site 79withSmallInput fs = fs { fsAttrs = newAttrs } 80 where newAttrs = addClass "input-sm" (fsAttrs fs) 81 82 83-- | How many bootstrap grid columns should be taken (see 84-- 'BootstrapFormLayout'). 85-- 86-- Since: yesod-form 1.3.8 87data BootstrapGridOptions = 88 ColXs !Int 89 | ColSm !Int 90 | ColMd !Int 91 | ColLg !Int 92 deriving (Eq, Ord, Show) 93 94toColumn :: BootstrapGridOptions -> String 95toColumn (ColXs 0) = "" 96toColumn (ColSm 0) = "" 97toColumn (ColMd 0) = "" 98toColumn (ColLg 0) = "" 99toColumn (ColXs columns) = "col-xs-" ++ show columns 100toColumn (ColSm columns) = "col-sm-" ++ show columns 101toColumn (ColMd columns) = "col-md-" ++ show columns 102toColumn (ColLg columns) = "col-lg-" ++ show columns 103 104toOffset :: BootstrapGridOptions -> String 105toOffset (ColXs 0) = "" 106toOffset (ColSm 0) = "" 107toOffset (ColMd 0) = "" 108toOffset (ColLg 0) = "" 109toOffset (ColXs columns) = "col-xs-offset-" ++ show columns 110toOffset (ColSm columns) = "col-sm-offset-" ++ show columns 111toOffset (ColMd columns) = "col-md-offset-" ++ show columns 112toOffset (ColLg columns) = "col-lg-offset-" ++ show columns 113 114addGO :: BootstrapGridOptions -> BootstrapGridOptions -> BootstrapGridOptions 115addGO (ColXs a) (ColXs b) = ColXs (a+b) 116addGO (ColSm a) (ColSm b) = ColSm (a+b) 117addGO (ColMd a) (ColMd b) = ColMd (a+b) 118addGO (ColLg a) (ColLg b) = ColLg (a+b) 119addGO a b | a > b = addGO b a 120addGO (ColXs a) other = addGO (ColSm a) other 121addGO (ColSm a) other = addGO (ColMd a) other 122addGO (ColMd a) other = addGO (ColLg a) other 123addGO (ColLg _) _ = error "Yesod.Form.Bootstrap.addGO: never here" 124 125 126-- | The layout used for the bootstrap form. 127-- 128-- Since: yesod-form 1.3.8 129data BootstrapFormLayout = 130 BootstrapBasicForm -- ^ A form with labels and inputs listed vertically. See <http://getbootstrap.com/css/#forms-example> 131 | BootstrapInlineForm -- ^ A form whose @\<inputs>@ are laid out horizontally (displayed as @inline-block@). For this layout, @\<label>@s are still added to the HTML, but are hidden from display. When using this layout, you must add the @form-inline@ class to your form tag. See <http://getbootstrap.com/css/#forms-inline> 132 | BootstrapHorizontalForm 133 { bflLabelOffset :: !BootstrapGridOptions -- ^ The left <http://getbootstrap.com/css/#grid-offsetting offset> of the @\<label>@. 134 , bflLabelSize :: !BootstrapGridOptions -- ^ The number of grid columns the @\<label>@ should use. 135 , bflInputOffset :: !BootstrapGridOptions -- ^ The left <http://getbootstrap.com/css/#grid-offsetting offset> of the @\<input>@ from its @\<label>@. 136 , bflInputSize :: !BootstrapGridOptions -- ^ The number of grid columns the @\<input>@ should use. 137 } -- ^ A form laid out using the Bootstrap grid, with labels in the left column and inputs on the right. When using this layout, you must add the @form-horizontal@ class to your form tag. Bootstrap requires additional markup for the submit button for horizontal forms; you can use 'bootstrapSubmit' in your form or write the markup manually. See <http://getbootstrap.com/css/#forms-horizontal> 138 deriving (Show) 139 140 141-- | Render the given form using Bootstrap v3 conventions. 142-- 143-- Since: yesod-form 1.3.8 144renderBootstrap3 :: Monad m => BootstrapFormLayout -> FormRender m a 145renderBootstrap3 formLayout aform fragment = do 146 (res, views') <- aFormToForm aform 147 let views = views' [] 148 has (Just _) = True 149 has Nothing = False 150 widget = [whamlet| 151 $newline never 152 #{fragment} 153 $forall view <- views 154 <div .form-group :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.has-error> 155 $case formLayout 156 $of BootstrapBasicForm 157 $if fvId view /= bootstrapSubmitId 158 <label :Blaze.null (fvLabel view):.sr-only for=#{fvId view}>#{fvLabel view} 159 ^{fvInput view} 160 ^{helpWidget view} 161 $of BootstrapInlineForm 162 $if fvId view /= bootstrapSubmitId 163 <label .sr-only for=#{fvId view}>#{fvLabel view} 164 ^{fvInput view} 165 ^{helpWidget view} 166 $of BootstrapHorizontalForm labelOffset labelSize inputOffset inputSize 167 $if fvId view /= bootstrapSubmitId 168 <label :Blaze.null (fvLabel view):.sr-only .control-label .#{toOffset labelOffset} .#{toColumn labelSize} for=#{fvId view}>#{fvLabel view} 169 <div .#{toOffset inputOffset} .#{toColumn inputSize}> 170 ^{fvInput view} 171 ^{helpWidget view} 172 $else 173 <div .#{toOffset (addGO inputOffset (addGO labelOffset labelSize))} .#{toColumn inputSize}> 174 ^{fvInput view} 175 ^{helpWidget view} 176 |] 177 return (res, widget) 178 179 180-- | (Internal) Render a help widget for tooltips and errors. 181helpWidget :: FieldView site -> WidgetFor site () 182helpWidget view = [whamlet| 183 $maybe tt <- fvTooltip view 184 <span .help-block>#{tt} 185 $maybe err <- fvErrors view 186 <span .help-block .error-block>#{err} 187|] 188 189 190-- | How the 'bootstrapSubmit' button should be rendered. 191-- 192-- Since: yesod-form 1.3.8 193data BootstrapSubmit msg = 194 BootstrapSubmit 195 { bsValue :: msg 196 -- ^ The text of the submit button. 197 , bsClasses :: Text 198 -- ^ Classes added to the @\<button>@. 199 , bsAttrs :: [(Text, Text)] 200 -- ^ Attributes added to the @\<button>@. 201 } deriving (Show) 202 203instance IsString msg => IsString (BootstrapSubmit msg) where 204 fromString msg = BootstrapSubmit (fromString msg) " btn-default " [] 205 206 207-- | A Bootstrap v3 submit button disguised as a field for 208-- convenience. For example, if your form currently is: 209-- 210-- > Person <$> areq textField "Name" Nothing 211-- > <*> areq textField "Surname" Nothing 212-- 213-- Then just change it to: 214-- 215-- > Person <$> areq textField "Name" Nothing 216-- > <*> areq textField "Surname" Nothing 217-- > <* bootstrapSubmit ("Register" :: BootstrapSubmit Text) 218-- 219-- (Note that '<*' is not a typo.) 220-- 221-- Alternatively, you may also just create the submit button 222-- manually as well in order to have more control over its 223-- layout. 224-- 225-- Since: yesod-form 1.3.8 226bootstrapSubmit 227 :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) 228 => BootstrapSubmit msg -> AForm m () 229bootstrapSubmit = formToAForm . liftM (second return) . mbootstrapSubmit 230 231 232-- | Same as 'bootstrapSubmit' but for monadic forms. This isn't 233-- as useful since you're not going to use 'renderBootstrap3' 234-- anyway. 235-- 236-- Since: yesod-form 1.3.8 237mbootstrapSubmit 238 :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) 239 => BootstrapSubmit msg -> MForm m (FormResult (), FieldView site) 240mbootstrapSubmit (BootstrapSubmit msg classes attrs) = 241 let res = FormSuccess () 242 widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|] 243 fv = FieldView { fvLabel = "" 244 , fvTooltip = Nothing 245 , fvId = bootstrapSubmitId 246 , fvInput = widget 247 , fvErrors = Nothing 248 , fvRequired = False } 249 in return (res, fv) 250 251 252-- | A royal hack. Magic id used to identify whether a field 253-- should have no label. A valid HTML4 id which is probably not 254-- going to clash with any other id should someone use 255-- 'bootstrapSubmit' outside 'renderBootstrap3'. 256bootstrapSubmitId :: Text 257bootstrapSubmitId = "b:ootstrap___unique__:::::::::::::::::submit-id" 258 259-- $example 260-- @\<input\>@ tags in Bootstrap 3 require the @form-control@ class, 261-- and so they need modified 'FieldSettings' to display correctly. 262-- 263-- When creating your forms, use the 'bfs' function to add this class: 264-- 265-- > personForm :: AForm Handler Person 266-- > personForm = Person 267-- > <$> areq textField (bfs ("Name" :: Text)) Nothing 268-- > <*> areq textField (bfs ("Surname" :: Text)) Nothing 269-- 270-- That form can then be rendered into a widget using the 'renderBootstrap3' function. Here, the form is laid out vertically using 'BootstrapBasicForm': 271-- 272-- > (formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm personForm 273-- 274-- And then used in Hamlet: 275-- 276-- > <form role=form method=post action=@{ActionR} enctype=#{formEnctype}> 277-- > ^{formWidget} 278-- > <button type="submit" .btn .btn-default>Submit 279 280-- $example2 281-- Yesod.Form.Bootstrap3 also supports <http://getbootstrap.com/css/#forms-horizontal horizontal, grid based forms>. 282-- These forms require additional markup for the submit tag, which is provided by the 'bootstrapSubmit' function: 283-- 284-- > personForm :: AForm Handler Person 285-- > personForm = Person 286-- > <$> areq textField MsgName Nothing 287-- > <*> areq textField MsgSurname Nothing 288-- > <* bootstrapSubmit (BootstrapSubmit MsgSubmit "btn-default" [("attribute-name","attribute-value")]) 289-- > -- Note: bootstrapSubmit works with all BootstrapFormLayouts, but provides the additional markup required for Bootstrap's horizontal forms. 290-- 291-- That form can be rendered with specific grid spacing: 292-- 293-- > (formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 (BootstrapHorizontalForm (ColSm 0) (ColSm 4) (ColSm 0) (ColSm 6)) personForm 294-- 295-- And then used in Hamlet. Note the additional @form-horizontal@ class on the form, and that a manual submit tag isn't required: 296-- 297-- > <form .form-horizontal role=form method=post action=@{ActionR} enctype=#{formEnctype}> 298-- > ^{formWidget} 299 300-- $fieldSettings 301-- This module comes with several methods to help customize your Bootstrap 3 @\<input\>@s. 302-- These functions can be chained together to apply several properties to an input: 303-- 304-- > userForm :: AForm Handler UserForm 305-- > userForm = UserForm 306-- > <$> areq textField nameSettings Nothing 307-- > where nameSettings = withAutofocus $ 308-- > withPlaceholder "First name" $ 309-- > (bfs ("Name" :: Text)) 310