    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE OverloadedStrings #-}
    -- | Some fields spiced up with jQuery UI.
    module Yesod.Form.Jquery
        ( YesodJquery (..)
        , jqueryDayField
        , jqueryDatePickerDayField
        , jqueryAutocompleteField
        , jqueryAutocompleteField'
        , googleHostedJqueryUiCss
        , JqueryDaySettings (..)
        , Default (..)
        ) where

    import Yesod.Core
    import Yesod.Form
    import Data.Time (Day)
    import Data.Default
    import Text.Julius (rawJS)
    import Data.Text (Text, pack, unpack)
    import Data.Monoid (mconcat)

    -- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme.
    googleHostedJqueryUiCss :: Text -> Text
    googleHostedJqueryUiCss :: Text -> Text
    googleHostedJqueryUiCss Text
    theme = [Text] -> Text
    forall a. Monoid a => [a] -> a
    Data.Monoid.mconcat
        [ Text
    "//ajax.googleapis.com/ajax/libs/jqueryui/1.8/themes/"
        , Text
    theme
        , Text
    "/jquery-ui.css"
        ]

    class YesodJquery a where
        -- | The jQuery Javascript file. Note that in upgrades to this library, the
        -- version of jQuery referenced, or where it is downloaded from, may be
        -- changed without warning. If you are relying on a specific version of
        -- jQuery, you should give an explicit URL instead of relying on the
        -- default value.
        --
        -- Currently, the default value is jQuery 1.7 from Google\'s CDN.
        urlJqueryJs :: a -> Either (Route a) Text
        urlJqueryJs a
    _ = Text -> Either (Route a) Text
    forall a b. b -> Either a b
    Right Text
    "//ajax.googleapis.com/ajax/libs/jquery/1.7/jquery.min.js"

        -- | The jQuery UI 1.8 Javascript file.
        urlJqueryUiJs :: a -> Either (Route a) Text
        urlJqueryUiJs a
    _ = Text -> Either (Route a) Text
    forall a b. b -> Either a b
    Right Text
    "//ajax.googleapis.com/ajax/libs/jqueryui/1.8/jquery-ui.min.js"

        -- | The jQuery UI 1.8 CSS file; defaults to cupertino theme.
        urlJqueryUiCss :: a -> Either (Route a) Text
        urlJqueryUiCss a
    _ = Text -> Either (Route a) Text
    forall a b. b -> Either a b
    Right (Text -> Either (Route a) Text) -> Text -> Either (Route a) Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    googleHostedJqueryUiCss Text
    "cupertino"

        -- | jQuery UI time picker add-on.
        urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
        urlJqueryUiDateTimePicker a
    _ = Text -> Either (Route a) Text
    forall a b. b -> Either a b
    Right Text
    "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"

    jqueryDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field (HandlerFor site) Day
    jqueryDayField :: forall site.
    (RenderMessage site FormMessage, YesodJquery site) =>
    JqueryDaySettings -> Field (HandlerFor site) Day
    jqueryDayField = (JqueryDaySettings -> Text -> Field (HandlerFor site) Day)
    -> Text -> JqueryDaySettings -> Field (HandlerFor site) Day
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip JqueryDaySettings -> Text -> Field (HandlerFor site) Day
    forall site.
    (RenderMessage site FormMessage, YesodJquery site) =>
    JqueryDaySettings -> Text -> Field (HandlerFor site) Day
    jqueryDayField' Text
    "date"

    -- | Use jQuery's datepicker as the underlying implementation.
    --
    -- Since 1.4.3
    jqueryDatePickerDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field (HandlerFor site) Day
    jqueryDatePickerDayField :: forall site.
    (RenderMessage site FormMessage, YesodJquery site) =>
    JqueryDaySettings -> Field (HandlerFor site) Day
    jqueryDatePickerDayField = (JqueryDaySettings -> Text -> Field (HandlerFor site) Day)
    -> Text -> JqueryDaySettings -> Field (HandlerFor site) Day
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip JqueryDaySettings -> Text -> Field (HandlerFor site) Day
    forall site.
    (RenderMessage site FormMessage, YesodJquery site) =>
    JqueryDaySettings -> Text -> Field (HandlerFor site) Day
    jqueryDayField' Text
    "text"

    jqueryDayField' :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Text -> Field (HandlerFor site) Day
    jqueryDayField' :: forall site.
    (RenderMessage site FormMessage, YesodJquery site) =>
    JqueryDaySettings -> Text -> Field (HandlerFor site) Day
    jqueryDayField' JqueryDaySettings
    jds Text
    inputType = Field
        { fieldParse :: [Text]
    -> [FileInfo]
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Day))
    fieldParse = (Text -> Either FormMessage Day)
    -> [Text]
    -> [FileInfo]
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Day))
    forall (m :: * -> *) site a.
    (Monad m, RenderMessage site FormMessage) =>
    (Text -> Either FormMessage a)
    -> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
    parseHelper ((Text -> Either FormMessage Day)
     -> [Text]
     -> [FileInfo]
     -> HandlerFor
          site
          (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Day)))
    -> (Text -> Either FormMessage Day)
    -> [Text]
    -> [FileInfo]
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Day))
    forall a b. (a -> b) -> a -> b
    $ Either FormMessage Day
    -> (Day -> Either FormMessage Day)
    -> Maybe Day
    -> Either FormMessage Day
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
                      (FormMessage -> Either FormMessage Day
    forall a b. a -> Either a b
    Left FormMessage
    MsgInvalidDay)
                      Day -> Either FormMessage Day
    forall a b. b -> Either a b
    Right
                  (Maybe Day -> Either FormMessage Day)
    -> (Text -> Maybe Day) -> Text -> Either FormMessage Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe Day
    forall a. Read a => String -> Maybe a
    readMay
                  (String -> Maybe Day) -> (Text -> String) -> Text -> Maybe Day
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    unpack
        , fieldView :: FieldViewFunc (HandlerFor site) Day
    fieldView = \Text
    theId Text
    name [(Text, Text)]
    attrs Either Text Day
    val Bool
    isReq -> do
            MarkupM () -> WidgetFor site ()
    forall site a (m :: * -> *).
    (ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
    a -> m ()
    forall (m :: * -> *).
    (MonadWidget m, HandlerSite m ~ site) =>
    MarkupM () -> m ()
    toWidget [shamlet|
    $newline never
    <input id="#{theId}" name="#{name}" *{attrs} type="#{inputType}" :isReq:required="" value="#{showVal val}">
    |]
            (site -> Either (Route site) Text) -> WidgetFor site ()
    forall (m :: * -> *) site.
    (HandlerSite m ~ site, MonadWidget m) =>
    (site -> Either (Route site) Text) -> m ()
    addScript' site -> Either (Route site) Text
    forall a. YesodJquery a => a -> Either (Route a) Text
    urlJqueryJs
            (site -> Either (Route site) Text) -> WidgetFor site ()
    forall (m :: * -> *) site.
    (HandlerSite m ~ site, MonadWidget m) =>
    (site -> Either (Route site) Text) -> m ()
    addScript' site -> Either (Route site) Text
    forall a. YesodJquery a => a -> Either (Route a) Text
    urlJqueryUiJs
            (site -> Either (Route site) Text) -> WidgetFor site ()
    forall (m :: * -> *) site.
    (MonadWidget m, HandlerSite m ~ site) =>
    (site -> Either (Route site) Text) -> m ()
    addStylesheet' site -> Either (Route site) Text
    forall a. YesodJquery a => a -> Either (Route a) Text
    urlJqueryUiCss
            JavascriptUrl (Route site) -> WidgetFor site ()
    forall site a (m :: * -> *).
    (ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
    a -> m ()
    forall (m :: * -> *).
    (MonadWidget m, HandlerSite m ~ site) =>
    JavascriptUrl (Route site) -> m ()
    toWidget [julius|
    $(function(){
        var i = document.getElementById("#{rawJS theId}");
        if (i.type != "date") {
            $(i).datepicker({
                dateFormat:'yy-mm-dd',
                changeMonth:#{jsBool $ jdsChangeMonth jds},
                changeYear:#{jsBool $ jdsChangeYear jds},
                numberOfMonths:#{rawJS $ mos $ jdsNumberOfMonths jds},
                yearRange:#{toJSON $ jdsYearRange jds}
            });
        }
    });
    |]
        , fieldEnctype :: Enctype
    fieldEnctype = Enctype
    UrlEncoded
        }
      where
        showVal :: Either Text Day -> Text
    showVal = (Text -> Text) -> (Day -> Text) -> Either Text Day -> Text
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Text -> Text
    forall a. a -> a
    id (String -> Text
    pack (String -> Text) -> (Day -> String) -> Day -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Day -> String
    forall a. Show a => a -> String
    show)
        jsBool :: Bool -> Value
    jsBool Bool
    True = Bool -> Value
    forall a. ToJSON a => a -> Value
    toJSON Bool
    True
        jsBool Bool
    False = Bool -> Value
    forall a. ToJSON a => a -> Value
    toJSON Bool
    False
        mos :: Either a (a, a) -> String
    mos (Left a
    i) = a -> String
    forall a. Show a => a -> String
    show a
    i
        mos (Right (a
    x, a
    y)) = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
            [ String
    "["
            , a -> String
    forall a. Show a => a -> String
    show a
    x
            , String
    ","
            , a -> String
    forall a. Show a => a -> String
    show a
    y
            , String
    "]"
            ]

    jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site)
                            => Route site -> Field (HandlerFor site) Text
    jqueryAutocompleteField :: forall site.
    (RenderMessage site FormMessage, YesodJquery site) =>
    Route site -> Field (HandlerFor site) Text
    jqueryAutocompleteField = Int -> Route site -> Field (HandlerFor site) Text
    forall site.
    (RenderMessage site FormMessage, YesodJquery site) =>
    Int -> Route site -> Field (HandlerFor site) Text
    jqueryAutocompleteField' Int
    2

    jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site)
                             => Int -- ^ autocomplete minimum length
                             -> Route site
                             -> Field (HandlerFor site) Text
    jqueryAutocompleteField' :: forall site.
    (RenderMessage site FormMessage, YesodJquery site) =>
    Int -> Route site -> Field (HandlerFor site) Text
    jqueryAutocompleteField' Int
    minLen Route site
    src = Field
        { fieldParse :: [Text]
    -> [FileInfo]
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Text))
    fieldParse = (Text -> Either FormMessage Text)
    -> [Text]
    -> [FileInfo]
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Text))
    forall (m :: * -> *) site a.
    (Monad m, RenderMessage site FormMessage) =>
    (Text -> Either FormMessage a)
    -> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
    parseHelper ((Text -> Either FormMessage Text)
     -> [Text]
     -> [FileInfo]
     -> HandlerFor
          site
          (Either
             (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Text)))
    -> (Text -> Either FormMessage Text)
    -> [Text]
    -> [FileInfo]
    -> HandlerFor
         site
         (Either (SomeMessage (HandlerSite (HandlerFor site))) (Maybe Text))
    forall a b. (a -> b) -> a -> b
    $ Text -> Either FormMessage Text
    forall a b. b -> Either a b
    Right
        , fieldView :: FieldViewFunc (HandlerFor site) Text
    fieldView = \Text
    theId Text
    name [(Text, Text)]
    attrs Either Text Text
    val Bool
    isReq -> do
            MarkupM () -> WidgetFor site ()
    forall site a (m :: * -> *).
    (ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
    a -> m ()
    forall (m :: * -> *).
    (MonadWidget m, HandlerSite m ~ site) =>
    MarkupM () -> m ()
    toWidget [shamlet|
    $newline never
    <input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
    |]
            (site -> Either (Route site) Text) -> WidgetFor site ()
    forall (m :: * -> *) site.
    (HandlerSite m ~ site, MonadWidget m) =>
    (site -> Either (Route site) Text) -> m ()
    addScript' site -> Either (Route site) Text
    forall a. YesodJquery a => a -> Either (Route a) Text
    urlJqueryJs
            (site -> Either (Route site) Text) -> WidgetFor site ()
    forall (m :: * -> *) site.
    (HandlerSite m ~ site, MonadWidget m) =>
    (site -> Either (Route site) Text) -> m ()
    addScript' site -> Either (Route site) Text
    forall a. YesodJquery a => a -> Either (Route a) Text
    urlJqueryUiJs
            (site -> Either (Route site) Text) -> WidgetFor site ()
    forall (m :: * -> *) site.
    (MonadWidget m, HandlerSite m ~ site) =>
    (site -> Either (Route site) Text) -> m ()
    addStylesheet' site -> Either (Route site) Text
    forall a. YesodJquery a => a -> Either (Route a) Text
    urlJqueryUiCss
            JavascriptUrl (Route site) -> WidgetFor site ()
    forall site a (m :: * -> *).
    (ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
    a -> m ()
    forall (m :: * -> *).
    (MonadWidget m, HandlerSite m ~ site) =>
    JavascriptUrl (Route site) -> m ()
    toWidget [julius|
    $(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:#{toJSON minLen}})});
    |]
        , fieldEnctype :: Enctype
    fieldEnctype = Enctype
    UrlEncoded
        }

    addScript' :: (HandlerSite m ~ site, MonadWidget m) => (site -> Either (Route site) Text) -> m ()
    addScript' :: forall (m :: * -> *) site.
    (HandlerSite m ~ site, MonadWidget m) =>
    (site -> Either (Route site) Text) -> m ()
    addScript' site -> Either (Route site) Text
    f = do
        y <- m site
    m (HandlerSite m)
    forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
    getYesod
        addScriptEither $ f y

    addStylesheet' :: (MonadWidget m, HandlerSite m ~ site)
                   => (site -> Either (Route site) Text)
                   -> m ()
    addStylesheet' :: forall (m :: * -> *) site.
    (MonadWidget m, HandlerSite m ~ site) =>
    (site -> Either (Route site) Text) -> m ()
    addStylesheet' site -> Either (Route site) Text
    f = do
        y <- m site
    m (HandlerSite m)
    forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
    getYesod
        addStylesheetEither $ f y

    readMay :: Read a => String -> Maybe a
    readMay :: forall a. Read a => String -> Maybe a
    readMay String
    s = case ReadS a
    forall a. Read a => ReadS a
    reads String
    s of
                    (a
    x, String
    _):[(a, String)]
    _ -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x
                    [] -> Maybe a
    forall a. Maybe a
    Nothing

    data JqueryDaySettings = JqueryDaySettings
        { JqueryDaySettings -> Bool
    jdsChangeMonth :: Bool
        , JqueryDaySettings -> Bool
    jdsChangeYear :: Bool
        , JqueryDaySettings -> String
    jdsYearRange :: String
        , JqueryDaySettings -> Either Int (Int, Int)
    jdsNumberOfMonths :: Either Int (Int, Int)
        }

    instance Default JqueryDaySettings where
        def :: JqueryDaySettings
    def = JqueryDaySettings
            { jdsChangeMonth :: Bool
    jdsChangeMonth = Bool
    False
            , jdsChangeYear :: Bool
    jdsChangeYear = Bool
    False
            , jdsYearRange :: String
    jdsYearRange = String
    "c-10:c+10"
            , jdsNumberOfMonths :: Either Int (Int, Int)
    jdsNumberOfMonths = Int -> Either Int (Int, Int)
    forall a b. a -> Either a b
    Left Int
    1
            }