module Yesod.Form.Jquery
( YesodJquery (..)
, jqueryDayField
, maybeJqueryDayField
, jqueryDayTimeField
, jqueryDayTimeFieldProfile
, jqueryAutocompleteField
, maybeJqueryAutocompleteField
, jqueryDayFieldProfile
) where
import Yesod.Handler
import Yesod.Form.Core
import Yesod.Form.Profiles
import Yesod.Widget
import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
timeToTimeOfDay)
import Yesod.Hamlet
import Data.Char (isSpace)
class YesodJquery a where
urlJqueryJs :: a -> Either (Route a) String
urlJqueryJs _ = Right "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
urlJqueryUiJs :: a -> Either (Route a) String
urlJqueryUiJs _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
urlJqueryUiCss :: a -> Either (Route a) String
urlJqueryUiCss _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"
urlJqueryUiDateTimePicker :: a -> Either (Route a) String
urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
jqueryDayField :: YesodJquery y => FormFieldSettings -> FormletField sub y Day
jqueryDayField = requiredFieldHelper jqueryDayFieldProfile
maybeJqueryDayField :: YesodJquery y => FormFieldSettings -> FormletField sub y (Maybe Day)
maybeJqueryDayField = optionalFieldHelper jqueryDayFieldProfile
jqueryDayFieldProfile :: YesodJquery y => FieldProfile sub y Day
jqueryDayFieldProfile = FieldProfile
{ fpParse = maybe
(Left "Invalid day, must be in YYYY-MM-DD format")
Right
. readMay
, fpRender = show
, fpWidget = \theId name val isReq -> do
addBody [$hamlet|
%input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
addJavascript [$julius|
$(function(){$("#%theId%").datepicker({dateFormat:'yymmdd'})});
|]
}
ifRight :: Either a b -> (b -> c) -> Either a c
ifRight e f = case e of
Left l -> Left l
Right r -> Right $ f r
showLeadingZero :: (Show a) => a -> String
showLeadingZero time = let t = show time in if length t == 1 then "0" ++ t else t
jqueryDayTimeField :: YesodJquery y => FormFieldSettings -> FormletField sub y UTCTime
jqueryDayTimeField = requiredFieldHelper jqueryDayTimeFieldProfile
jqueryDayTimeUTCTime :: UTCTime -> String
jqueryDayTimeUTCTime (UTCTime day utcTime) =
let timeOfDay = timeToTimeOfDay utcTime
in (replace '-' '/' (show day)) ++ " " ++ showTimeOfDay timeOfDay
where
showTimeOfDay (TimeOfDay hour minute _) =
let (h, apm) = if hour < 12 then (hour, "AM") else (hour 12, "PM")
in (show h) ++ ":" ++ (showLeadingZero minute) ++ " " ++ apm
jqueryDayTimeFieldProfile :: YesodJquery y => FieldProfile sub y UTCTime
jqueryDayTimeFieldProfile = FieldProfile
{ fpParse = parseUTCTime
, fpRender = jqueryDayTimeUTCTime
, fpWidget = \theId name val isReq -> do
addBody [$hamlet|
%input#$theId$!name=$name$!:isReq:required!value=$val$
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addScript' urlJqueryUiDateTimePicker
addStylesheet' urlJqueryUiCss
addJavascript [$julius|
$(function(){$("#%theId%").datetimepicker({dateFormat : "yyyy/mm/dd h:MM TT"})});
|]
}
parseUTCTime :: String -> Either String UTCTime
parseUTCTime s =
let (dateS, timeS) = break isSpace (dropWhile isSpace s)
dateE = parseDate dateS
in case dateE of
Left l -> Left l
Right date ->
ifRight (parseTime timeS)
(UTCTime date . timeOfDayToTime)
jqueryAutocompleteField :: YesodJquery y =>
Route y -> FormFieldSettings -> FormletField sub y String
jqueryAutocompleteField = requiredFieldHelper . jqueryAutocompleteFieldProfile
maybeJqueryAutocompleteField :: YesodJquery y =>
Route y -> FormFieldSettings -> FormletField sub y (Maybe String)
maybeJqueryAutocompleteField src =
optionalFieldHelper $ jqueryAutocompleteFieldProfile src
jqueryAutocompleteFieldProfile :: YesodJquery y => Route y -> FieldProfile sub y String
jqueryAutocompleteFieldProfile src = FieldProfile
{ fpParse = Right
, fpRender = id
, fpWidget = \theId name val isReq -> do
addBody [$hamlet|
%input.autocomplete#$theId$!name=$name$!type=text!:isReq:required!value=$val$
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
addJavascript [$julius|
$(function(){$("#%theId%").autocomplete({source:"@src@",minLength:2})});
|]
}
addScript' :: (y -> Either (Route y) String) -> GWidget sub y ()
addScript' f = do
y <- liftHandler getYesod
addScriptEither $ f y
addStylesheet' :: (y -> Either (Route y) String) -> GWidget sub y ()
addStylesheet' f = do
y <- liftHandler getYesod
addStylesheetEither $ f y
readMay :: Read a => String -> Maybe a
readMay s = case reads s of
(x, _):_ -> Just x
[] -> Nothing
replace :: Eq a => a -> a -> [a] -> [a]
replace x y = map (\z -> if z == x then y else z)