module Dingo.Widget.DataTables
       ( Table
       , mkTable
       , onTableBodyEvent
       , setTableData
       ) where

import Control.Monad (forM_)
import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))
import Data.Text (Text)
import Data.Typeable (Typeable)
import Dingo.Callback
import Dingo.Event
import Dingo.ResourceBundle.JqueryUI (jqueryUIResourceBundle)
import Dingo.ResourceBundle.DataTables (dataTablesResourceBundle)
import Dingo.Selector
import Dingo.Widget
import Text.Blaze ((!), toValue, toHtml)
import Text.Julius (julius)
import qualified Text.Blaze.Html4.Strict as H
import qualified Text.Blaze.Html4.Strict.Attributes as A

-- Table type.
data Table = Table { tableId :: WidgetId
                   , tableHeadings :: [Text]
                   , tableData :: [[Text]]
                   }
            deriving (Show, Typeable)

-- State associated with table widget.
data TableState = TableState ()
                deriving (Show, Typeable)

instance FromJSON TableState where
  parseJSON _ = return $ TableState ()

instance ToJSON TableState where
  toJSON (TableState ()) = Null

-- Table is a widget.
instance Widget Table TableState where
  -- Get the widget ID.
  getWidgetId = tableId
  -- Render table to HTML.
  renderWidget w =
    H.table ! A.id (toValue $ tableId w) $ do
      H.thead $ do
        H.tr $ do
          mapM_ (H.th ! A.width (toValue aWidth)) $ map toHtml $ tableHeadings w
      H.tbody $ do
        forM_ (tableData w) $ \rowData ->
          H.tr $ do
            mapM_ H.td $ map toHtml $ rowData
    where
      aWidth :: Int
      aWidth = 150
  -- Show widget.
  showWidget w s =
    show w ++ "->" ++ show s
  -- Client state handling.
  encodeClientStateJs _ =
    [julius| null |]
  decodeClientStateJs _ =
    [julius| null |]

  widgetResources _ =
    [ jqueryUIResourceBundle, dataTablesResourceBundle ]

-- Make a new table.
mkTable :: Widget w s => w -> [Text] -> [[Text]] -> CallbackM Table
mkTable pw headings data_ = do
  table <- addWidget pw (\i -> return (Table i headings data_, TableState ()))
  sendJavascript
    [julius| $(document).ready(function () {
        $('#i#{getWidgetId table}').dataTable({
              "bJQueryUI" : true,
              "sPaginationType" : "full_numbers"
        });
      }); |]
  return table

-- Change value in a table cell.
setTableData :: Table -> (Integer,Integer) -> Text -> CallbackM ()
setTableData table (row,col) data_ =
  sendJavascript
    [julius| $('#i#{getWidgetId table}').dataTable().fnUpdate('#{data_}', #{show row}, #{show col}); |]

-- Set up event handler.
onTableBodyEvent :: Table -> Event -> CallbackM () -> CallbackM ()
onTableBodyEvent table event callback =
  onEvent (tableRowsSelector table) event callback
  where
    tableRowsSelector :: Table -> Selector
    tableRowsSelector w =
      widgetSelector w .>*. element "tbody" .>*. element "tr"