packages feed

named-formlet (empty) → 0.1

raw patch · 5 files changed

+254/−0 lines, 5 filesdep +basedep +blaze-htmldep +bytestringsetup-changed

Dependencies added: base, blaze-html, bytestring, containers, mtl, text, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Chris Done++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Chris Done nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ named-formlet.cabal view
@@ -0,0 +1,23 @@+Name:                named-formlet+Version:             0.1+Synopsis:            A simple formlet library with named formlets.+Description:         A simple formlet library with named formlets (e.g. username, email, password, etc.).+License:             BSD3+License-file:        LICENSE+Author:              Chris Done+Maintainer:          chrisdone@gmail.com+Copyright:           2010 Chris Done+Category:            Web+Build-type:          Simple+Cabal-version:       >=1.2+Library+  Exposed-modules:   Text.Formlet+  Other-modules:     Data.Monoid.Operator+  Build-depends:     base >= 4 && < 5+                    ,text >= 0.11+                    ,blaze-html >= 0.4   && < 0.5+                    ,containers >= 0.3+                    ,bytestring >= 0.8+                    ,mtl >= 2.0+                    ,transformers >= 0.2+  Hs-source-dirs:    src
+ src/Data/Monoid/Operator.hs view
@@ -0,0 +1,8 @@+-- | Convenient operator.++module Data.Monoid.Operator where++import Data.Monoid++(++) :: (Monoid a) => a -> a -> a+(++) = mappend
+ src/Text/Formlet.hs view
@@ -0,0 +1,191 @@+{-# OPTIONS -Wall #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS -fno-warn-name-shadowing -fno-warn-orphans #-}++-- | Mini formlets library.++module Text.Formlet+       (Formlet(..)+       ,formlet+       ,req+       ,opt+       ,wrap+       ,integer+       ,textInput+       ,dropInput+       ,areaInput+       ,submitInput+       ,parse+       ,options+       ,findOption) where++import           Control.Applicative+import           Control.Monad.Error+import           Control.Monad.Reader+import           Control.Monad.Trans.Error   (ErrorList(..))+import           Control.Monad.Writer+import           Data.ByteString             (ByteString)+import           Data.List                   (find)+import           Data.Map                    (Map)+import qualified Data.Map                    as M+import           Data.Maybe+import           Data.Monoid.Operator+import           Data.Text                   (Text)+import qualified Data.Text                   as T+import           Data.Text.Encoding+import           Prelude                     hiding ((++))+import           Text.Blaze.Html5            as H hiding (map)+import qualified Text.Blaze.Html5.Attributes as A++type Params = Map ByteString [ByteString]++-- | A simple formlet data type, collects errors.+data Formlet a = Formlet {+   formletValue  :: Params -> Either [Text] a+ , formletName   :: Maybe Text+ , formletHtml   :: Params -> Html+}++instance Applicative Formlet where+  pure a = Formlet { formletValue = const (return a)+                   , formletHtml  = const mempty+                   , formletName  = Nothing+                   }+  Formlet f n fhtml <*> Formlet v n' vhtml =+    Formlet { formletValue = \params ->+                case v params of+                  Right x -> f params <*> Right x+                  Left e  -> case f params <*> Left [] of+                               Right x -> return x+                               Left e' -> Left $ e' ++ e+            , formletHtml  = \params -> fhtml params ++ vhtml params+            , formletName  = case (n,n') of+                               (Just{},Just{}) -> Nothing+                               _               -> n `mplus` n'+            }++-- | Normal instance.+instance Functor Formlet where+  fmap f formlet@Formlet{..} = formlet { formletValue = value }+    where value = \params ->+                    case formletValue params of+                      Left e -> Left e+                      Right a -> Right (f a)++-- | The error message for the formlets is a text value.+instance Error Text where noMsg = ""; strMsg = T.pack+instance ErrorList Text where listMsg = return . T.pack++-- | Make a simple formlet.+formlet :: Text -> (Maybe Text -> Html) -> Formlet Text+formlet name html = +  Formlet { formletValue = \inputs ->+              case (M.lookup (encodeUtf8 name) inputs) of+                Just (value:_) -> return $ decodeUtf8 value+                _ -> throwError $ ["missing input: " ++ name]+          , formletHtml = \inputs ->+              case M.lookup (encodeUtf8 name) inputs of+                Just (value:_) -> html (Just $ decodeUtf8 value)+                _ -> html Nothing+          , formletName = Just name+          }++-- | Make an input required (non-empty text).+req :: Formlet Text -> Formlet Text+req formlet@Formlet{..} =+  formlet { formletValue = \inputs ->+              case formletValue inputs of+                Right v | T.null v ->+                  throwError $ ["required input" ++ maybe "" (": "++) formletName]+                meh -> meh+          }++-- | Make an input optional (empty text is nothing).+opt :: Formlet Text -> Formlet (Maybe Text)+opt formlet@Formlet{..} =+  formlet { formletValue = \inputs ->+              case formletValue inputs of+                Right v | T.null v -> Right Nothing+                meh -> Just <$> meh+          }++++-- | Parse a form value.+parse :: (a -> Either Text b) -> Formlet a -> Formlet b+parse parser formlet@Formlet{..} =+  formlet { formletValue = \inputs ->+              case formletValue inputs of+                Left e -> Left e+                Right x -> case parser x of+                             Right y -> Right y+                             Left e -> Left [e ++ maybe "" (": "++) formletName]+          }++-- | Integer parser.+integer :: Text -> Either Text Integer+integer (readMay . T.unpack -> Just v) = Right v+integer _ = Left "expected integer"++readMay :: Read a => String -> Maybe a+readMay x = case reads x of+              [(x,"")] -> return x+              _        -> Nothing++-- | Wrap/transform formlet's HTML.+wrap :: (Html -> Html) -> Formlet Text -> Formlet Text+wrap f formlet@Formlet{..} = formlet { formletHtml = f . formletHtml }++-- | Make a text input formlet with a label.+textInput :: Text -> Text -> Maybe Text -> Formlet Text+textInput name caption def =+  formlet name $ \value -> do+    p $ H.label $ do+      H.span $ toHtml $ caption ++ ": "+      input ! A.name (toValue name)+            ! A.value (toValue $ fromMaybe "" (value <|> def))+            ! A.class_ "text"++-- | Make a textarea input with a label.+areaInput :: Text -> Text -> Maybe Text -> Formlet Text+areaInput name caption def =+  formlet name $ \value -> do+    p $ H.label $ do+      H.span $ toHtml $ caption ++ ": "+      textarea ! A.name (toValue name) $+        toHtml $ fromMaybe "" (value <|> def)++-- | Make a drop down input with a label.+dropInput :: [(Text,Text)] -> Text -> Text -> Text -> Formlet Text+dropInput values name caption def =+  formlet name $ \value -> do+    p $ H.label $ do+      H.span $ toHtml $ caption ++ ": "+      select ! A.name (toValue name) $+        forM_ values $ \(key,title) -> do+          let nonSelected = all ((/=value) . Just . fst) values+              defaulting = nonSelected && def == key+              selected+                | Just key == value = (! A.selected "selected")+                | defaulting        = (! A.selected "selected")+                | otherwise         = id+          selected $ option ! A.value (toValue key) $ toHtml title++-- | Make a submit (captioned) button.+submitInput :: Text -> Text -> Html+submitInput name caption = p $ do+  p $ H.input ! A.type_ "submit"+              ! A.name (toValue name)+              ! A.value (toValue caption)++-- | Make a list of options for use with the option formlet.+options :: (o -> Text) -> (o -> Text) -> [o] -> [(Text,Text)]+options slug caption os = ("","") : map (\o -> (slug o,caption o)) os++-- | Lookup a real internal id from a slug.+findOption :: (o -> Bool) -> [o] -> (o -> internalid) -> Either Text internalid+findOption pred os field =+  case find pred os of+    Nothing -> Left ""+    Just x -> Right (field x)