module Yesod.Form.Jquery
( YesodJquery (..)
, jqueryDayField
, maybeJqueryDayField
, jqueryDayTimeField
, jqueryDayTimeFieldProfile
, jqueryAutocompleteField
, maybeJqueryAutocompleteField
, jqueryDayFieldProfile
, googleHostedJqueryUiCss
, JqueryDaySettings (..)
, Default (..)
) where
import Yesod.Handler
import Yesod.Form.Core
import Yesod.Form.Profiles
import Yesod.Widget
import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
timeToTimeOfDay)
import Data.Char (isSpace)
import Data.Default
import Text.Hamlet (hamlet)
import Text.Julius (julius)
import Control.Monad.Trans.Class (lift)
#if __GLASGOW_HASKELL__ >= 700
#define HAMLET hamlet
#define CASSIUS cassius
#define JULIUS julius
#else
#define HAMLET $hamlet
#define CASSIUS $cassius
#define JULIUS $julius
#endif
googleHostedJqueryUiCss :: String -> String
googleHostedJqueryUiCss theme = concat
[ "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8/themes/"
, theme
, "/jquery-ui.css"
]
class YesodJquery a where
urlJqueryJs :: a -> Either (Route a) String
urlJqueryJs _ = Right "http://ajax.googleapis.com/ajax/libs/jquery/1.4/jquery.min.js"
urlJqueryUiJs :: a -> Either (Route a) String
urlJqueryUiJs _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8/jquery-ui.min.js"
urlJqueryUiCss :: a -> Either (Route a) String
urlJqueryUiCss _ = Right $ googleHostedJqueryUiCss "cupertino"
urlJqueryUiDateTimePicker :: a -> Either (Route a) String
urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
jqueryDayField :: (IsForm f, FormType f ~ Day, YesodJquery (FormMaster f))
=> JqueryDaySettings
-> FormFieldSettings
-> Maybe (FormType f)
-> f
jqueryDayField = requiredFieldHelper . jqueryDayFieldProfile
maybeJqueryDayField
:: (IsForm f, FormType f ~ Maybe Day, YesodJquery (FormMaster f))
=> JqueryDaySettings
-> FormFieldSettings
-> Maybe (FormType f)
-> f
maybeJqueryDayField = optionalFieldHelper . jqueryDayFieldProfile
jqueryDayFieldProfile :: YesodJquery y
=> JqueryDaySettings -> FieldProfile sub y Day
jqueryDayFieldProfile jds = FieldProfile
{ fpParse = maybe
(Left "Invalid day, must be in YYYY-MM-DD format")
Right
. readMay
, fpRender = show
, fpWidget = \theId name val isReq -> do
addHtml [HAMLET|\
<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{val}">
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
addJulius [JULIUS|
$(function(){$("##{theId}").datepicker({
dateFormat:'yymmdd',
changeMonth:#{jsBool $ jdsChangeMonth jds},
changeYear:#{jsBool $ jdsChangeYear jds},
numberOfMonths:#{mos $ jdsNumberOfMonths jds},
yearRange:"#{jdsYearRange jds}"
})});
|]
}
where
jsBool True = "true"
jsBool False = "false"
mos (Left i) = show i
mos (Right (x, y)) = concat
[ "["
, show x
, ","
, show y
, "]"
]
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
:: (IsForm f, FormType f ~ UTCTime, YesodJquery (FormMaster f))
=> FormFieldSettings
-> Maybe (FormType f)
-> f
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
addHtml [HAMLET|\
<input id="#{theId}" name="#{name}" :isReq:required="" value="#{val}">
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addScript' urlJqueryUiDateTimePicker
addStylesheet' urlJqueryUiCss
addJulius [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
:: (IsForm f, FormType f ~ String, YesodJquery (FormMaster f))
=> Route (FormMaster f)
-> FormFieldSettings
-> Maybe (FormType f)
-> f
jqueryAutocompleteField = requiredFieldHelper . jqueryAutocompleteFieldProfile
maybeJqueryAutocompleteField
:: (IsForm f, FormType f ~ Maybe String, YesodJquery (FormMaster f))
=> Route (FormMaster f)
-> FormFieldSettings
-> Maybe (FormType f)
-> f
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
addHtml [HAMLET|\
<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{val}" .autocomplete>
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
addJulius [JULIUS|
$(function(){$("##{theId}").autocomplete({source:"@{src}",minLength:2})});
|]
}
addScript' :: (y -> Either (Route y) String) -> GWidget sub y ()
addScript' f = do
y <- lift getYesod
addScriptEither $ f y
addStylesheet' :: (y -> Either (Route y) String) -> GWidget sub y ()
addStylesheet' f = do
y <- lift 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)
data JqueryDaySettings = JqueryDaySettings
{ jdsChangeMonth :: Bool
, jdsChangeYear :: Bool
, jdsYearRange :: String
, jdsNumberOfMonths :: Either Int (Int, Int)
}
instance Default JqueryDaySettings where
def = JqueryDaySettings
{ jdsChangeMonth = False
, jdsChangeYear = False
, jdsYearRange = "c-10:c+10"
, jdsNumberOfMonths = Left 1
}