{- |
Some dynamic widgets, widgets that dynamically edit content in other widgets,
widgets for templating, content management and multilanguage. And some primitives
to create other active widgets.
-}

{-# LANGUAGE UndecidableInstances,ExistentialQuantification
            , FlexibleInstances, OverlappingInstances, FlexibleContexts
            , OverloadedStrings, DeriveDataTypeable , ScopedTypeVariables
            , TemplateHaskell #-}




module MFlow.Forms.Widgets (
-- * Ajax refreshing of widgets
autoRefresh, appendUpdate, prependUpdate, push, UpdateMethod(..)

-- * JQueryUi widgets
,datePicker, getSpinner, wautocomplete, wdialog,

-- * User Management
userFormOrName,maybeLogout,

-- * Active widgets
wEditList,wautocompleteList
, wautocompleteEdit,

-- * Editing widgets
delEdited, getEdited
,prependWidget,appendWidget,setWidget

-- * Content Management
,tField, tFieldEd, tFieldGen

-- * Multilanguage
,mFieldEd, mField

) where
import MFlow
import MFlow.Forms
import MFlow.Forms.Internals
import Data.Monoid
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans
import Data.Typeable
import Data.List
import System.IO.Unsafe

import Control.Monad.State
import Data.TCache
import Data.TCache.Defs
import Data.TCache.Memoization
import Data.RefSerialize hiding ((<|>))
import qualified Data.Map as M
import Data.IORef
import MFlow.Cookies
import Data.Maybe
import Data.Char
import Control.Monad.Identity
import Control.Workflow(killWF)



readyJQuery="ready=function(){if(!window.jQuery){return setTimeout(ready,100)}};"

jqueryScript1= "http://ajax.googleapis.com/ajax/libs/jquery/1.9.1/jquery.min.js"
jqueryScript="http://code.jquery.com/jquery-1.9.1.js"

jqueryCSS1= "http://code.jquery.com/ui/1.9.1/themes/base/jquery-ui.css"
jqueryCSS= "http://code.jquery.com/ui/1.10.3/themes/smoothness/jquery-ui.css"

jqueryUI1= "http://code.jquery.com/ui/1.9.1/jquery-ui.js"
jqueryUI= "http://code.jquery.com/ui/1.10.3/jquery-ui.js"

------- User Management ------

-- | Present a user form if not logged in. Otherwise, the user name and a logout link is presented.
-- The paremeters and the behaviour are the same as 'userWidget'.
-- Only the display is different
userFormOrName  mode wid= userWidget mode wid `wmodify` f  <** maybeLogout
  where
  f _ justu@(Just u)  =  return ([fromStr u], justu) -- !> "input"
  f felem Nothing = do
     us <- getCurrentUser -- getEnv cookieuser
     if us == anonymous
           then return (felem, Nothing)
           else return([fromStr us],  Just us)

-- | Display a logout link if the user is logged. Nothing otherwise
maybeLogout :: (MonadIO m,Functor m,FormInput v) => View v m ()
maybeLogout= do
    us <- getCurrentUser
    if us/= anonymous
      then do
          cmd <- ajax $ const $ return "window.location=='/'" --refresh
          fromStr " " ++> ((wlink () (fromStr "logout")) <![("onclick",cmd "''")]) `waction` const logout
      else noWidget


data Medit view m a = Medit (M.Map B.ByteString [(String,View view m a)])
instance (Typeable view, Typeable a)
         =>Typeable (Medit view m a) where
  typeOf= \v -> mkTyConApp (mkTyCon3 "MFlow" "MFlow.Forms.Widgets" "Medit" )
                [typeOf (tview v)
                ,typeOf (ta v)]
      where
      tview :: Medit v m a -> v
      tview= undefined
      tm :: Medit v m a -> m a
      tm= undefined
      ta :: Medit v m a -> a
      ta= undefined

getEdited1 id= do
    Medit stored <- getSessionData `onNothing` return (Medit M.empty)
    return $ fromMaybe [] $ M.lookup id stored

-- | Return the list of edited widgets (added by the active widgets) for a given identifier
getEdited
  :: (Typeable v, Typeable a, MonadState (MFlowState view) m) =>
     B.ByteString -> m [View v m1 a]
getEdited id= do
  r <- getEdited1 id
  let (_,ws)= unzip r
  return ws

-- | Deletes the list of edited widgets for a certain identifier and with the type of the witness widget parameter
delEdited
  :: (Typeable v, Typeable a, MonadIO m,
      MonadState (MFlowState view) m)
     => B.ByteString           -- ^ identifier
     -> [View v m1 a] -> m ()  -- ^ withess
delEdited id witness=do
    Medit stored <-  getSessionData `onNothing` return (Medit (M.empty))
    let (ks, ws)=  unzip $ fromMaybe [] $ M.lookup id stored

    return $ ws `asTypeOf` witness
    liftIO $ mapM  flushCached ks
    let stored'= M.delete id  stored
    setSessionData . Medit $ stored'



--    setEdited id ([] `asTypeOf` (zip (repeat "") witness))

setEdited id ws= do
    Medit stored <-  getSessionData `onNothing` return (Medit (M.empty))
    let stored'= M.insert id ws stored
    setSessionData . Medit $ stored'


addEdited id w= do
    ws <- getEdited1 id
    setEdited id (w:ws)


modifyWidget :: (MonadIO m,Executable m,Typeable a,FormInput v)
           => B.ByteString -> B.ByteString -> View v Identity a -> View v m B.ByteString
modifyWidget selector modifier  w = View $ do
     ws <- getEdited selector
     let n =  length (ws `asTypeOf` [w])
     let key= "widget"++ show selector ++  show n ++ show (typeOf $ typ w)
     let cw = wcached key 0  w
     addEdited selector (key,cw)
     FormElm form _ <-  runView cw
     let elem=  toByteString  $ mconcat form
     return . FormElm [] . Just $   selector <> "." <> modifier <>"('" <> elem <> "');"
     where
     typ :: View v Identity a -> a
     typ = undefined
-- | Return the javascript to be executed on the browser to prepend a widget to the location
-- identified by the selector (the bytestring parameter), The selector must have the form of a jquery expression
-- . It stores the added widgets in the edited list, that is accessed with 'getEdited'
--
-- The resulting string can be executed in the browser. 'ajax' will return the code to
-- execute the complete ajax roundtrip. This code returned by ajax must be in an eventhabdler.
--
-- This example  will insert a widget in the div  when the element with identifier
-- /clickelem/  is clicked. when the form is sbmitted, the widget values are returned
-- and the list of edited widgets are deleted.
--
-- >    id1<- genNewId
-- >    let sel= "$('#" <>  B.pack id1 <> "')"
-- >    callAjax <- ajax . const $ prependWidget sel wn
-- >    let installevents= "$(document).ready(function(){\
-- >              \$('#clickelem').click(function(){"++callAjax "''"++"});})"
-- >
-- >    requires [JScriptFile jqueryScript [installevents] ]
-- >    ws <- getEdited sel
-- >    r <-  (div <<< manyOf ws) <! [("id",id1)]
-- >    delEdited sel ws'
-- >    return  r

prependWidget
  :: (Typeable a, MonadIO m, Executable m, FormInput v)
  => B.ByteString           -- ^ jquery selector
  -> View v Identity a      -- ^ widget to prepend
  -> View v m B.ByteString  -- ^ string returned with the jquery string to be executed in the browser
prependWidget sel w= modifyWidget sel "prepend" w

-- | Like 'prependWidget' but append the widget instead of prepend.
appendWidget
  :: (Typeable a, MonadIO m, Executable m, FormInput v) =>
     B.ByteString -> View v Identity a -> View v m B.ByteString
appendWidget sel w= modifyWidget sel "append" w

-- | L  ike 'prependWidget' but set the entire content of the selector instead of prepending an element
setWidget
  :: (Typeable a, MonadIO m, Executable m, FormInput v) =>
     B.ByteString -> View v Identity a -> View v m B.ByteString
setWidget sel w= modifyWidget sel "html" w


-- | Inside a tag, it add and delete widgets of the same type. When the form is submitted
-- or a wlink is pressed, this widget return the list of validated widgets.
-- the event for adding a new widget is attached , as a click event to the element of the page with the identifier /wEditListAdd/
-- that the user will choose.
--
-- This example add or delete editable text boxes, with two initial boxes   with
-- /hi/, /how are you/ as values. Tt uses blaze-html:
--

-- >  r <-  ask  $   addLink
-- >              ++> br
-- >              ++> (El.div `wEditList`  getString1 $  ["hi", "how are you"]) "addid"
-- >              <++ br
-- >              <** submitButton "send"
-- >
-- >  ask $   p << (show r ++ " returned")
-- >      ++> wlink () (p << text " back to menu")
-- >  mainmenu
-- >  where
-- >  addLink = a ! At.id  "addid"
-- >              ! href "#"
-- >              $ text "add"
-- >  delBox  =  input ! type_   "checkbox"
-- >                   ! checked ""
-- >                   ! onclick "this.parentNode.parentNode.removeChild(this.parentNode)"
-- >  getString1 mx= El.div  <<< delBox ++> getString  mx <++ br

wEditList :: (Typeable a,Read a
             ,FormInput view
             ,Functor m,MonadIO m, Executable m)
          => (view ->view)     -- ^ The holder tag
          -> (Maybe String -> View view Identity a) -- ^ the contained widget, initialized  by a string
          -> [String]          -- ^ The initial list of values.
          -> String            -- ^ The id of the button or link that will create a new list element when clicked
          -> View view m  [a]
wEditList holderview w xs addId = do
    let ws=  map (w . Just) xs
        wn=  w Nothing
    id1<- genNewId
    let sel= "$('#" <>  B.pack id1 <> "')"
    callAjax <- ajax . const $ prependWidget sel wn
    let installevents= "$(document).ready(function(){\
              \$('#"++addId++"').click(function(){"++callAjax "''"++"});})"

    requires [JScriptFile jqueryScript [installevents] ]

    ws' <- getEdited sel

    r <-  (holderview  <<< (manyOf $ ws' ++ map changeMonad ws)) <! [("id",id1)]
    delEdited sel ws'
    return r

--wpush
--  :: (Typeable a,
--      FormInput v) =>
--     (v -> v)
--     -> String
--     -> String
--     -> String
--     -> (String -> View v IO a)
--     -> View v IO a
--wpush  holder modifier addId expr w = do
--    id1 <- genNewId
--    let sel= "$('#" <>  B.pack id1 <> "')"
--    callAjax <- ajax $ \s ->  appendWidget sel ( changeMonad $ w s)
--    let installevents= "$(document).ready(function(){\
--              \$('#"++addId++"').click(function(){"++callAjax expr ++ "});})"
--
--    requires [JScriptFile jqueryScript [installevents] ]
--
--    ws <- getEdited sel
--
--    r <-  holder  <<< firstOf ws  <! [("id",id1)]
--    delEdited sel ws
--    return r



-- | Present the JQuery autocompletion list, from a procedure defined by the programmer, to a text box.
wautocomplete
  :: (Show a, MonadIO m, FormInput v)
  => Maybe String       -- ^ Initial value
  -> (String -> IO a)   -- ^ Autocompletion procedure: will receive a prefix and return a list of strings
  -> View v m String
wautocomplete mv autocomplete  = do
    ajaxc <- ajax $ \u -> do
                          r <- liftIO $ autocomplete u
                          return $ jaddtoautocomp r


    requires [JScriptFile jqueryScript [] -- [events]
             ,CSSFile jqueryCSS
             ,JScriptFile jqueryUI []]


    getString mv <!  [("type", "text")
                     ,("id", "text1")
                     ,("oninput",ajaxc "$('#text1').attr('value')" )
                     ,("autocomplete", "off")]


    where
    jaddtoautocomp us= "$('#text1').autocomplete({ source: " <> B.pack( show us) <> "  });"


-- | Produces a text box. It gives a autocompletion list to the textbox. When return
-- is pressed in the textbox, the box content is used to create a widget of a kind defined
-- by the user, which will be situated above of the textbox. When submitted, the result of this widget is the content
-- of the created widgets (the validated ones).
--
-- 'wautocompleteList' is an specialization of this widget, where
-- the widget parameter is fixed, with a checkbox that delete the eleement when unselected
-- . This fixed widget is as such (using generic 'FormElem' class tags):
--
-- > ftag "div"    <<< ftag "input" mempty
-- >                               `attrs` [("type","checkbox")
-- >                                       ,("checked","")
-- >                                       ,("onclick","this.parentNode.parentNode.removeChild(this.parentNode)")]
-- >               ++> ftag "span" (fromStr $ fromJust x )
-- >               ++> whidden( fromJust x)
wautocompleteEdit
    :: (Typeable a, MonadIO m,Functor m, Executable m
     , FormInput v)
    => String                                 -- ^ the initial text of the box
    -> (String -> IO [String])                -- ^ the autocompletion procedure: receives a prefix, return a list of options.
    -> (Maybe String  -> View v Identity a)   -- ^ the widget to add, initialized with the string entered in the box
    -> [String]                               -- ^ initial set of values
    -> View v m [a]                           -- ^ resulting widget
wautocompleteEdit phold   autocomplete  elem values= do
    id1 <- genNewId
    let sel= "$('#" <> B.pack id1 <> "')"
    ajaxc <- ajax $ \(c:u) ->
              case c of
                'f' -> prependWidget sel (elem $ Just u)
                _   -> do
                          r <- liftIO $ autocomplete u
                          return $ jaddtoautocomp r


    requires [JScriptFile jqueryScript [events ajaxc] -- [events]
             ,CSSFile jqueryCSS
             ,JScriptFile jqueryUI []]

    ws' <- getEdited sel

    r<- (ftag "div" mempty  `attrs` [("id",  id1)]
      ++> manyOf (ws' ++ (map (changeMonad . elem . Just) values)))
      <++ ftag "input" mempty
             `attrs` [("type", "text")
                     ,("id", "text1")
                     ,("placeholder", phold)
                     ,("oninput",ajaxc "'n'+$('#text1').attr('value')" )
                     ,("autocomplete", "off")]
    delEdited sel ws'
    return r
    where
    events ajaxc=
         "$(document).ready(function(){   \
         \  $('#text1').keydown(function(){ \
         \   if(event.keyCode == 13){  \
             \   var v= $('#text1').attr('value'); \
             \   if(event.preventDefault) event.preventDefault();\
             \   else if(event.returnValue) event.returnValue = false;" ++
                 ajaxc "'f'+v"++";"++
             "   $('#text1').val('');\
         \  }\
         \ });\
         \});"

    jaddtoautocomp us= "$('#text1').autocomplete({ source: " <> B.pack( show us) <> "  });"

-- | A specialization of 'selectAutocompleteEdit' which make appear each option choosen with
-- a checkbox that deletes the element when uncheched. The result, when submitted, is the list of selected elements.
wautocompleteList
  :: (Functor m, MonadIO m, Executable m, FormInput v) =>
     String -> (String -> IO [String]) -> [String] -> View v m [String]
wautocompleteList phold serverproc values=
 wautocompleteEdit phold serverproc  wrender1 values
 where
 wrender1 x= ftag "div"    <<< ftag "input" mempty
                                `attrs` [("type","checkbox")
                                        ,("checked","")
                                        ,("onclick","this.parentNode.parentNode.removeChild(this.parentNode)")]
                           ++> ftag "span" (fromStr $ fromJust x )
                           ++> whidden( fromJust x)

------- Templating and localization ---------

writetField    k s=  atomically $ writetFieldSTM k s

writetFieldSTM k s=  do
             phold <- readDBRef tFields `onNothing` return (M.fromList [])
             let r= M.insert k  (toByteString s) phold
             writeDBRef tFields   r

readtField text k= atomically $ do
       hs<- readDBRef tFields `onNothing` return (M.fromList [])
       let mp=  M.lookup k hs
       case mp of
         Just c  -> return   $ fromStrNoEncode $ B.unpack c
         Nothing -> writetFieldSTM k  text >> return  text

type TFields  = M.Map String B.ByteString
instance Indexable TFields where
    key _= "texts"
    defPath _= "texts/"

tFields :: DBRef TFields
tFields =  getDBRef "texts"

type Key= String

-- | A widget that display the content of an  html, But if logged as administrator,
-- it permits to edit it in place. So the editor could see the final appearance
-- of what he write in the page.
--
-- When the administrator double click in the paragraph, the content is saved and
-- identified by the key. Then, from now on, all the users will see the saved
-- content instead of the code content.
--
-- The content is saved in a file by default (/texts/ in this versions), but there is
-- a configurable version (`tFieldGen`). The content of the element and the formatting
-- is cached in memory, so the display is, theoretically, very fast.
--
-- THis is an example of how to use the content management primitives (in demos.blaze.hs):
--
-- > textEdit= do
-- >   setHeader $ \t -> html << body << t
-- >
-- >   let first=  p << i <<
-- >                  (El.span << text "this is a page with"
-- >                  <> b << text " two " <> El.span << text "paragraphs")
-- >
-- >       second= p << i << text "This is the original text of the second paragraph"
-- >
-- >       pageEditable =  (tFieldEd "first"  first)
-- >                   **> (tFieldEd "second" second)
-- >
-- >   ask $   first
-- >       ++> second
-- >       ++> wlink () (p << text "click here to edit it")
-- >
-- >   ask $ p << text "Please login with admin/admin to edit it"
-- >           ++> userWidget (Just "admin") userLogin
-- >
-- >   ask $   p << text "now you can click the field and edit them"
-- >       ++> p << b << text "to save the edited field, double click on it"
-- >       ++> pageEditable
-- >       **> wlink () (p << text "click here to see it as a normal user")
-- >
-- >   logout
-- >
-- >   ask $   p << text "the user sees the edited content. He can not edit"
-- >       ++> pageEditable
-- >       **> wlink () (p << text "click to continue")
-- >
-- >   ask $   p << text "When text are fixed,the edit facility and the original texts can be removed. The content is indexed by the field key"
-- >       ++> tField "first"
-- >       **> tField "second"
-- >       **> p << text "End of edit field demo" ++> wlink () (p << text "click here to go to menu")
tFieldEd
  :: (Functor m,  MonadIO m, Executable m,
      FormInput v) =>
      Key -> v -> View v m ()
tFieldEd  k text=
   tFieldGen k  (readtField text) writetField


-- | Like 'tFieldEd' with user-configurable storage.
tFieldGen :: (MonadIO m,Functor m, Executable m
        ,FormInput v)
        => Key
        -> (Key -> IO  v)  -- ^ the read procedure, user defined
        -> (Key ->v  -> IO())   -- ^ the write procedure, user defiend
        -> View v m ()
tFieldGen  k  getcontent create =   wfreeze k 0 $ do
    content <- liftIO $ getcontent  k
    admin   <- getAdminName
    ajaxjs  <- ajax  $ \str -> do
              let (k,s)= break (==',')    str  -- !> str
              liftIO  . create  k  $ fromStrNoEncode (tail s)
              liftIO $ flushCached k
              return "alert('saved')"
    attribs <- do
            name <- genNewId
            -- Need to check the user in the browser because the widget is wfreeze'd
            let ifUserAdmin= "if(document.cookie.search('"++cookieuser++"="++admin++"') != -1)"
                nikeditor= "var myNicEditor = new nicEditor();"
                callback=ifUserAdmin ++
                  "bkLib.onDomLoaded(function() {\
                     \    myNicEditor.addInstance('"++name++"');\
                     \});"
                param= ("'"++k  ++ "'+','+ document.getElementById('"++name++"').innerHTML")

            requires  [JScriptFile "http://js.nicedit.com/nicEdit-latest.js" [nikeditor, callback]]

            return [("id", name),("ondblclick",  ifUserAdmin ++ ajaxjs param)]

    wraw $  (ftag "span" content `attrs` attribs)

-- | Read the field value and present it without edition.
tField :: (MonadIO m,Functor m, Executable m
       ,  FormInput v)
       => Key
       -> View v m ()
tField  k    =  wfreeze k 0 $ do
    content <-  liftIO $ readtField (fromStrNoEncode "not found")  k
    wraw content

-- | A multilanguage version of tFieldEd. For a field with @key@ it add a suffix with the
-- two characters of the language used.
mFieldEd k content= do
  lang <- getLang
  tFieldEd (k ++ ('-':lang)) content

-- | A multilanguage version of tField
mField k= do
  lang <- getLang
  tField $ k ++ ('-':lang)

-- | present the JQuery datepicker calendar to choose a date.
-- The second parameter is the configuration. Use \"()\" by default.
-- See http://jqueryui.com/datepicker/
datePicker :: (Monad m, FormInput v) => String -> Maybe String -> View v m (Int,Int,Int)
datePicker conf jd= do
    id <- genNewId
    let setit= "$(document).ready(function() {\
                   \$( '#"++id++"' ).datepicker "++ conf ++";\
                \});"

    requires
      [CSSFile      jqueryCSS
      ,JScriptFile  jqueryScript []
      ,JScriptFile  jqueryUI [setit]]

    s <- getString jd <! [("id",id)]
    let (month,r) = span (/='/')  s
    let (day,r2)= span(/='/') $ tail r
    return (read day,read month, read $ tail r2)

-- | present a jQuery dialog with a widget. When a button is pressed it return the result.
-- The first parameter is the configuration. To make it modal,  use \"({modal: true})\" see  "http://jqueryui.com/dialog/" for
-- the available configurations.
--
-- As in the case of 'autoRefresh' the enclosed widget will be wrapped within a form tag if the user do not encloses it using wform.

wdialog :: (Monad m, FormInput v) => String -> String -> View v m a -> View v m a
wdialog conf title w= do
    id <- genNewId
    let setit= "$(document).ready(function() {\n\
                   \$('#"++id++"').dialog "++ conf ++";\n\
                   \var idform= $('#"++id++" form');\n\
                   \idform.submit(function(){$(this).dialog(\"close\")})\n\
                \});"

    modify $ \st -> st{needForm= False}
    requires
      [CSSFile      jqueryCSS
      ,JScriptFile  jqueryScript []
      ,JScriptFile  jqueryUI [setit]]

    (ftag "div" <<< insertForm w) <! [("id",id),("title", title)]



insertForm w=View $ do
    FormElm forms mx <- runView w
    st <- get


    cont <- case needForm st of
                      True ->  do
                               frm <- formPrefix (mfPIndex st) (twfname $ mfToken st ) st forms False
                               return   frm
                      _    ->  return $ mconcat  forms
    put st{needForm= False}
    return $ FormElm [cont] mx



-- | Capture the form submissions and the links of the enclosed widget and send them via jQuery AJAX.
-- The response is the new presentation of the widget, that is updated. No new page is generated
-- but the functionality is equivalent. Only the activated widget is executed in the server and updated
-- in the client, so a widget with autoRefresh can be used in heavyweight pages.
-- If AJAX/JavaScript are not available, the widget is refreshed normally, via a new page.
-- If has form elements, the enclosed widget must be a complete form and it must include the form action tag.
-- For this purpose, autoRefresh encloses the widget in a form tag if there are form elements on it
-- and the programmer has not enclosed them in a 'wform' element.
autoRefresh
  :: (MonadIO m,
     FormInput v)
  => View v m a
  -> View v m a
autoRefresh w=  update "html" w

-- | does the same than autoRefresh but append the result of each request to the bottom of the widget
appendUpdate  :: (MonadIO m,
     FormInput v)
  => View v m a
  -> View v m a
appendUpdate= update "append"

-- | does the same than autoRefresh but prepend the result of each request before the current widget content
prependUpdate   :: (MonadIO m,
     FormInput v)
  => View v m a
  -> View v m a
prependUpdate= update "prepend"

update method w= do
    id <- genNewId
    st <- get
    let t = mfkillTime st -1

    let installscript=
            "$(document).ready(function(){\n"
               ++ "ajaxGetLink('"++id++"');"
               ++ "ajaxPostForm('"++id++"');"
               ++ "})\n"

    r <- getParam1 ("auto"++id) $ mfEnv st           -- !> ("TIMEOUT="++ show t)
    case r of
      NoParam -> do
         requires [JScript $ timeoutscript t
                  ,JScript ajaxGetLink
                  ,JScript ajaxPostForm
                  ,JScriptFile jqueryScript [installscript]]
         (ftag "div" <<< insertForm w) <! [("id",id)] 

      Validated (x :: String) -> View $ do
         let t= mfToken st
         FormElm form mr <- runView $ insertForm w
         st <- get
         let HttpData ctype c s= toHttpData $ mconcat form
         liftIO . sendFlush t $ HttpData (ctype ++ ("Cache-Control", "no-cache, no-store"):mfHttpHeaders st) (mfCookies st ++ c) s
         put st{mfAutorefresh=True}
         return $ FormElm [] mr

  where

  timeoutscript t=
     "\nvar hadtimeout=false;\n\
     \setTimeout(function() {hadtimeout=true; }, "++show (t*1000)++");\n"

  -- | adapted from http://www.codeproject.com/Articles/341151/Simple-AJAX-POST-Form-and-AJAX-Fetch-Link-to-Modal
  ajaxGetLink = "function ajaxGetLink(id){\n\
    \var id1= $('#'+id);\n\
    \var ida= $('#'+id+' a');\n\
    \ida.click(function () {\n\
    \if (hadtimeout == true) return true;\n\
    \var pdata = $(this).attr('data-value');\n\
    \var actionurl = $(this).attr('href');\n\
    \var dialogOpts = {\n\
    \       type: 'GET',\n\
    \       url: actionurl+'?bustcache='+ new Date().getTime()+'&auto'+id+'=true',\n\
    \       data: pdata,\n\
    \       success: function (resp) {\n\
    \         id1."++method++"(resp);\n\
    \         ajaxGetLink(id)\n\
    \       },\n\
    \       error: function (xhr, status, error) {\n\
    \           var msg = $('<div>' + xhr + '</div>');\n\
    \           id1.html(msg);\n\
    \       }\n\
    \   };\n\
    \$.ajax(dialogOpts);\n\
    \return false;\n\
    \});\n\
  \}"

  ajaxPostForm = "function ajaxPostForm(id) {\n\
    \var id1= $('#'+id);\n\
    \var idform= $('#'+id+' form');\n\
    \idform.submit(function (event) {\n\
        \if (hadtimeout == true) return true;\n\
        \event.preventDefault();\n\
        \var $form = $(this);\n\
        \var url = $form.attr('action');\n\
        \var pdata = $form.serialize();\n\
        \$.ajax({\n\
            \type: 'GET',\n\
            \url: url,\n\
            \data: 'auto'+id+'=true&'+pdata,\n\
            \success: function (resp) {\n\
                \id1."++method++"(resp);\n\
                \ajaxPostForm(id)\n\
            \},\n\
            \error: function (xhr, status, error) {\n\
                \var msg = $('<div>' + xhr + '</div>');\n\
                \id1.html(msg);\n\
            \}\n\
        \});\n\
       \});\n\
      \return false;\n\
     \}"

data UpdateMethod= Append | Prepend | Html deriving Show

-- | continously execute a widget and update the content.
-- The update method specify how the update is done. 'Html' means a substitution of content.
-- The second parameter is the delay for the next retry in case of disconnection, in milliseconds.
--
-- It can be used to show data updates in the server. The widget is executed in a different process than
--  the one of the rest of the page. Although the process is initiated with the session context,
-- updates in the session context are not seen by the push widget
-- To communicate with te widget, use DBRef's or TVar and the
-- STM semantics for waiting updates using 'retry'.
--
-- Widgets in a push can have links and forms, but since they are asunchonous, they can not
-- return validated inputs. but they can modify the server state.
-- push ever return invalid to the calling widget, so it never
-- triggers the advance of the navigation.
--
--
-- This example is a counter increased each second:
--
-- > pushIncrease= do
-- >   tv <- liftIO $ newTVarIO 0
-- >   page $ push 0 Html $ do
-- >       n <- atomic $ readTVar tv
-- >       atomic $ writeTVar tv $ n + 1
-- >       liftIO $ threadDelay 1000000
-- >       b << (show n) ++> noWidget
--
--
-- This other  simulates a console output that echoes what is entered in a text box
-- below. It has two widgets: a push output in append mode and a text box input.
-- The communication it uses a TVar. The push widget wait for updates in the TVar.
-- because the second widget uses autoRefresh, all happens in the same page.
--
-- It is recommended to add a timeout to the push widget, like in the example:
--
-- >  pushSample=  do
-- >   tv <- liftIO $ newTVarIO $ Just "init"
-- >   page $ push Append 1000 (disp tv) <** input tv
-- >
-- >   where
-- >   disp tv= do
-- >       setTimeouts 100 0
-- >       line <- tget tv
-- >       p <<  line ++> noWidget
-- >
-- >   input tv= autoRefresh $ do
-- >       line <- getString Nothing <** submitButton "Enter"
-- >       tput tv line
-- >
-- >   tput tv x = atomic $ writeTVar  tv ( Just x)  !> "WRITE"
-- >
-- >   tget tv= atomic $ do
-- >       mr <- readTVar tv
-- >       case mr of
-- >          Nothing -> retry
-- >          Just r -> do
-- >           writeTVar tv Nothing
-- >           return r

push :: FormInput v
  => UpdateMethod
  -> Int
  -> View v IO ()
  -> View v IO ()
push method' wait w= push' . map toLower $ show method'
 where
 push' method= do
    id <- genNewId
    st <- get
    let token= mfToken st
        dat= mfData st
        procname= "_push" ++ tind token ++ id
        installscript=
            "$(document).ready(function(){\n"
               ++ "ajaxPush('"++id++"',"++show wait++");"
               ++ "})\n"

    new <- gets newAsk

    when new  $ do
        killWF procname token{twfname= procname}
        let proc= transient . runFlow . ask $ w' dat
        requires [ServerProc (procname, proc),
                  JScript $ ajaxPush procname,
                  JScriptFile jqueryScript [installscript]]



    (ftag "div" <<< noWidget) <! [("id",id)]
      <++ ftag "div" mempty `attrs` [("id",id++"status")]

   where
   w' dat= do
     modify $ \s -> s{inSync= True,newAsk=True,mfData=dat}
     w


   ajaxPush procname=" function ajaxPush(id,waititime){\n\
    \var cnt=0; \n\
    \var id1= $('#'+id);\n\
    \var idstatus= $('#'+id+'status');\n\
    \var ida= $('#'+id+' a');\n\
    \   var actionurl='/"++procname++"';\n\
    \   var dialogOpts = {\n\
    \       cache: false,\n\
    \       type: 'GET',\n\
    \       url: actionurl,\n\
    \       data: '',\n\
    \       success: function (resp) {\n\
    \         idstatus.html('')\n\
    \         cnt=0;\n\
    \         id1."++method++"(resp);\n\
    \         ajaxPush1();\n\
    \       },\n\
    \       error: function (xhr, status, error) {\n\
    \            cnt= cnt + 1;\n\
    \            if (cnt > 6)\n\
    \               idstatus.html('no more retries');\n\
    \            else {\n\
    \               idstatus.html('waiting');\n\
    \               setTimeout(function() { idstatus.html('retrying');ajaxPush1(); }, waititime);\n\
    \            }\n\
    \       }\n\
    \   };\n\
    \function ajaxPush1(){\n\
    \   $.ajax(dialogOpts);\n\
    \   return false;\n\
    \ }\n\
    \ ajaxPush1();\n\
  \}"

-- | show the jQuery spinner widget. the first parameter is the configuration . Use \"()\" by default.
-- See http://jqueryui.com/spinner
getSpinner
  :: (MonadIO m, Read a,Show a, Typeable a, FormInput view) =>
     String -> Maybe a -> View view m a
getSpinner conf mv= do
    id <- genNewId
    let setit=   "$(document).ready(function() {\n\
                 \var spinner = $( '#"++id++"' ).spinner "++conf++";\n\
                 \spinner.spinner( \"enable\" );\n\
                 \});"
    requires
      [CSSFile      jqueryCSS
      ,JScriptFile  jqueryScript []
      ,JScriptFile  jqueryUI [setit]]

    getTextBox mv <! [("id",id)]