Permalink
Browse files

Switch to using named-formlet library.

  • Loading branch information...
1 parent 9c210c4 commit d293bb3c5cb8ec0c62abbb6c26974c5d4d4278d0 @chrisdone committed Jun 14, 2011
Showing with 2 additions and 185 deletions.
  1. +1 −0 amelie.cabal
  2. +1 −0 lib/named-formlet
  3. +0 −185 src/Text/Formlet.hs
View
@@ -42,3 +42,4 @@ Executable amelie
,download-curl >= 0.1
,Diff >= 0.1
,css >= 0.1
+ ,named-formlet >= 0.1
View
View
@@ -1,185 +0,0 @@
-{-# 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.List (find)
-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 Safe (readMay)
-import Snap.Types
-import Text.Blaze.Html5 as H hiding (map)
-import qualified Text.Blaze.Html5.Attributes as A
-
--- | A simple formlet data type, fails on first error.
-data Formlet a = Formlet {
- formletValue :: Params -> Either [Text] a
- , formletName :: Maybe Text
- , formletHtml :: Params -> Html
-}
-
--- | Fails on first error, concatenates HTML output.
-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"
-
--- | 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)

4 comments on commit d293bb3

@mausch
mausch commented on d293bb3 Jun 17, 2011

Hi, is there any public repository for named-formlet? Also, why another formlet library?

@chrisdone
Owner

Is there a formlet library that lets you name the inputs?

@mausch
mausch commented on d293bb3 Jun 17, 2011

Ahh, that was the reason... sorry, didn't get the 'named' part of the name, thanks.
My formlet library allows naming inputs... but it's in F# ;-)

Cheers

@chrisdone
Owner

:-)

Please sign in to comment.