Remove fpHamlet

This commit is contained in:
Michael Snoyman 2010-08-13 17:16:50 +03:00
parent a609f2d046
commit b5fa539f1b
5 changed files with 28 additions and 41 deletions

View File

@ -13,9 +13,9 @@ import Data.Int (Int64)
import Data.Time (Day, TimeOfDay) import Data.Time (Day, TimeOfDay)
class ToForm a y where class ToForm a y where
toForm :: Maybe a -> Form sub y a toForm :: Formlet sub y a
class ToFormField a y where class ToFormField a y where
toFormField :: FormFieldSettings -> Maybe a -> FormField sub y a toFormField :: FormFieldSettings -> FormletField sub y a
instance ToFormField String y where instance ToFormField String y where
toFormField = stringField toFormField = stringField

View File

@ -126,7 +126,7 @@ instance Monoid xml => Applicative (GForm sub url xml) where
-- 'FieldProfile'.ngs -- 'FieldProfile'.ngs
requiredFieldHelper :: FieldProfile sub y a -> FormFieldSettings requiredFieldHelper :: FieldProfile sub y a -> FormFieldSettings
-> Maybe a -> FormField sub y a -> Maybe a -> FormField sub y a
requiredFieldHelper (FieldProfile parse render mkXml w) ffs orig = requiredFieldHelper (FieldProfile parse render mkWidget) ffs orig =
GForm $ \env _ -> do GForm $ \env _ -> do
let (FormFieldSettings label tooltip theId' name') = ffs let (FormFieldSettings label tooltip theId' name') = ffs
name <- maybe newFormIdent return name' name <- maybe newFormIdent return name'
@ -146,7 +146,7 @@ requiredFieldHelper (FieldProfile parse render mkXml w) ffs orig =
, fiTooltip = tooltip , fiTooltip = tooltip
, fiIdent = theId , fiIdent = theId
, fiName = name , fiName = name
, fiInput = w theId >> addBody (mkXml theId name val True) , fiInput = mkWidget theId name val True
, fiErrors = case res of , fiErrors = case res of
FormFailure [x] -> Just $ string x FormFailure [x] -> Just $ string x
_ -> Nothing _ -> Nothing
@ -157,7 +157,7 @@ requiredFieldHelper (FieldProfile parse render mkXml w) ffs orig =
-- 'FieldProfile'. -- 'FieldProfile'.
optionalFieldHelper :: FieldProfile sub y a -> FormFieldSettings optionalFieldHelper :: FieldProfile sub y a -> FormFieldSettings
-> FormletField sub y (Maybe a) -> FormletField sub y (Maybe a)
optionalFieldHelper (FieldProfile parse render mkXml w) ffs orig' = optionalFieldHelper (FieldProfile parse render mkWidget) ffs orig' =
GForm $ \env _ -> do GForm $ \env _ -> do
let (FormFieldSettings label tooltip theId' name') = ffs let (FormFieldSettings label tooltip theId' name') = ffs
let orig = join orig' let orig = join orig'
@ -178,7 +178,7 @@ optionalFieldHelper (FieldProfile parse render mkXml w) ffs orig' =
, fiTooltip = tooltip , fiTooltip = tooltip
, fiIdent = theId , fiIdent = theId
, fiName = name , fiName = name
, fiInput = w theId >> addBody (mkXml theId name val False) , fiInput = mkWidget theId name val False
, fiErrors = case res of , fiErrors = case res of
FormFailure [x] -> Just $ string x FormFailure [x] -> Just $ string x
_ -> Nothing _ -> Nothing
@ -221,8 +221,8 @@ instance IsString FormFieldSettings where
data FieldProfile sub y a = FieldProfile data FieldProfile sub y a = FieldProfile
{ fpParse :: String -> Either String a { fpParse :: String -> Either String a
, fpRender :: a -> String , fpRender :: a -> String
, fpHamlet :: String -> String -> String -> Bool -> Hamlet (Route y) -- | ID, name, value, required
, fpWidget :: String -> GWidget sub y () , fpWidget :: String -> String -> String -> Bool -> GWidget sub y ()
} }
type Form sub y = GForm sub y (GWidget sub y ()) type Form sub y = GForm sub y (GWidget sub y ())

View File

@ -49,10 +49,10 @@ jqueryDayFieldProfile = FieldProfile
Right Right
. readMay . readMay
, fpRender = show , fpRender = show
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> do
addBody [$hamlet|
%input#$theId$!name=$name$!type=date!:isReq:required!value=$val$ %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
|] |]
, fpWidget = \name -> do
addScript' urlJqueryJs addScript' urlJqueryJs
addScript' urlJqueryUiJs addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss addStylesheet' urlJqueryUiCss
@ -86,10 +86,10 @@ jqueryDayTimeFieldProfile :: YesodJquery y => FieldProfile sub y UTCTime
jqueryDayTimeFieldProfile = FieldProfile jqueryDayTimeFieldProfile = FieldProfile
{ fpParse = parseUTCTime { fpParse = parseUTCTime
, fpRender = jqueryDayTimeUTCTime , fpRender = jqueryDayTimeUTCTime
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> do
addBody [$hamlet|
%input#$theId$!name=$name$!type=date!:isReq:required!value=$val$ %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
|] |]
, fpWidget = \name -> do
addScript' urlJqueryJs addScript' urlJqueryJs
addScript' urlJqueryUiJs addScript' urlJqueryUiJs
addScript' urlJqueryUiDateTimePicker addScript' urlJqueryUiDateTimePicker
@ -122,10 +122,10 @@ jqueryAutocompleteFieldProfile :: YesodJquery y => Route y -> FieldProfile sub y
jqueryAutocompleteFieldProfile src = FieldProfile jqueryAutocompleteFieldProfile src = FieldProfile
{ fpParse = Right { fpParse = Right
, fpRender = id , fpRender = id
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> do
addBody [$hamlet|
%input.autocomplete#$theId$!name=$name$!type=text!:isReq:required!value=$val$ %input.autocomplete#$theId$!name=$name$!type=text!:isReq:required!value=$val$
|] |]
, fpWidget = \name -> do
addScript' urlJqueryJs addScript' urlJqueryJs
addScript' urlJqueryUiJs addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss addStylesheet' urlJqueryUiCss

View File

@ -7,7 +7,6 @@ module Yesod.Form.Nic
import Yesod.Handler import Yesod.Handler
import Yesod.Form.Core import Yesod.Form.Core
import Yesod.Form.Profiles
import Yesod.Hamlet import Yesod.Hamlet
import Yesod.Widget import Yesod.Widget
import qualified Data.ByteString.Lazy.UTF8 as U import qualified Data.ByteString.Lazy.UTF8 as U
@ -27,10 +26,8 @@ nicHtmlFieldProfile :: YesodNic y => FieldProfile sub y Html
nicHtmlFieldProfile = FieldProfile nicHtmlFieldProfile = FieldProfile
{ fpParse = Right . preEscapedString { fpParse = Right . preEscapedString
, fpRender = U.toString . renderHtml , fpRender = U.toString . renderHtml
, fpHamlet = \theId name val _isReq -> [$hamlet| , fpWidget = \theId name val _isReq -> do
%textarea.html#$theId$!name=$name$ $val$ addBody [$hamlet|%textarea.html#$theId$!name=$name$ $val$|]
|]
, fpWidget = \name -> do
addScript' urlNicEdit addScript' urlNicEdit
addJavaScript [$julius|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")});|] addJavaScript [$julius|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")});|]
} }

View File

@ -1,7 +1,6 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Yesod.Form.Profiles module Yesod.Form.Profiles
( FieldProfile (..) ( stringFieldProfile
, stringFieldProfile
, textareaFieldProfile , textareaFieldProfile
, hiddenFieldProfile , hiddenFieldProfile
, intFieldProfile , intFieldProfile
@ -16,6 +15,7 @@ module Yesod.Form.Profiles
) where ) where
import Yesod.Form.Core import Yesod.Form.Core
import Yesod.Widget
import Text.Hamlet import Text.Hamlet
import Data.Time (Day, TimeOfDay(..)) import Data.Time (Day, TimeOfDay(..))
import qualified Data.ByteString.Lazy.UTF8 as U import qualified Data.ByteString.Lazy.UTF8 as U
@ -26,10 +26,9 @@ intFieldProfile :: Integral i => FieldProfile sub y i
intFieldProfile = FieldProfile intFieldProfile = FieldProfile
{ fpParse = maybe (Left "Invalid integer") Right . readMayI { fpParse = maybe (Left "Invalid integer") Right . readMayI
, fpRender = showI , fpRender = showI
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> addBody [$hamlet|
%input#$theId$!name=$name$!type=number!:isReq:required!value=$val$ %input#$theId$!name=$name$!type=number!:isReq:required!value=$val$
|] |]
, fpWidget = \_name -> return ()
} }
where where
showI x = show (fromIntegral x :: Integer) showI x = show (fromIntegral x :: Integer)
@ -41,70 +40,63 @@ doubleFieldProfile :: FieldProfile sub y Double
doubleFieldProfile = FieldProfile doubleFieldProfile = FieldProfile
{ fpParse = maybe (Left "Invalid number") Right . readMay { fpParse = maybe (Left "Invalid number") Right . readMay
, fpRender = show , fpRender = show
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> addBody [$hamlet|
%input#$theId$!name=$name$!type=number!:isReq:required!value=$val$ %input#$theId$!name=$name$!type=number!:isReq:required!value=$val$
|] |]
, fpWidget = \_name -> return ()
} }
dayFieldProfile :: FieldProfile sub y Day dayFieldProfile :: FieldProfile sub y Day
dayFieldProfile = FieldProfile dayFieldProfile = FieldProfile
{ fpParse = parseDate { fpParse = parseDate
, fpRender = show , fpRender = show
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> addBody [$hamlet|
%input#$theId$!name=$name$!type=date!:isReq:required!value=$val$ %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
|] |]
, fpWidget = const $ return ()
} }
timeFieldProfile :: FieldProfile sub y TimeOfDay timeFieldProfile :: FieldProfile sub y TimeOfDay
timeFieldProfile = FieldProfile timeFieldProfile = FieldProfile
{ fpParse = parseTime { fpParse = parseTime
, fpRender = show , fpRender = show
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> addBody [$hamlet|
%input#$theId$!name=$name$!:isReq:required!value=$val$ %input#$theId$!name=$name$!:isReq:required!value=$val$
|] |]
, fpWidget = const $ return ()
} }
htmlFieldProfile :: FieldProfile sub y Html htmlFieldProfile :: FieldProfile sub y Html
htmlFieldProfile = FieldProfile htmlFieldProfile = FieldProfile
{ fpParse = Right . preEscapedString { fpParse = Right . preEscapedString
, fpRender = U.toString . renderHtml , fpRender = U.toString . renderHtml
, fpHamlet = \theId name val _isReq -> [$hamlet| , fpWidget = \theId name val _isReq -> addBody [$hamlet|
%textarea.html#$theId$!name=$name$ $val$ %textarea.html#$theId$!name=$name$ $val$
|] |]
, fpWidget = const $ return ()
} }
textareaFieldProfile :: FieldProfile sub y String textareaFieldProfile :: FieldProfile sub y String
textareaFieldProfile = FieldProfile textareaFieldProfile = FieldProfile
{ fpParse = Right { fpParse = Right
, fpRender = id , fpRender = id
, fpHamlet = \theId name val _isReq -> [$hamlet| , fpWidget = \theId name val _isReq -> addBody [$hamlet|
%textarea#$theId$!name=$name$ $val$ %textarea#$theId$!name=$name$ $val$
|] |]
, fpWidget = const $ return ()
} }
hiddenFieldProfile :: FieldProfile sub y String hiddenFieldProfile :: FieldProfile sub y String
hiddenFieldProfile = FieldProfile hiddenFieldProfile = FieldProfile
{ fpParse = Right { fpParse = Right
, fpRender = id , fpRender = id
, fpHamlet = \theId name val _isReq -> [$hamlet| , fpWidget = \theId name val _isReq -> addBody [$hamlet|
%input!type=hidden#$theId$!name=$name$!value=$val$ %input!type=hidden#$theId$!name=$name$!value=$val$
|] |]
, fpWidget = const $ return ()
} }
stringFieldProfile :: FieldProfile sub y String stringFieldProfile :: FieldProfile sub y String
stringFieldProfile = FieldProfile stringFieldProfile = FieldProfile
{ fpParse = Right { fpParse = Right
, fpRender = id , fpRender = id
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> addBody [$hamlet|
%input#$theId$!name=$name$!type=text!:isReq:required!value=$val$ %input#$theId$!name=$name$!type=text!:isReq:required!value=$val$
|] |]
, fpWidget = \_name -> return ()
} }
readMay :: Read a => String -> Maybe a readMay :: Read a => String -> Maybe a
@ -151,10 +143,9 @@ emailFieldProfile = FieldProfile
then Right s then Right s
else Left "Invalid e-mail address" else Left "Invalid e-mail address"
, fpRender = id , fpRender = id
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> addBody [$hamlet|
%input#$theId$!name=$name$!type=email!:isReq:required!value=$val$ %input#$theId$!name=$name$!type=email!:isReq:required!value=$val$
|] |]
, fpWidget = const $ return ()
} }
urlFieldProfile :: FieldProfile s y String urlFieldProfile :: FieldProfile s y String
@ -163,8 +154,7 @@ urlFieldProfile = FieldProfile
Nothing -> Left "Invalid URL" Nothing -> Left "Invalid URL"
Just _ -> Right s Just _ -> Right s
, fpRender = id , fpRender = id
, fpHamlet = \theId name val isReq -> [$hamlet| , fpWidget = \theId name val isReq -> addBody [$hamlet|
%input#$theId$!name=$name$!type=url!:isReq:required!value=$val$ %input#$theId$!name=$name$!type=url!:isReq:required!value=$val$
|] |]
, fpWidget = const $ return ()
} }