Remove fpHamlet
This commit is contained in:
parent
a609f2d046
commit
b5fa539f1b
@ -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
|
||||||
|
|||||||
@ -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 ())
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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$")});|]
|
||||||
}
|
}
|
||||||
|
|||||||
@ -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 ()
|
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user