{-# 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 = runDB $ do
  today <- liftIO $ utctDay <$> getCurrentTime
  
  items <- map entityVal <$> selectList [] []
  references <- Set.fromList <$> (withTypes . fmap entityVal =<< selectList [] [])

  let
    references' = Set.filter (isNothing . flip find items . matches) references
    matches (Reference{..} `WithType` _) Item{..}
      | today `isBefore` itemExpires
      , not $ itemRunningLow = itemNormKind == referenceNormKind
      | otherwise = False
      
    isBefore _ DateNever = True
    isBefore _ DateUnknown = False
    isBefore d1 (DateKnown d2) = d1 < d2

  return $ Set.map (fmap referenceKind) references'

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
              |]