{-# LANGUAGE ApplicativeDo #-}

module Handler.Common
  ( inventoryListing
  , itemForm
  , referenceListing
  , referenceForm
  , kinds
  , InventoryState(..)
  , ReferenceState(..)
  , FormState(..)
  , HasFormState(..)
  ) where

import Import

import Data.Unique

import qualified Data.Text as Text (pack)

import Control.Lens

import Handler.Common.Types

dayFormat :: Day -> String
dayFormat = formatTime defaultTimeLocale "%e. %b %y"

itemForm :: Maybe Item -- ^ Update existing item or insert new?
         -> Html -> MForm Handler (FormResult Item, Widget)
itemForm proto identView = do
  today <- utctDay <$> liftIO getCurrentTime
  
  (kindRes, kindWidget) <- kindField $ itemKind <$> proto
  (boughtRes, boughtWidget) <- dayForm (maybe (Just $ Just today) Just $ fmap itemBought proto) "Unknown"
  (expiresRes, expiresWidget) <- dayForm (fmap itemExpires proto) "Never"
  (openedRes, openedWidget) <- dayForm (fmap itemOpened proto) "Never"

  let itemRes = do
        itemKind <- kindRes
        itemBought <- boughtRes
        itemExpires <- expiresRes
        itemOpened <- openedRes
        return Item{ itemNormKind = normalizeKind itemKind, ..}

  return . (itemRes, ) $
    [whamlet|
            $newline never
            #{identView}
            <div .td>^{kindWidget}
            <div .td>^{boughtWidget}
            <div .td>^{expiresWidget}
            <div .td>^{openedWidget}
            |]
  where
    dayForm :: Maybe (Maybe Day) -> String -> MForm Handler (FormResult (Maybe Day), Widget)
    dayForm proto label = do
      today <- utctDay <$> liftIO getCurrentTime

      checkboxId <- ("check" <>) . show . hashUnique <$> liftIO newUnique
      
      (fmap (fromMaybe False) -> isNothingRes, isNothingView) <-
        mopt checkBoxField ("" { fsId = Just $ Text.pack checkboxId }) . Just . Just . fromMaybe True $ fmap isNothing proto
      (dayRes, dayView) <-
        mreq dayField "" . Just . fromMaybe today $ join proto

      let res = (bool Just (const Nothing) <$> isNothingRes) <*> dayRes
      return . (res, ) $ do
        [whamlet|
                $newline never
                <div .table>
                  <div .tr>
                    <label for=#{checkboxId} .checkbox .td>
                      ^{fvInput isNothingView}
                      <span>
                        #{label}
                  <div .tr>
                    <div .td .dayInput>^{fvInput dayView}
                |]

inventoryListing :: InventoryState -> Widget
inventoryListing InventoryState{ invFormState = formState, ..} = $(widgetFile "inventoryListing")

referenceForm :: Maybe Reference -- ^ Update existing item or insert new?
              -> Html -> MForm Handler (FormResult Reference, Widget)
referenceForm proto identView = do
  (kindRes, kindWidget) <- kindField $ referenceKind <$> proto

  let referenceRes = do
        referenceKind <- kindRes
        return Reference{ referenceNormKind = normalizeKind referenceKind, .. }

  return . (referenceRes, ) $
    [whamlet|
            $newline never
            #{identView}
            <div .td>^{kindWidget}
            |]

referenceListing :: ReferenceState -> Widget
referenceListing ReferenceState{ refFormState = formState, ..} = $(widgetFile "referenceListing")

kindField :: Maybe Text -> MForm Handler (FormResult Text, Widget)
kindField proto = do
  optionId <- ("options" <>) . tshow . hashUnique <$> liftIO newUnique

  let
    attrs = [ ("list", optionId)
            , ("autocomplete", "off")
            ]
  
  (kindRes, kindView) <- mreq textField ("" { fsAttrs = attrs }) proto

  options <- lift kinds

  return . (kindRes, ) $
    [whamlet|
            $newline never
            ^{fvInput kindView}
            <datalist ##{optionId}>
              $forall opt <- options
                <option value=#{opt}>
            |]

kinds :: Handler [Text]
kinds = do
  stock <- runDB $ selectList [] []
  reference <- runDB $ selectList [] []

  return $ concat
    [ [ itemKind | Entity _ Item{..} <- stock ]
    , [ referenceKind | Entity _ Reference{..} <- reference ]
    ]