From 0fa08a7355f90e1dd4c31ce667b398e398b0df8f Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 9 May 2011 22:07:56 +0300 Subject: [PATCH] ToForm and ToField --- Yesod/Form.hs | 4 +- Yesod/Form/Class.hs | 89 +++++++++++++++++++++++--------------------- Yesod/Form/Fields.hs | 8 ++-- 3 files changed, 53 insertions(+), 48 deletions(-) diff --git a/Yesod/Form.hs b/Yesod/Form.hs index 0eab5bcb..7080ce67 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -10,10 +10,10 @@ module Yesod.Form ( module Yesod.Form.Types , module Yesod.Form.Functions , module Yesod.Form.Fields - -- FIXME , module Yesod.Form.Class + , module Yesod.Form.Class ) where import Yesod.Form.Types import Yesod.Form.Functions import Yesod.Form.Fields --- FIXME import Yesod.Form.Class +import Yesod.Form.Class diff --git a/Yesod/Form/Class.hs b/Yesod/Form/Class.hs index 9e0457fb..2eaa137e 100644 --- a/Yesod/Form/Class.hs +++ b/Yesod/Form/Class.hs @@ -2,24 +2,25 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} module Yesod.Form.Class -() where -{- FIXME Maybe we should remove this module entirely... ( ToForm (..) - , ToFormField (..) + , ToField (..) ) where import Text.Hamlet +import Yesod.Widget (GGWidget) import Yesod.Form.Fields -import Yesod.Form.Core -import Yesod.Form.Profiles (Textarea) +import Yesod.Form.Types +import Yesod.Form.Functions (areq, aopt) import Data.Int (Int64) import Data.Time (Day, TimeOfDay) import Data.Text (Text) +import Yesod.Handler (GGHandler) -class ToForm a y where - toForm :: Formlet sub y a -class ToFormField a y where - toFormField :: FormFieldSettings -> FormletField sub y a +class ToForm a master monad where + toForm :: AForm ([FieldView (GGWidget master monad ())] -> [FieldView (GGWidget master monad ())]) monad a + +class ToField a master monad where + toField :: FieldSettings -> Maybe a -> AForm ([FieldView (GGWidget master monad ())] -> [FieldView (GGWidget master monad ())]) monad a {- FIXME instance ToFormField String y where @@ -28,45 +29,47 @@ instance ToFormField (Maybe String) y where toFormField = maybeStringField -} -instance ToFormField Text y where - toFormField = stringField -instance ToFormField (Maybe Text) y where - toFormField = maybeStringField +instance Monad m => ToField Text master (GGHandler sub master m) where + toField = areq textField +instance Monad m => ToField (Maybe Text) master (GGHandler sub master m) where + toField = aopt textField -instance ToFormField Int y where - toFormField = intField -instance ToFormField (Maybe Int) y where - toFormField = maybeIntField -instance ToFormField Int64 y where - toFormField = intField -instance ToFormField (Maybe Int64) y where - toFormField = maybeIntField +instance Monad m => ToField Int master (GGHandler sub master m) where + toField = areq intField +instance Monad m => ToField (Maybe Int) master (GGHandler sub master m) where + toField = aopt intField -instance ToFormField Double y where - toFormField = doubleField -instance ToFormField (Maybe Double) y where - toFormField = maybeDoubleField +instance Monad m => ToField Int64 master (GGHandler sub master m) where + toField = areq intField +instance Monad m => ToField (Maybe Int64) master (GGHandler sub master m) where + toField = aopt intField -instance ToFormField Day y where - toFormField = dayField -instance ToFormField (Maybe Day) y where - toFormField = maybeDayField +instance Monad m => ToField Double master (GGHandler sub master m) where + toField = areq doubleField +instance Monad m => ToField (Maybe Double) master (GGHandler sub master m) where + toField = aopt doubleField -instance ToFormField TimeOfDay y where - toFormField = timeField -instance ToFormField (Maybe TimeOfDay) y where - toFormField = maybeTimeField +instance Monad m => ToField Day master (GGHandler sub master m) where + toField = areq dayField +instance Monad m => ToField (Maybe Day) master (GGHandler sub master m) where + toField = aopt dayField +instance Monad m => ToField TimeOfDay master (GGHandler sub master m) where + toField = areq timeField +instance Monad m => ToField (Maybe TimeOfDay) master (GGHandler sub master m) where + toField = aopt timeField + +instance Monad m => ToField Html master (GGHandler sub master m) where + toField = areq htmlField +instance Monad m => ToField (Maybe Html) master (GGHandler sub master m) where + toField = aopt htmlField + +instance Monad m => ToField Textarea master (GGHandler sub master m) where + toField = areq textareaField +instance Monad m => ToField (Maybe Textarea) master (GGHandler sub master m) where + toField = aopt textareaField + +{- FIXME instance ToFormField Bool y where toFormField = boolField - -instance ToFormField Html y where - toFormField = htmlField -instance ToFormField (Maybe Html) y where - toFormField = maybeHtmlField - -instance ToFormField Textarea y where - toFormField = textareaField -instance ToFormField (Maybe Textarea) y where - toFormField = maybeTextareaField -} diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs index fc945240..3a61091c 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -43,10 +43,12 @@ import qualified Data.ByteString.Lazy as L import Data.Text (Text, unpack, pack) #if __GLASGOW_HASKELL__ >= 700 +#define WHAMLET whamlet #define HAMLET hamlet #define CASSIUS cassius #define JULIUS julius #else +#define WHAMLET $whamlet #define HAMLET $hamlet #define CASSIUS $cassius #define JULIUS $julius @@ -154,9 +156,9 @@ textField :: Monad monad => Field (GGWidget master monad ()) Text textField = Field { fieldParse = Right , fieldRender = id - , fieldView = \theId name val isReq -> addHamlet - [HAMLET|\ - + , fieldView = \theId name val isReq -> + [WHAMLET| + |] }