module Handler.List where

import Import

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

import qualified Data.Map as Map

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

#ifdef THERMOPRINT
import Thermoprint.Client

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
#endif

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'


#ifdef THERMOPRINT
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")
#else
getListR, postListR :: Handler TypedContent
getListR = postListR
postListR = do
  list <- list
  selectRep $ do
    provideJson $ typeToJSON "item" <$> Set.toAscList list
    provideRep $ defaultLayout $(widgetFile "list-no-thermoprint")
#endif