{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
module Main where
import MFlow.Wai.XHtml.All
import Data.TCache
import Control.Monad.Trans
import Data.Typeable
import Control.Concurrent
import Control.Exception as E
import qualified Data.ByteString.Char8 as SB

import Debug.Trace
(!>)= flip  trace


data Ops= Ints | Strings | Actions | Ajax | Shop deriving(Typeable,Read, Show)
main= do
   syncWrite SyncManual
   setFilesPath ""
   addFileServerWF
   forkIO $ run 80 $ waiMessageFlow  [("noscript",transient $ runFlow mainf)
                                      ("shop"    ,runFlow shopCart)]
   adminLoop



stdheader c= p << "you can press the back button to go to the menu"+++ c
mainf=   do
       setHeader stdheader
       r <- ask $   wlink Ints (bold << "Ints") <|>
                    br ++> wlink Strings (bold << "Strings") <|>
                    br ++> wlink Actions (bold << "Example of a string widget with an action") <|>
                    br ++> wlink Ajax (bold << "Simple AJAX example")
       case r of
         Ints ->  clickn 0
         Strings ->  clicks "1"
         Actions ->  actions 1
         Ajax    ->  ajaxsample
         Shop    ->  shopCart
       mainf

clickn (n :: Int)= do
   setHeader stdheader
   r <- ask $  wlink "menu" (p << "back")
           |+| getInt (Just n) <* submitButton "submit"
   case r of
    (Just _,_) -> breturn ()
    (_, Just n') -> clickn $ n'+1


clicks s= do
   setHeader stdheader
   s' <- ask $ (getString (Just s)
             <* submitButton "submit")
             `validate` (\s -> return $ if length s   > 5 then Just "length must be < 5" else Nothing )
   clicks $ s'++ "1"


ajaxheader html= thehtml << ajaxHead << p << "click the box" +++ html

ajaxsample= do
   setHeader ajaxheader
   ajaxc <- ajaxCommand    "document.getElementById('text1').value"
                           (\n ->  return $ "document.getElementById('text1').value='"++show(read  n +1)++"'")
   ask $ (getInt (Just 0) <! [("id","text1"),("onclick", ajaxc)])
   breturn()

actions n=do
  ask $ wlink () (p << "exit from action")
     <**((getInt (Just (n+1)) <** submitButton "submit" ) `waction` actions )
  breturn ()


shopCart  = do
   setTimeouts 10 0
   shopCart1 (V.fromList [0,0,0:: Int])
   where
   shopCart1 cart=  do
     i <- step . ask
           $ table ! [border 1,thestyle "width:20%;margin-left:auto;margin-right:auto"]
             <<< caption << "choose an item"
             ++> thead << tr << concatHtml[ th << bold << "item", th << bold << "times chosen"]
             ++> (tbody
                  <<< (tr <<< td <<< wlink  0 (bold <<"iphone") <++  td << ( bold << show ( cart V.! 0))
                  <|>  tr <<< td <<< wlink  1 (bold <<"ipad")   <++  td << ( bold << show ( cart V.! 1))
                  <|>  tr <<< td <<< wlink  2 (bold <<"ipod")   <++  td << ( bold << show ( cart V.! 2)))
                  )
     let newCart= cart V.// [(i, cart V.! i + 1 )]
     shopCart1 newCart