{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}

module Handler.Utils.Table where
-- General Utilities for Tables

import Import hiding  ((<>))
-- import Data.Monoid ((<>))
import Data.Profunctor

import Control.Monad.Except

import Text.Blaze as B

import Colonnade
import Yesod.Colonnade

import Data.List ((!!))
import Data.Either


-- Table design
tableDefault :: Attribute
tableDefault = customAttribute "class" "table table-striped table-hover"

tableSortable :: Attribute
tableSortable = customAttribute "class" "js-sortable"

-- Colonnade Tools
numberColonnade :: (IsString c) => Colonnade Headed Int c
numberColonnade = headed "Nr" (fromString.show)

pairColonnade :: (Functor h) =>  Colonnade h a c -> Colonnade h b c ->  Colonnade h (a,b) c
pairColonnade a b = mconcat [ lmap fst a, lmap snd b]


-- Table Modification
encodeHeadedWidgetTableNumbered :: Attribute -> Colonnade Headed a (WidgetT site IO ()) -> [a] -> WidgetT site IO ()
encodeHeadedWidgetTableNumbered attrs colo tdata =
    encodeWidgetTable attrs (mconcat [numberCol, lmap snd colo]) (zip [1..] tdata)
  where
    numberCol :: Colonnade Headed (Int,a) (WidgetT site IO ())
    numberCol = headed "Nr" (fromString.show.fst)

headedRowSelector :: ( PathPiece b
                     , Eq b
                     )
                  => (a -> Handler b)
                  -> (b -> Handler c)
                  -> Attribute
                  -> Colonnade Headed a (Cell UniWorX)
                  -> [a]
                  -> MForm Handler (FormResult [c], Widget)
headedRowSelector toExternal fromExternal attrs colonnade tdata = do
  externalIds <- mapM (lift . toExternal) tdata

  let
    checkbox extId = Field parse view UrlEncoded
      where
        parse [] _ = return $ Right Nothing
        parse optlist _ = runExceptT $ do
          extIds <- maybe (throwError "Error parsing values") return $ mapM fromPathPiece optlist
          case () of
            _ | extId `elem` extIds
                -> Just <$> (lift $ fromExternal extId)
              | otherwise
                -> return Nothing

        view _ name attributes val _ = do
          [whamlet|
            <label style="display: block">
              <input type=checkbox name=#{name} value=#{toPathPiece extId} *{attributes} :isRight val:checked>
          |]

  selectionIdent <- newFormIdent

  (selectionResults, selectionBoxes) <- fmap unzip . forM externalIds $ \ident -> mopt (checkbox ident) ("" { fsName = Just selectionIdent }) Nothing

  let
    selColonnade :: Colonnade Headed Int (Cell UniWorX)
    selColonnade = headed "Markiert" $ cell . fvInput . (selectionBoxes !!)

    collectResult :: [FormResult a] -> FormResult [a]
    collectResult [] = FormSuccess []
    collectResult (FormFailure errs : _) = FormFailure errs
    collectResult (FormMissing:rs) = collectResult rs
    collectResult (FormSuccess x:rs) = (x :) <$> collectResult rs

  return ( catMaybes <$> collectResult selectionResults
         , encodeCellTable attrs (pairColonnade selColonnade colonnade) (zip [0..] tdata)
         )