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

  let
    formatDraft (dId@(DraftId num), Nothing) =
      ("Draft #" <> tshow num, dId)
    formatDraft (dId@(DraftId num), Just t) =
      (t <> " (" <> tshow num <> ")", dId)
  drafts' <- map formatDraft . Map.toAscList <$> drafts
  
  list <- list

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

  ((oDraftResult, oDraftView), oDraftEnc) <- runFormPost . identifyForm "oldDraft" . renderDivsNoLabels
    $ areq (selectFieldList drafts') "Draft" Nothing

  ((nDraftResult, nDraftView), nDraftEnc) <- runFormPost . identifyForm "newDraft" . renderDivsNoLabels
    $ areq textField "Title" Nothing

  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 ()

  case oDraftResult of
    FormSuccess dId@(DraftId num) -> do
      (t, printout) <- draft dId 
      let t' = fromMaybe "" t
      draftReplace dId t $ printout `mappend` mkPrintout list
      addMessage "appendSuccess" [shamlet|Appended shopping list to ‘#{t'}’ (#{num})|]
    FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
    _ -> return ()

  case nDraftResult of
    FormSuccess (Text.strip -> t) -> do
      let t' = t <$ guard (not $ Text.null t)
      (DraftId num) <- draftCreate t' $ mkPrintout list
      addMessage "saveSuccess" [shamlet|Saved shopping list as ‘#{t}’ (#{num})|]
    FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
    _ -> return ()
  
  selectRep $ do
    provideJson $ typeToJSON "item" <$> Set.toAscList list
    provideRep $ defaultLayout $(widgetFile "list")