1{-# LANGUAGE QuasiQuotes #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE OverloadedStrings #-}
5-- | Some fields spiced up with jQuery UI.
6module Yesod.Form.Jquery
7    ( YesodJquery (..)
8    , jqueryDayField
9    , jqueryDatePickerDayField
10    , jqueryAutocompleteField
11    , jqueryAutocompleteField'
12    , googleHostedJqueryUiCss
13    , JqueryDaySettings (..)
14    , Default (..)
15    ) where
16
17import Yesod.Core
18import Yesod.Form
19import Data.Time (Day)
20import Data.Default
21import Text.Julius (rawJS)
22import Data.Text (Text, pack, unpack)
23import Data.Monoid (mconcat)
24
25-- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme.
26googleHostedJqueryUiCss :: Text -> Text
27googleHostedJqueryUiCss theme = Data.Monoid.mconcat
28    [ "//ajax.googleapis.com/ajax/libs/jqueryui/1.8/themes/"
29    , theme
30    , "/jquery-ui.css"
31    ]
32
33class YesodJquery a where
34    -- | The jQuery Javascript file. Note that in upgrades to this library, the
35    -- version of jQuery referenced, or where it is downloaded from, may be
36    -- changed without warning. If you are relying on a specific version of
37    -- jQuery, you should give an explicit URL instead of relying on the
38    -- default value.
39    --
40    -- Currently, the default value is jQuery 1.7 from Google\'s CDN.
41    urlJqueryJs :: a -> Either (Route a) Text
42    urlJqueryJs _ = Right "//ajax.googleapis.com/ajax/libs/jquery/1.7/jquery.min.js"
43
44    -- | The jQuery UI 1.8 Javascript file.
45    urlJqueryUiJs :: a -> Either (Route a) Text
46    urlJqueryUiJs _ = Right "//ajax.googleapis.com/ajax/libs/jqueryui/1.8/jquery-ui.min.js"
47
48    -- | The jQuery UI 1.8 CSS file; defaults to cupertino theme.
49    urlJqueryUiCss :: a -> Either (Route a) Text
50    urlJqueryUiCss _ = Right $ googleHostedJqueryUiCss "cupertino"
51
52    -- | jQuery UI time picker add-on.
53    urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
54    urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
55
56jqueryDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field (HandlerFor site) Day
57jqueryDayField = flip jqueryDayField' "date"
58
59-- | Use jQuery's datepicker as the underlying implementation.
60--
61-- Since 1.4.3
62jqueryDatePickerDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field (HandlerFor site) Day
63jqueryDatePickerDayField = flip jqueryDayField' "text"
64
65jqueryDayField' :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Text -> Field (HandlerFor site) Day
66jqueryDayField' jds inputType = Field
67    { fieldParse = parseHelper $ maybe
68                  (Left MsgInvalidDay)
69                  Right
70              . readMay
71              . unpack
72    , fieldView = \theId name attrs val isReq -> do
73        toWidget [shamlet|
74$newline never
75<input id="#{theId}" name="#{name}" *{attrs} type="#{inputType}" :isReq:required="" value="#{showVal val}">
76|]
77        addScript' urlJqueryJs
78        addScript' urlJqueryUiJs
79        addStylesheet' urlJqueryUiCss
80        toWidget [julius|
81$(function(){
82    var i = document.getElementById("#{rawJS theId}");
83    if (i.type != "date") {
84        $(i).datepicker({
85            dateFormat:'yy-mm-dd',
86            changeMonth:#{jsBool $ jdsChangeMonth jds},
87            changeYear:#{jsBool $ jdsChangeYear jds},
88            numberOfMonths:#{rawJS $ mos $ jdsNumberOfMonths jds},
89            yearRange:#{toJSON $ jdsYearRange jds}
90        });
91    }
92});
93|]
94    , fieldEnctype = UrlEncoded
95    }
96  where
97    showVal = either id (pack . show)
98    jsBool True = toJSON True
99    jsBool False = toJSON False
100    mos (Left i) = show i
101    mos (Right (x, y)) = concat
102        [ "["
103        , show x
104        , ","
105        , show y
106        , "]"
107        ]
108
109jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site)
110                        => Route site -> Field (HandlerFor site) Text
111jqueryAutocompleteField = jqueryAutocompleteField' 2
112
113jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site)
114                         => Int -- ^ autocomplete minimum length
115                         -> Route site
116                         -> Field (HandlerFor site) Text
117jqueryAutocompleteField' minLen src = Field
118    { fieldParse = parseHelper $ Right
119    , fieldView = \theId name attrs val isReq -> do
120        toWidget [shamlet|
121$newline never
122<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
123|]
124        addScript' urlJqueryJs
125        addScript' urlJqueryUiJs
126        addStylesheet' urlJqueryUiCss
127        toWidget [julius|
128$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:#{toJSON minLen}})});
129|]
130    , fieldEnctype = UrlEncoded
131    }
132
133addScript' :: (HandlerSite m ~ site, MonadWidget m) => (site -> Either (Route site) Text) -> m ()
134addScript' f = do
135    y <- getYesod
136    addScriptEither $ f y
137
138addStylesheet' :: (MonadWidget m, HandlerSite m ~ site)
139               => (site -> Either (Route site) Text)
140               -> m ()
141addStylesheet' f = do
142    y <- getYesod
143    addStylesheetEither $ f y
144
145readMay :: Read a => String -> Maybe a
146readMay s = case reads s of
147                (x, _):_ -> Just x
148                [] -> Nothing
149
150data JqueryDaySettings = JqueryDaySettings
151    { jdsChangeMonth :: Bool
152    , jdsChangeYear :: Bool
153    , jdsYearRange :: String
154    , jdsNumberOfMonths :: Either Int (Int, Int)
155    }
156
157instance Default JqueryDaySettings where
158    def = JqueryDaySettings
159        { jdsChangeMonth = False
160        , jdsChangeYear = False
161        , jdsYearRange = "c-10:c+10"
162        , jdsNumberOfMonths = Left 1
163        }
164