yesod-form-bootstrap4 1.0.2 → 2.0.0
raw patch · 2 files changed
+90/−89 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- src/Yesod/Form/Bootstrap4.hs +88/−87
- yesod-form-bootstrap4.cabal +2/−2
src/Yesod/Form/Bootstrap4.hs view
@@ -7,18 +7,18 @@ -- yesod-form under MIT license, author is Michael Snoyman <michael@snoyman.com> module Yesod.Form.Bootstrap4- ( renderBootstrap4- , BootstrapFormLayout(..)- , BootstrapGridOptions(..)- , bfs- , withPlaceholder- , withAutofocus- , withLargeInput- , withSmallInput- , bootstrapSubmit- , mbootstrapSubmit- , BootstrapSubmit(..)- ) where+ ( renderBootstrap4+ , BootstrapFormLayout(..)+ , BootstrapGridOptions(..)+ , bfs+ , withPlaceholder+ , withAutofocus+ , withLargeInput+ , withSmallInput+ , bootstrapSubmit+ , mbootstrapSubmit+ , BootstrapSubmit(..)+ ) where import Control.Arrow (second) import Data.Maybe (isJust)@@ -33,25 +33,25 @@ withPlaceholder :: Text -> FieldSettings site -> FieldSettings site withPlaceholder placeholder fs = fs { fsAttrs = newAttrs }- where newAttrs = ("placeholder", placeholder) : fsAttrs fs+ 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+ 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 = addClass "form-control-lg" (fsAttrs fs)+ where newAttrs = addClass "form-control-lg" (fsAttrs fs) -- | Add the @input-sm@ CSS class to a field. withSmallInput :: FieldSettings site -> FieldSettings site withSmallInput fs = fs { fsAttrs = newAttrs }- where newAttrs = addClass "form-control-sm" (fsAttrs fs)+ where newAttrs = addClass "form-control-sm" (fsAttrs fs) data BootstrapGridOptions = ColXs !Int | ColSm !Int | ColMd !Int | ColLg !Int | ColXl !Int- deriving (Eq, Ord, Show, Read)+ deriving (Eq, Ord, Show, Read) toColumn :: BootstrapGridOptions -> String toColumn (ColXs columns) = "col-xs-" ++ show columns@@ -76,89 +76,88 @@ 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 _ _ = error "Yesod.Form.Bootstrap.addGO: never here"+addGO _ _ = 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 (Eq, Ord, Show, Read)+ BootstrapHorizontalForm+ { bflLabelOffset :: !BootstrapGridOptions+ , bflLabelSize :: !BootstrapGridOptions+ , bflInputOffset :: !BootstrapGridOptions+ , bflInputSize :: !BootstrapGridOptions+ }+ deriving (Eq, Ord, Show, Read) -- | Render the given form using Bootstrap v3 conventions. renderBootstrap4 :: Monad m => BootstrapFormLayout -> FormRender m a renderBootstrap4 formLayout aform fragment = do- (res, views') <- aFormToForm aform- let views = views' []- widget = [whamlet|- #{fragment}- $forall view <- views- <div .form-group :isJust (fvErrors view):.has-danger>- $case formLayout- $of BootstrapBasicForm- $if fvId view /= bootstrapSubmitId- <label .form-control-label for=#{fvId view}>#{fvLabel view}- ^{fvInput view}- ^{helpWidget view}- $of BootstrapInlineForm- $if fvId view /= bootstrapSubmitId- <label .sr-only .form-control-label for=#{fvId view}>#{fvLabel view}- ^{fvInput view}- ^{helpWidget view}- $of BootstrapHorizontalForm labelOffset labelSize inputOffset inputSize- $if fvId view /= bootstrapSubmitId- <div .row>- <label- .form-control-label- .#{toOffset labelOffset}- .#{toColumn labelSize}- for=#{fvId view}>#{fvLabel view}- <div .#{toOffset inputOffset} .#{toColumn inputSize}>- ^{fvInput view}- ^{helpWidget view}- $else- <div- .#{toOffset (addGO inputOffset (addGO labelOffset labelSize))}- .#{toColumn inputSize}>- ^{fvInput view}- ^{helpWidget view}- |]- return (res, widget)+ (res, views') <- aFormToForm aform+ let views = views' []+ widget = [whamlet|+#{fragment}+$forall view <- views+ <div .form-group :isJust (fvErrors view):.has-danger>+ $case formLayout+ $of BootstrapBasicForm+ $if fvId view /= bootstrapSubmitId+ <label for=#{fvId view}>#{fvLabel view}+ ^{fvInput view}+ ^{helpWidget view}+ $of BootstrapInlineForm+ $if fvId view /= bootstrapSubmitId+ <label .sr-only for=#{fvId view}>#{fvLabel view}+ ^{fvInput view}+ ^{helpWidget view}+ $of BootstrapHorizontalForm labelOffset labelSize inputOffset inputSize+ $if fvId view /= bootstrapSubmitId+ <div .row>+ <label+ .#{toOffset labelOffset}+ .#{toColumn labelSize}+ for=#{fvId view}>#{fvLabel view}+ <div .#{toOffset inputOffset} .#{toColumn inputSize}>+ ^{fvInput view}+ ^{helpWidget view}+ $else+ <div+ .#{toOffset (addGO inputOffset (addGO labelOffset labelSize))}+ .#{toColumn inputSize}>+ ^{fvInput view}+ ^{helpWidget view}+ |]+ return (res, widget) -- | (Internal) Render a help widget for tooltips and errors. helpWidget :: FieldView site -> WidgetFor site () helpWidget view = [whamlet|- $maybe err <- fvErrors view- <div .form-control-feedback>#{err}- $maybe tt <- fvTooltip view- <small .form-text .text-muted>#{tt}+$maybe err <- fvErrors view+ <div .invalid-feedback>#{err}+$maybe tt <- fvTooltip view+ <small .form-text .text-muted>#{tt} |] -- | How the 'bootstrapSubmit' button should be rendered. data BootstrapSubmit msg =- BootstrapSubmit- { bsValue :: msg -- ^ The text of the submit button.- , bsClasses :: Text -- ^ Classes added to the @\<button>@.- , bsAttrs :: [(Text, Text)] -- ^ Attributes added to the @\<button>@.- } deriving (Eq, Ord, Show, Read)+ BootstrapSubmit+ { bsValue :: msg -- ^ The text of the submit button.+ , bsClasses :: Text -- ^ Classes added to the @\<button>@.+ , bsAttrs :: [(Text, Text)] -- ^ Attributes added to the @\<button>@.+ } deriving (Eq, Ord, Show, Read) instance IsString msg => IsString (BootstrapSubmit msg) where- fromString msg = BootstrapSubmit (fromString msg) "btn-primary" []+ fromString msg = BootstrapSubmit (fromString msg) "btn-primary" [] -- | A Bootstrap v4 submit button disguised as a field for -- convenience. For example, if your form currently is: ----- > Person <$> areq textField "Name" Nothing--- > <*> areq textField "Surname" Nothing+-- > Person <$> areq textField "Name" Nothing+-- > <*> areq textField "Surname" Nothing -- -- Then just change it to: ----- > Person <$> areq textField "Name" Nothing--- > <*> areq textField "Surname" Nothing--- > <* bootstrapSubmit ("Register" :: BootstrapSubmit Text)+-- > Person <$> areq textField "Name" Nothing+-- > <*> areq textField "Surname" Nothing+-- > <* bootstrapSubmit ("Register" :: BootstrapSubmit Text) -- -- (Note that '<*' is not a typo.) --@@ -166,24 +165,26 @@ -- manually as well in order to have more control over its -- layout. bootstrapSubmit :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>- BootstrapSubmit msg -> AForm m ()+ BootstrapSubmit msg -> AForm m () bootstrapSubmit = formToAForm . fmap (second return) . mbootstrapSubmit -- | Same as 'bootstrapSubmit' but for monadic forms. This isn't -- as useful since you're not going to use 'renderBootstrap4' -- anyway. mbootstrapSubmit :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>- BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)+ BootstrapSubmit msg -> MForm m (FormResult (), FieldView site) mbootstrapSubmit (BootstrapSubmit msg classes attrs) =- let res = FormSuccess ()- widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|]- fv = FieldView { fvLabel = ""- , fvTooltip = Nothing- , fvId = bootstrapSubmitId- , fvInput = widget- , fvErrors = Nothing- , fvRequired = False }- in return (res, fv)+ let res = FormSuccess ()+ widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|]+ fv = FieldView+ { fvLabel = ""+ , fvTooltip = Nothing+ , fvId = bootstrapSubmitId+ , fvInput = widget+ , fvErrors = Nothing+ , fvRequired = False+ }+ in return (res, fv) -- | A royal hack. Magic id used to identify whether a field -- should have no label. A valid HTML4 id which is probably not
yesod-form-bootstrap4.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e6da7e86970590a4b47e6c1d2d466868a14ed599969f7b55c017f64fd5dad8b6+-- hash: 394ee8edcbb802cb7628af29db1bb090b6fc8682b129dd772eaa73a32e5e4ee5 name: yesod-form-bootstrap4-version: 1.0.2+version: 2.0.0 synopsis: renderBootstrap4 category: Web homepage: https://github.com/ncaq/yesod-form-bootstrap4#readme