haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove fpHamlet

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Yesod/Form/Class.hs
View File

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

12
Yesod/Form/Core.hs
View File

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

12
Yesod/Form/Jquery.hs
View File

@ -49,10 +49,10 @@ jqueryDayFieldProfile = FieldProfile
Right
. readMay
, 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$
|]
, fpWidget = \name -> do
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
@ -86,10 +86,10 @@ jqueryDayTimeFieldProfile :: YesodJquery y => FieldProfile sub y UTCTime
jqueryDayTimeFieldProfile = FieldProfile
{ fpParse = parseUTCTime
, 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$
|]
, fpWidget = \name -> do
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addScript' urlJqueryUiDateTimePicker
@ -122,10 +122,10 @@ jqueryAutocompleteFieldProfile :: YesodJquery y => Route y -> FieldProfile sub y
jqueryAutocompleteFieldProfile src = FieldProfile
{ fpParse = Right
, 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$
|]
, fpWidget = \name -> do
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss

7
Yesod/Form/Nic.hs
View File

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

34
Yesod/Form/Profiles.hs
View File

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