module Yesod.Form.Jquery
( YesodJquery (..)
, jqueryDayField
, jqueryAutocompleteField
, googleHostedJqueryUiCss
, JqueryDaySettings (..)
, Default (..)
) where
import Yesod.Handler
import Yesod.Core (Route)
import Yesod.Form
import Yesod.Widget
import Data.Time (Day)
import qualified Data.Text as T
import Data.Default
import Text.Hamlet (shamlet)
import Text.Julius (julius)
import Data.Text (Text, pack, unpack)
import Data.Monoid (mconcat)
import Yesod.Core (RenderMessage, SomeMessage (..))
#if __GLASGOW_HASKELL__ >= 700
#define HTML shamlet
#define HAMLET hamlet
#define CASSIUS cassius
#define JULIUS julius
#else
#define HTML $shamlet
#define HAMLET $hamlet
#define CASSIUS $cassius
#define JULIUS $julius
#endif
googleHostedJqueryUiCss :: Text -> Text
googleHostedJqueryUiCss theme = mconcat
[ "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8/themes/"
, theme
, "/jquery-ui.css"
]
class YesodJquery a where
urlJqueryJs :: a -> Either (Route a) Text
urlJqueryJs _ = Right "http://ajax.googleapis.com/ajax/libs/jquery/1.4/jquery.min.js"
urlJqueryUiJs :: a -> Either (Route a) Text
urlJqueryUiJs _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8/jquery-ui.min.js"
urlJqueryUiCss :: a -> Either (Route a) Text
urlJqueryUiCss _ = Right $ googleHostedJqueryUiCss "cupertino"
urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
blank :: (RenderMessage master FormMessage, Monad m) => (Text -> Either FormMessage a) -> [Text] -> m (Either (SomeMessage master) (Maybe a))
blank _ [] = return $ Right Nothing
blank _ ("":_) = return $ Right Nothing
blank f (x:_) = return $ either (Left . SomeMessage) (Right . Just) $ f x
jqueryDayField :: (RenderMessage master FormMessage, YesodJquery master) => JqueryDaySettings -> Field sub master Day
jqueryDayField jds = Field
{ fieldParse = blank $ maybe
(Left MsgInvalidDay)
Right
. readMay
. unpack
, fieldView = \theId name theClass val isReq -> do
addHtml [HTML|\
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="date" :isReq:required="" value="#{showVal val}">
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
addJulius [JULIUS|
$(function(){
var i = $("##{theId}");
if (i.attr("type") != "date") {
i.datepicker({
dateFormat:'yymmdd',
changeMonth:#{jsBool $ jdsChangeMonth jds},
changeYear:#{jsBool $ jdsChangeYear jds},
numberOfMonths:#{mos $ jdsNumberOfMonths jds},
yearRange:"#{jdsYearRange jds}"
});
}
});
|]
}
where
showVal = either id (pack . show)
jsBool True = "true" :: Text
jsBool False = "false" :: Text
mos (Left i) = show i
mos (Right (x, y)) = concat
[ "["
, show x
, ","
, show y
, "]"
]
jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master)
=> Route master -> Field sub master Text
jqueryAutocompleteField src = Field
{ fieldParse = blank $ Right
, fieldView = \theId name theClass val isReq -> do
addHtml [HTML|\
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
addJulius [JULIUS|
$(function(){$("##{theId}").autocomplete({source:"@{src}",minLength:2})});
|]
}
addScript' :: (master -> Either (Route master) Text) -> GWidget sub master ()
addScript' f = do
y <- lift getYesod
addScriptEither $ f y
addStylesheet' :: (y -> Either (Route y) Text) -> 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
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
}