yesod-form warnings cleanup

This commit is contained in:
Michael Snoyman 2011-08-05 06:29:17 +03:00
parent f17c1f823d
commit cbbf8dbf6a
6 changed files with 18 additions and 14 deletions

View File

@ -8,14 +8,12 @@ module Yesod.Form.Class
) where ) where
import Text.Hamlet import Text.Hamlet
import Yesod.Widget (GGWidget, GWidget)
import Yesod.Form.Fields import Yesod.Form.Fields
import Yesod.Form.Types import Yesod.Form.Types
import Yesod.Form.Functions (areq, aopt) import Yesod.Form.Functions (areq, aopt)
import Data.Int (Int64) import Data.Int (Int64)
import Data.Time (Day, TimeOfDay) import Data.Time (Day, TimeOfDay)
import Data.Text (Text) import Data.Text (Text)
import Yesod.Handler (GGHandler)
import Yesod.Message (RenderMessage) import Yesod.Message (RenderMessage)
{- {-

View File

@ -31,7 +31,6 @@ module Yesod.Form.Fields
import Yesod.Form.Types import Yesod.Form.Types
import Yesod.Widget import Yesod.Widget
import Yesod.Message (RenderMessage) import Yesod.Message (RenderMessage)
import Yesod.Handler (GGHandler)
import Text.Hamlet import Text.Hamlet
import Text.Blaze (ToHtml (..), preEscapedString, unsafeByteString) import Text.Blaze (ToHtml (..), preEscapedString, unsafeByteString)
import Text.Cassius import Text.Cassius
@ -55,7 +54,6 @@ import qualified Data.ByteString.Lazy as L
import Data.Text (Text, unpack, pack) import Data.Text (Text, unpack, pack)
import qualified Data.Text.Read import qualified Data.Text.Read
import Data.Monoid (mappend) import Data.Monoid (mappend)
import Text.Hamlet (html)
#if __GLASGOW_HASKELL__ >= 700 #if __GLASGOW_HASKELL__ >= 700
#define WHAMLET whamlet #define WHAMLET whamlet

View File

@ -15,7 +15,6 @@ import Control.Applicative (Applicative (..))
import Yesod.Handler (GHandler, GGHandler, invalidArgs, runRequestBody, getRequest, getYesod, liftIOHandler) import Yesod.Handler (GHandler, GGHandler, invalidArgs, runRequestBody, getRequest, getYesod, liftIOHandler)
import Yesod.Request (reqGetParams, languages) import Yesod.Request (reqGetParams, languages)
import Control.Monad (liftM) import Control.Monad (liftM)
import Yesod.Widget (GWidget)
import Yesod.Message (RenderMessage (..)) import Yesod.Message (RenderMessage (..))
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
@ -62,6 +61,7 @@ runInputGet (FormInput f) = do
Left errs -> invalidArgs $ errs [] Left errs -> invalidArgs $ errs []
Right x -> return x Right x -> return x
toMap :: [(Text, a)] -> Map.Map Text [a]
toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y]) toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y])
runInputPost :: FormInput sub master a -> GHandler sub master a runInputPost :: FormInput sub master a -> GHandler sub master a

View File

@ -12,19 +12,18 @@ module Yesod.Form.MassInput
import Yesod.Form.Types import Yesod.Form.Types
import Yesod.Form.Functions import Yesod.Form.Functions
import Yesod.Form.Fields (boolField, FormMessage (MsgDelete)) import Yesod.Form.Fields (boolField, FormMessage (MsgDelete))
import Yesod.Widget (GWidget, GGWidget, whamlet) import Yesod.Widget (GWidget, whamlet)
import Yesod.Message (RenderMessage) import Yesod.Message (RenderMessage)
import Yesod.Handler (newIdent, GHandler, GGHandler) import Yesod.Handler (newIdent, GGHandler)
import Text.Blaze (Html) import Text.Blaze (Html)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Data.Text (pack, Text) import Data.Text (pack)
import Control.Monad.Trans.RWS (get, put, ask) import Control.Monad.Trans.RWS (get, put, ask)
import Data.Maybe (fromMaybe, catMaybes) import Data.Maybe (fromMaybe)
import Data.Text.Read (decimal) import Data.Text.Read (decimal)
import Control.Monad (liftM) import Control.Monad (liftM)
import Data.Either (partitionEithers) import Data.Either (partitionEithers)
import Data.Traversable (sequenceA) import Data.Traversable (sequenceA)
import Control.Monad.IO.Class (MonadIO)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe)
@ -36,6 +35,7 @@ import Data.Maybe (listToMaybe)
#define WHAMLET $whamlet #define WHAMLET $whamlet
#endif #endif
down :: Int -> Form sub master ()
down 0 = return () down 0 = return ()
down i | i < 0 = error "called down with a negative number" down i | i < 0 = error "called down with a negative number"
down i = do down i = do
@ -43,6 +43,7 @@ down i = do
put $ IntCons 0 is put $ IntCons 0 is
down $ i - 1 down $ i - 1
up :: Int -> Form sub master ()
up 0 = return () up 0 = return ()
up i | i < 0 = error "called down with a negative number" up i | i < 0 = error "called down with a negative number"
up i = do up i = do

View File

@ -78,13 +78,21 @@ getMassR = do
|] |]
myValidForm = fixType $ runFormGet $ renderTable $ pure (,,) myValidForm = fixType $ runFormGet $ renderTable $ pure (,,)
<*> areq (check (\x -> if T.length x < 3 then Left ("Need at least 3 letters" :: Text) else Right x) textField) "Name" Nothing <*> areq (check (\x ->
<*> areq (checkBool (>= 18) ("Must be 18 or older" :: Text) intField) "Age" Nothing if T.length x < 3
then Left ("Need at least 3 letters" :: Text)
else Right x
) textField)
"Name" Nothing
<*> areq (checkBool (>= 18) ("Must be 18 or older" :: Text) intField)
"Age" Nothing
<*> areq (checkM inPast dayField) "Anniversary" Nothing <*> areq (checkM inPast dayField) "Anniversary" Nothing
where where
inPast x = do inPast x = do
now <- liftIO $ getCurrentTime now <- liftIO $ getCurrentTime
return $ if utctDay now < x then Left ("Need a date in the past" :: Text) else Right x return $ if utctDay now < x
then Left ("Need a date in the past" :: Text)
else Right x
getValidR = do getValidR = do
((res, form), enctype) <- myValidForm ((res, form), enctype) <- myValidForm

View File

@ -28,7 +28,6 @@ library
, blaze-html >= 0.4 && < 0.5 , blaze-html >= 0.4 && < 0.5
, bytestring >= 0.9 && < 0.10 , bytestring >= 0.9 && < 0.10
, text >= 0.7 && < 1.0 , text >= 0.7 && < 1.0
, web-routes-quasi >= 0.7 && < 0.8
, wai >= 0.4 && < 0.5 , wai >= 0.4 && < 0.5
, containers >= 0.2 && < 0.5 , containers >= 0.2 && < 0.5
exposed-modules: Yesod.Form exposed-modules: Yesod.Form