digestive-foundation-lucid (empty) → 0.0.0.1

raw patch · 3 files changed

+129/−0 lines, 3 filesdep +basedep +digestive-functorsdep +digestive-functors-lucidsetup-changed

Dependencies added: base, digestive-functors, digestive-functors-lucid, http-types, lucid, lucid-foundation, text

Files

• Setup.hs +2/−0
• digestive-foundation-lucid.cabal +24/−0
• src/Text/Digestive/Foundation.hs +103/−0

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

@@ -0,0 +1,24 @@+name:                digestive-foundation-lucid+version:             0.0.0.1+synopsis:            Speed up form designing using digestive functors and foundation+description:         Generate foundation forms out of digestive views+license:             MIT+author:              Athan Clark <athan.clark@gmail.com>+maintainer:          Athan Clark <athan.clark@gmail.com>+copyright:           (c) 2014 Athan Clark+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Text.Digestive.Foundation+  build-depends:       base ==4.*,+                       digestive-functors >=0.7 && <0.8,+                       digestive-functors-lucid >=0.0.0.2,+                       lucid >=2.9,+                       lucid-foundation >=0.0.2.1,+                       http-types  >=0.8 && <0.9,+                       text+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options: -Wall

@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.Digestive.Foundation+    ( FormMeta (..), FormElement (..), FormElementCfg (..)+    , StdMethod (..)+    , renderForm+    )+where++import Data.Maybe+import Data.Monoid+import Network.HTTP.Types.Method+import Lucid.Foundation+import Lucid+import Lucid.Base+import Text.Digestive+import Text.Digestive.Lucid.Html5+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+++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 =+    form_ [ makeAttribute "role" "form"+          , method_ formMethod+          , action_ formAction+          ] $+     do mconcat $ map (renderElement formView) (fm_elements formMeta)+        input_ [type_ "submit", value_ (fm_submitText formMeta)]+    where+      formMethod = T.decodeUtf8 $ renderStdMethod (fm_method formMeta)+      formAction = fm_target formMeta++renderElement :: View (Html ()) -> FormElement -> Html ()+renderElement formView formElement =+    div_ [] $+    do case errors (fe_name formElement) formView of+         [] -> mempty+         errorMsgs ->+             div_ [class_ alert_box_] $ ul_ [] $ mapM_ (li_ []) errorMsgs+       case fe_label formElement of+         Just lbl ->+             label_ [name_ $ fe_name formElement] $ toHtmlRaw lbl+         Nothing ->+             mempty+       let ct = buildFun (fe_name formElement) formView+       if hasAddon+       then div_ [class_ "input-group"] (ct >>= \_ -> groupAddonAfter)+       else ct+    where+      (hasAddon, groupAddonAfter) =+          case fe_cfg formElement of+            InputNumber (Just numberUnit) ->+                (True, span_ [class_ "input-group-addon"] $ toHtmlRaw 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_ x+             , id_ ref'+             , name_ ref'+             , value_ (fieldInputText ref view)+             ] ++ (ifSingleton (x == "number") $ step_ "any")+  where+    ref' = absoluteRef ref view