{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedLists #-}

module Handler.List where

import Import

import Data.Set (Set)
import qualified Data.Set as Set

import Data.Map (Map)
import qualified Data.Map as Map

import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy.Text

import Database.Persist.Sql (Single(..), rawSql)

import Thermoprint.Client

list :: Handler (Set (WithType Text))
list = do
  (map (uncurry WithType . bimap unSingle unSingle) -> kinds) <- runDB $ rawSql "select reference.kind, kind.type from reference,kind where (not exists (select * from item where COALESCE(item.expires >= CURRENT_DATE, TRUE) and (item.norm_kind = reference.norm_kind))) and (reference.norm_kind = kind.norm_kind)" []
  return $ Set.fromList kinds

mkPrintout :: Set (WithType Text) -> Printout
mkPrintout list = Printout ps
  where
    ps = Map.foldMapWithKey (fmap (pure . Paragraph . pure . Cooked) . toLines) $ group list
    group = Map.fromListWith (<>) . fmap (\(kind `WithType` t) -> (t, Set.singleton kind)) . Set.toAscList
    toLines t (Set.toAscList -> kinds) = either id Line . text . Lazy.Text.fromStrict . Text.unlines $
      pure t ++ map (" - " <>) kinds

getListR, postListR :: Handler TypedContent
getListR = postListR
postListR = do
  Client{..} <- mkClient' . appThermoprintBase . appSettings <$> getYesod
  let
    formatPrinter (pId@(PrinterId num), pStatus) =
      ("Printer #" <> tshow num <> " – " <> tshow pStatus, pId)
  printers' <- map formatPrinter . Map.toAscList <$> printers
  list <- list

  ((printResult, printView), printEnc) <- runFormPost . renderDivsNoLabels $ do
    pId <- case printers' of
      [(_, pId)] -> pure pId
      _ -> areq (selectFieldList printers') "Printer" . listToMaybe $ map snd printers'
    pure pId

  case printResult of
    FormSuccess pId -> do
      (JobId jId) <- jobCreate (Just pId) $ mkPrintout list
      addMessage "printSuccess" [shamlet|List is printing as job ##{jId}|]
    FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
    _ -> return ()
  
  selectRep $ do
    provideJson $ typeToJSON "item" <$> Set.toAscList list
    provideRep . defaultLayout $
      [whamlet|
              <table .main>
                <tr .sepBelow>
                  <th>Item
                  <th>Type
                $forall WithType item itemType <- Set.toAscList list
                  <tr .color>
                    <td .kind>#{item}
                    <td .type>#{itemType}
                <tr .sepAbove>
                  <td colspan=2>
                    <form method=post action=@{ListR} enctype=#{printEnc}>
                      ^{printView}
                      <button type=submit :Set.null list:disabled>
                        Print
              |]