digestive-bootstrap (empty) → 0.1.0.0

raw patch · 3 files changed

+131/−0 lines, 3 filesdep +basedep +blaze-bootstrapdep +blaze-htmlsetup-changed

Dependencies added: base, blaze-bootstrap, blaze-html, digestive-functors, digestive-functors-blaze, http-types, text

Files

• Setup.hs +2/−0
• digestive-bootstrap.cabal +24/−0
• src/Text/Digestive/Bootstrap.hs +105/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,24 @@+name:                digestive-bootstrap+version:             0.1.0.0+synopsis:            Speed up form designing using digestive functors and bootstrap+description:         Generate bootstrap forms out of digestive views+license:             MIT+author:              Alexander Thiemann <mail@agrafix.net>+maintainer:          mail@agrafix.net+copyright:           (c) 2014 Alexander Thiemann+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Text.Digestive.Bootstrap+  build-depends:       base ==4.*,+                       digestive-functors >=0.7 && <0.8,+                       digestive-functors-blaze >=0.6 && <0.7,+                       blaze-html >=0.7 && <0.8,+                       blaze-bootstrap >=0.1 && <0.2,+                       http-types  >=0.8 && <0.9,+                       text+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options: -Wall

@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.Digestive.Bootstrap+    ( FormMeta (..), FormElement (..), FormElementCfg (..)+    , StdMethod (..)+    , renderForm+    )+where++import Data.Maybe+import Data.Monoid+import Network.HTTP.Types.Method+import Text.Blaze.Bootstrap+import Text.Blaze.Html5+import Text.Blaze.Html5.Attributes+import Text.Digestive+import Text.Digestive.Blaze.Html5+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A++type NumberUnit = T.Text++data FormElementCfg+   = InputText+   | InputNumber (Maybe NumberUnit)+   | InputPassword+   | InputTextArea (Maybe Int) (Maybe Int)+   | InputHidden+   | InputSelect+   | InputRadio Bool+   | InputCheckbox+   | InputFile+   | InputDate++data FormElement+   = FormElement+   { fe_name :: T.Text+   , fe_label :: Maybe T.Text+   , fe_cfg :: FormElementCfg+   }++data FormMeta+   = FormMeta+   { fm_method :: StdMethod+   , fm_target :: T.Text+   , fm_elements :: [FormElement]+   , fm_submitText :: T.Text+   }++renderForm :: FormMeta -> View Html -> Html+renderForm formMeta formView =+    H.form ! role "form" ! method formMethod ! action formAction $+     do mapM_ (renderElement formView) (fm_elements formMeta)+        formSubmit (toHtml $ fm_submitText formMeta)+    where+      formMethod = toValue (T.decodeUtf8 $ renderStdMethod (fm_method formMeta))+      formAction = toValue $ fm_target formMeta++renderElement :: View Html -> FormElement -> Html+renderElement formView formElement =+    formGroup $+    do case errors (fe_name formElement) formView of+         [] -> mempty+         errorMsgs ->+             alertBox BootAlertDanger $ H.ul $ mapM_ (H.li . toHtml) errorMsgs+       case fe_label formElement of+         Just lbl ->+             H.label ! for (toValue $ fe_name formElement) $ toHtml lbl+         Nothing ->+             mempty+       let ct = buildFun (fe_name formElement) formView ! class_ "form-control" ! placeholder (toValue $ fromMaybe "" $ fe_label formElement)+       if hasAddon+       then H.div ! class_ "input-group" $ (ct >>= \_ -> groupAddonAfter)+       else ct+    where+      (hasAddon, groupAddonAfter) =+          case fe_cfg formElement of+            InputNumber (Just numberUnit) ->+                (True, H.span ! class_ "input-group-addon" $ toHtml numberUnit)+            _ ->+                (False, mempty)+      buildFun =+          case fe_cfg formElement of+            InputText -> inputText+            InputPassword -> inputPassword+            InputTextArea taRows taCols -> inputTextArea taRows taCols+            InputHidden -> inputHidden+            InputSelect -> inputSelect+            InputRadio rBr -> inputRadio rBr+            InputCheckbox -> inputCheckbox+            InputFile -> inputFile+            InputNumber _ -> inputX "number"+            InputDate -> inputX "date"++inputX :: T.Text -> T.Text -> View v -> Html+inputX x ref view =+    input+    ! type_ (toValue x)+    ! A.id    (H.toValue ref')+    ! name  (H.toValue ref')+    ! value (H.toValue $ fieldInputText ref view)+    !? (x == "number", A.step "any")+  where+    ref' = absoluteRef ref view