{-# LANGUAGE  DeriveDataTypeable #-}
import Haste.HPlay.View
import Haste.HPlay.Cell
import Haste.Perch
import Haste
import Haste.LocalStorage
import Control.Applicative
import Prelude hiding (div,span,id,all)
import Data.Typeable
import Control.Monad(when)
import Control.Monad.IO.Class
import qualified Data.IntMap as M
import Data.Monoid
import Haste.Serialize
import Haste.JSON (JSON(..))



data Status= Completed | Active deriving (Show,Eq,Read)

type Tasks = M.IntMap  (String,Status)

instance Serialize Status where
  toJSON= Str . toJSString . show
  parseJSON (Str jss)=  return . read  $ fromJSStr jss

data PresentationMode= Mode String deriving Typeable

all= ""
active= "active"
completed= "completed"

main= do
  addHeader $ link ! atr "rel" "stylesheet" ! href "base.css"
  runBody todo

todo ::  Widget ()
todo = do
      section ! id "todoapp" $ do
        nelem "header" ! id "header"
        section ! id "main" $ do
          ul ! id "todo-list"  $ noHtml

        footer ! id "footer"  $ do
          span ! id "todo-count" $ noHtml
          ul ! id "filters" $ noHtml
          span ! id "clear-holder" $ noHtml

      footer ! id "info" $ do
        p "Double-click to edit a todo"
        p $ do
           toElem "Created by "
           a ! href "http://twitter.com/agocorona" $ "Alberto G. Corona"
           p $ do
              toElem "Part of "
              a ! href "http://todomvc.com" $ "TodoMVC"

     ++> header                       --             ++> add HTML to a widget
     **> toggleAll
     **> filters all
     **> itemsLeft
     **> showClearCompleted           --             **> is the *> applicative operator

 where

 itemsLeft= at "todo-count" Insert $ do
    n <- getTasks >>= return . M.size . M.filter ((==) Active . snd) . fst
    wraw $ do strong (show n)
              toElem $ case n of
                1 -> " item left"
                _ -> " items left"

 showClearCompleted= at "clear-holder" Insert $ do
    (tasks,_) <- getTasks
    let n =  M.size . M.filter ((==) Completed . snd)   $ tasks
    when (n >0) $ do
        (button ! id "clear-completed" $ "Clear completed") `pass` OnClick
        setTasks $ M.filter ((==) Active . snd) tasks
        displayFiltered

 filters op =at "filters" Insert $ filters' op

    where
    filters' op= (links op `wake` OnClick)
      `wcallback` (\op' -> do
        setSData $ Mode op'
        displayFiltered **> return ()
        filters' op')

    links op=
        li ! clas op all       <<< wlink all        (toElem "All")     <|>
        li ! clas op active    <<< wlink active     (toElem "Active")  <|>
        li ! clas op completed <<< wlink completed  (toElem "Completed")

    clas current op= atr "class" $ if current== op then "selected" else "unsel"

 header = at "header" Insert $ h1 "todos" ++> newTodo

 toggleAll = at "main" Prepend $ do
    t <- getCheckBoxes $ setCheckBox False "toggle" `wake` OnClick ! atr "class" "toggle-all"
    let newst=  case t of
            [] ->  Active
            _  ->  Completed
    (tasks,_) <- getTasks
    filtered  <- getFiltered tasks
    let filtered' = M.map (\(t,_) -> (t,newst)) filtered
        tasks'    = M.union filtered' tasks
    setTasks tasks'
    displayFiltered
    itemsLeft

 displayFiltered = do
    (tasks,_) <- getTasks
    filtered <- getFiltered tasks
    at "todo-list" Insert $ foldl (<|>) mempty $ reverse
      [display  i | i <- M.keys filtered]
   **> return ()

 getFiltered tasks= do
   Mode todisplay <- getSData <|> return (Mode all)
   return $ M.filter (fil todisplay)  tasks
   where
   fil  f (t,st)
     | f==all=   True
     | f==active = case st of
                         Active -> True
                         _      -> False
     | otherwise = case st of
                         Completed -> True
                         _         -> False


 newTodo= do
      let entry= boxCell "new-todo"
      task <- mk entry Nothing `wake` OnKeyUp
                ! atr "placeholder" "What needs to be done?"
                ! atr "autofocus" ""
      EventData evname evdata <- getEventData
      when( evdata == Key 13) $ do
         entry .= ""
         idtask <- addTask task Active
         Mode m <- getSData <|> return (Mode all)
         when (m /= completed) $ at "todo-list" Prepend $ display idtask
         itemsLeft

 display idtask =
   (li <<< ( toggleActive  **> destroy)) `wcallback` const (delTask idtask)

   where
   toggleActive = do
        Just (task,st) <- getTask idtask
        let checked= case st of Completed -> True; Active -> False
        ch <- getCheckBoxes $ setCheckBox checked "check" `wake` OnClick ! atr "class" "toggle"
        case ch of
          ["check"] -> changeState  idtask Completed task
          _         -> changeState  idtask Active task

   destroy= (button ! atr "class" "destroy" $ noHtml) `pass` OnClick

   changeState  i stat task=
          insertTask i task stat
      **> itemsLeft
      **> showClearCompleted
      **> viewEdit i stat task

   viewEdit idtask st task = do
        let lab= case st of
                 Completed  -> label ! atr "class" "completed"
                 Active     -> label

        lab  task `pass` OnDblClick

     `wcallback` const (do
            ntask <-  inputString (Just task) `wake` OnKeyUp ! atr "class" "edit"
            EventData _ (Key k) <- getEventData
            continueIf (k== 13) ntask

       `wcallback` (\ntask -> do
            insertTask idtask ntask st
            viewEdit idtask st ntask))

-- Model, using LocalStorage

getTasks :: MonadIO m  => m (Tasks, Int)
getTasks= liftIO $ do
    mt <- getItem "tasks"
    case mt of
      Left _ ->   setItem "tasks" (M.toList (M.empty :: Tasks),0 :: Int) >> getTasks
      Right (ts,n) -> return (M.fromList ts, n)

getTask i= liftIO $ do
     (tasks,id) <- getTasks
     return $ M.lookup i tasks

setTasks :: MonadIO m => Tasks -> m ()
setTasks tasks=  liftIO $ do
      (_,n) <- getTasks
      setItem "tasks" (M.toList tasks,n)

addTask :: String -> Status -> Widget Int
addTask task state= liftIO $ do
     (tasks,id) <- getTasks
     let tasks'= M.insert id  (task, state) tasks
     setItem "tasks" (M.toList tasks', id+1)
     return id

insertTask id task state= liftIO $ do
     (tasks,i) <- getTasks
     let tasks'= M.insert  id (task,state) tasks
     setItem "tasks" (M.toList tasks', i)
     return tasks'

delTask i= liftIO $ do
   (tasks,_) <- getTasks
   setTasks $ M.delete i tasks
