Minor rearranging and renaming

Yesod/Form.hs

@@ -8,7 +8,13 @@ module Yesod.Form
     ( -- * Data types
       GForm
     , FormResult (..)
-    , Enctype (..)
+    , Enctype
+      -- * Type synonyms
+    , Form
+    , Formlet
+    , FormField
+    , FormletField
+    , FormInput
       -- * Unwrapping functions
     , runFormGet
     , runFormPost

Yesod/Form/Class.hs

@@ -8,6 +8,7 @@ module Yesod.Form.Class
 
 import Text.Hamlet
 import Yesod.Form.Fields
+import Yesod.Form.Core
 import Data.Int (Int64)
 import Data.Time (Day, TimeOfDay)
 

Yesod/Form/Core.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Yesod.Form.Core
     ( FormResult (..)
     , GForm (..)
@@ -8,14 +9,32 @@ module Yesod.Form.Core
     , FileEnv
     , Enctype (..)
     , Ints (..)
+    , requiredFieldHelper
+    , optionalFieldHelper
+    , fieldsToInput
+    , mapFormXml
+      -- * Data types
+    , FieldInfo (..)
+    , FormFieldSettings (..)
+    , FieldProfile (..)
+      -- * Type synonyms
+    , Form
+    , Formlet
+    , FormField
+    , FormletField
+    , FormInput
     ) where
 
 import Control.Monad.Trans.State
 import Yesod.Handler
+import Yesod.Widget
 import Data.Monoid (Monoid (..))
 import Control.Applicative
 import Yesod.Request
 import Control.Monad (liftM)
+import Text.Hamlet
+import Data.String
+import Control.Monad (join)
 
 -- | A form can produce three different results: there was no data available,
 -- the data was invalid, or there was a successful parse.
@@ -44,9 +63,10 @@ instance Monoid m => Monoid (FormResult m) where
 -- | The encoding type required by a form. The 'Show' instance produces values
 -- that can be inserted directly into HTML.
 data Enctype = UrlEncoded | Multipart
-instance Show Enctype where
+    deriving (Eq, Enum, Bounded)
-    show UrlEncoded = "application/x-www-form-urlencoded"
+instance ToHtml Enctype where
-    show Multipart = "multipart/form-data"
+    toHtml UrlEncoded = unsafeByteString "application/x-www-form-urlencoded"
+    toHtml Multipart = unsafeByteString "multipart/form-data"
 instance Monoid Enctype where
     mempty = UrlEncoded
     mappend UrlEncoded UrlEncoded = UrlEncoded
@@ -101,3 +121,112 @@ instance Monoid xml => Applicative (GForm sub url xml) where
         (f1, f2, f3) <- f env fe
         (g1, g2, g3) <- g env fe
         return (f1 <*> g1, f2 `mappend` g2, f3 `mappend` g3)
+
+-- | Create a required field (ie, one that cannot be blank) from a
+-- 'FieldProfile'.ngs
+requiredFieldHelper :: FieldProfile sub y a -> FormFieldSettings
+                    -> Maybe a -> FormField sub y a
+requiredFieldHelper (FieldProfile parse render mkXml w) ffs orig =
+  GForm $ \env _ -> do
+    let (FormFieldSettings label tooltip theId' name') = ffs
+    name <- maybe newFormIdent return name'
+    theId <- maybe newFormIdent return theId'
+    let (res, val) =
+            if null env
+                then (FormMissing, maybe "" render orig)
+                else case lookup name env of
+                        Nothing -> (FormMissing, "")
+                        Just "" -> (FormFailure ["Value is required"], "")
+                        Just x ->
+                            case parse x of
+                                Left e -> (FormFailure [e], x)
+                                Right y -> (FormSuccess y, x)
+    let fi = FieldInfo
+            { fiLabel = label
+            , fiTooltip = tooltip
+            , fiIdent = theId
+            , fiName = name
+            , fiInput = w theId >> addBody (mkXml theId name val True)
+            , fiErrors = case res of
+                            FormFailure [x] -> Just $ string x
+                            _ -> Nothing
+            }
+    return (res, [fi], UrlEncoded)
+
+-- | Create an optional field (ie, one that can be blank) from a
+-- 'FieldProfile'.
+optionalFieldHelper :: FieldProfile sub y a -> FormFieldSettings
+                    -> FormletField sub y (Maybe a)
+optionalFieldHelper (FieldProfile parse render mkXml w) ffs orig' =
+  GForm $ \env _ -> do
+    let (FormFieldSettings label tooltip theId' name') = ffs
+    let orig = join orig'
+    name <- maybe newFormIdent return name'
+    theId <- maybe newFormIdent return theId'
+    let (res, val) =
+            if null env
+                then (FormSuccess Nothing, maybe "" render orig)
+                else case lookup name env of
+                        Nothing -> (FormSuccess Nothing, "")
+                        Just "" -> (FormSuccess Nothing, "")
+                        Just x ->
+                            case parse x of
+                                Left e -> (FormFailure [e], x)
+                                Right y -> (FormSuccess $ Just y, x)
+    let fi = FieldInfo
+            { fiLabel = label
+            , fiTooltip = tooltip
+            , fiIdent = theId
+            , fiName = name
+            , fiInput = w theId >> addBody (mkXml theId name val False)
+            , fiErrors = case res of
+                            FormFailure [x] -> Just $ string x
+                            _ -> Nothing
+            }
+    return (res, [fi], UrlEncoded)
+
+fieldsToInput :: [FieldInfo sub y] -> [GWidget sub y ()]
+fieldsToInput = map fiInput
+
+-- | Convert the XML in a 'GForm'.
+mapFormXml :: (xml1 -> xml2) -> GForm s y xml1 a -> GForm s y xml2 a
+mapFormXml f (GForm g) = GForm $ \e fe -> do
+    (res, xml, enc) <- g e fe
+    return (res, f xml, enc)
+
+-- | Using this as the intermediate XML representation for fields allows us to
+-- write generic field functions and then different functions for producing
+-- actual HTML. See, for example, 'fieldsToTable' and 'fieldsToPlain'.
+data FieldInfo sub y = FieldInfo
+    { fiLabel :: Html
+    , fiTooltip :: Html
+    , fiIdent :: String
+    , fiName :: String
+    , fiInput :: GWidget sub y ()
+    , fiErrors :: Maybe Html
+    }
+
+data FormFieldSettings = FormFieldSettings
+    { ffsLabel :: Html
+    , ffsTooltip :: Html
+    , ffsId :: Maybe String
+    , ffsName :: Maybe String
+    }
+instance IsString FormFieldSettings where
+    fromString s = FormFieldSettings (string s) mempty Nothing Nothing
+
+-- | A generic definition of a form field that can be used for generating both
+-- required and optional fields. See 'requiredFieldHelper and
+-- 'optionalFieldHelper'.
+data FieldProfile sub y a = FieldProfile
+    { fpParse :: String -> Either String a
+    , fpRender :: a -> String
+    , fpHamlet :: String -> String -> String -> Bool -> Hamlet (Route y)
+    , fpWidget :: String -> GWidget sub y ()
+    }
+
+type Form sub y = GForm sub y (GWidget sub y ())
+type Formlet sub y a = Maybe a -> Form sub y a
+type FormField sub y = GForm sub y [FieldInfo sub y]
+type FormletField sub y a = Maybe a -> FormField sub y a
+type FormInput sub y = GForm sub y [GWidget sub y ()]

Yesod/Form/Fields.hs

@@ -1,17 +1,8 @@
 {-# LANGUAGE QuasiQuotes #-}
 module Yesod.Form.Fields
-    ( -- * Type synonyms
+    ( -- * Fields
-      Form
-    , Formlet
-    , FormField
-    , FormletField
-    , FormInput
-      -- * Data types
-    , FieldInfo (..)
-    , FormFieldSettings (..)
-      -- * Fields
       -- ** Required
-    , stringField
+      stringField
     , textareaField
     , hiddenField
     , intField
@@ -46,11 +37,6 @@ module Yesod.Form.Fields
       -- ** Optional
     , maybeStringInput
     , maybeDayInput
-      -- * Utils
-    , requiredFieldHelper
-    , optionalFieldHelper
-    , fieldsToInput
-    , mapFormXml
     ) where
 
 import Yesod.Form.Core
@@ -61,34 +47,6 @@ import Text.Hamlet
 import Data.Monoid
 import Control.Monad (join)
 import Data.Maybe (fromMaybe)
-import Data.String
-
-data FormFieldSettings = FormFieldSettings
-    { ffsLabel :: Html
-    , ffsTooltip :: Html
-    , ffsId :: Maybe String
-    , ffsName :: Maybe String
-    }
-instance IsString FormFieldSettings where
-    fromString s = FormFieldSettings (string s) mempty Nothing Nothing
-
--- | Using this as the intermediate XML representation for fields allows us to
--- write generic field functions and then different functions for producing
--- actual HTML. See, for example, 'fieldsToTable' and 'fieldsToPlain'.
-data FieldInfo sub y = FieldInfo
-    { fiLabel :: Html
-    , fiTooltip :: Html
-    , fiIdent :: String
-    , fiName :: String
-    , fiInput :: GWidget sub y ()
-    , fiErrors :: Maybe Html
-    }
-
-type Form sub y = GForm sub y (GWidget sub y ())
-type Formlet sub y a = Maybe a -> Form sub y a
-type FormField sub y = GForm sub y [FieldInfo sub y]
-type FormletField sub y a = Maybe a -> FormField sub y a
-type FormInput sub y = GForm sub y [GWidget sub y ()]
 
 stringField :: FormFieldSettings -> FormletField sub y String
 stringField = requiredFieldHelper stringFieldProfile
@@ -269,78 +227,6 @@ maybeDayInput n =
 nameSettings :: String -> FormFieldSettings
 nameSettings n = FormFieldSettings mempty mempty (Just n) (Just n)
 
--- | Create a required field (ie, one that cannot be blank) from a
--- 'FieldProfile'.ngs
-requiredFieldHelper :: FieldProfile sub y a -> FormFieldSettings
-                    -> Maybe a -> FormField sub y a
-requiredFieldHelper (FieldProfile parse render mkXml w) ffs orig =
-  GForm $ \env _ -> do
-    let (FormFieldSettings label tooltip theId' name') = ffs
-    name <- maybe newFormIdent return name'
-    theId <- maybe newFormIdent return theId'
-    let (res, val) =
-            if null env
-                then (FormMissing, maybe "" render orig)
-                else case lookup name env of
-                        Nothing -> (FormMissing, "")
-                        Just "" -> (FormFailure ["Value is required"], "")
-                        Just x ->
-                            case parse x of
-                                Left e -> (FormFailure [e], x)
-                                Right y -> (FormSuccess y, x)
-    let fi = FieldInfo
-            { fiLabel = label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiName = name
-            , fiInput = w theId >> addBody (mkXml theId name val True)
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ string x
-                            _ -> Nothing
-            }
-    return (res, [fi], UrlEncoded)
-
--- | Create an optional field (ie, one that can be blank) from a
--- 'FieldProfile'.
-optionalFieldHelper :: FieldProfile sub y a -> FormFieldSettings
-                    -> FormletField sub y (Maybe a)
-optionalFieldHelper (FieldProfile parse render mkXml w) ffs orig' =
-  GForm $ \env _ -> do
-    let (FormFieldSettings label tooltip theId' name') = ffs
-    let orig = join orig'
-    name <- maybe newFormIdent return name'
-    theId <- maybe newFormIdent return theId'
-    let (res, val) =
-            if null env
-                then (FormSuccess Nothing, maybe "" render orig)
-                else case lookup name env of
-                        Nothing -> (FormSuccess Nothing, "")
-                        Just "" -> (FormSuccess Nothing, "")
-                        Just x ->
-                            case parse x of
-                                Left e -> (FormFailure [e], x)
-                                Right y -> (FormSuccess $ Just y, x)
-    let fi = FieldInfo
-            { fiLabel = label
-            , fiTooltip = tooltip
-            , fiIdent = theId
-            , fiName = name
-            , fiInput = w theId >> addBody (mkXml theId name val False)
-            , fiErrors = case res of
-                            FormFailure [x] -> Just $ string x
-                            _ -> Nothing
-            }
-    return (res, [fi], UrlEncoded)
-
-fieldsToInput :: [FieldInfo sub y] -> [GWidget sub y ()]
-fieldsToInput = map fiInput
-
--- | Convert the XML in a 'GForm'.
-mapFormXml :: (xml1 -> xml2) -> GForm s y xml1 a -> GForm s y xml2 a
-mapFormXml f (GForm g) = GForm $ \e fe -> do
-    (res, xml, enc) <- g e fe
-    return (res, f xml, enc)
-
 urlField :: FormFieldSettings -> FormletField sub y String
 urlField = requiredFieldHelper urlFieldProfile
 

Yesod/Form/Jquery.hs

@@ -11,7 +11,7 @@ module Yesod.Form.Jquery
     ) where
 
 import Yesod.Handler
-import Yesod.Form
+import Yesod.Form.Core
 import Yesod.Form.Profiles
 import Yesod.Widget
 import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,

Yesod/Form/Nic.hs

@@ -6,7 +6,7 @@ module Yesod.Form.Nic
     ) where
 
 import Yesod.Handler
-import Yesod.Form
+import Yesod.Form.Core
 import Yesod.Form.Profiles
 import Yesod.Hamlet
 import Yesod.Widget

Yesod/Form/Profiles.hs

@@ -15,24 +15,13 @@ module Yesod.Form.Profiles
     , parseTime
     ) where
 
-import Yesod.Widget
+import Yesod.Form.Core
-import Yesod.Handler
 import Text.Hamlet
 import Data.Time (Day, TimeOfDay(..))
 import qualified Data.ByteString.Lazy.UTF8 as U
 import qualified Text.Email.Validate as Email
 import Network.URI (parseURI)
 
--- | A generic definition of a form field that can be used for generating both
--- required and optional fields. See 'requiredFieldHelper and
--- 'optionalFieldHelper'.
-data FieldProfile sub y a = FieldProfile
-    { fpParse :: String -> Either String a
-    , fpRender :: a -> String
-    , fpHamlet :: String -> String -> String -> Bool -> Hamlet (Route y)
-    , fpWidget :: String -> GWidget sub y ()
-    }
-
 intFieldProfile :: Integral i => FieldProfile sub y i
 intFieldProfile = FieldProfile
     { fpParse = maybe (Left "Invalid integer") Right . readMayI

Yesod/Helpers/Crud.hs

@@ -160,7 +160,7 @@ crudHelper title me isPost = do
 %p
     %a!href=@toMaster.CrudListR@ Return to list
 %h1 $title$
-%form!method=post!enctype=$show.enctype$
+%form!method=post!enctype=$enctype$
     %table
         ^form^
         %tr