{-# LANGUAGE ApplicativeDo #-}

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

import Import

import Data.Unique

import qualified Data.Text as Text

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

import Control.Lens

import Handler.Common.Types

import Text.Julius (RawJS(..))

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

itemForm :: Maybe Item -- ^ Update existing item or insert new?
         -> Html -> MForm Handler (FormResult (WithType Item), Widget)
itemForm proto identView = do
  today <- utctDay <$> liftIO getCurrentTime

  t <- lift . runDB $ maybe (return Nothing) (fmap (Just . kindType) . getType) proto
  
  let kt kWidget tWidget =
        [whamlet|
                <div .td>^{kWidget}
                <div .td>^{tWidget}
                |]
  ((kindRes, typeRes), typedKindWidget) <- typedKindField kt ((itemKind <$> proto), t)
  (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
        t <- typeRes
        return $ Item{ itemNormKind = normalizeKind itemKind, ..} `WithType` t

  return . (itemRes, ) $
    [whamlet|
            $newline never
            #{identView}
            ^{typedKindWidget}
            <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 (WithType Reference), Widget)
referenceForm proto identView = do
  t <- lift . runDB $ maybe (return Nothing) (fmap (Just . kindType) . getType) proto
  
  let kt kWidget tWidget =
        [whamlet|
                <div .td>^{kWidget}
                <div .td>^{tWidget}
                |]

  ((kindRes, typeRes), typedKindWidget) <- typedKindField kt ((referenceKind <$> proto), t)

  let referenceRes = do
        referenceKind <- kindRes
        t <- typeRes
        return $ Reference{ referenceNormKind = normalizeKind referenceKind, .. } `WithType` t

  return . (referenceRes, ) $
    [whamlet|
            $newline never
            #{identView}
            ^{typedKindWidget}
            |]

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

typedKindField :: (Widget -> Widget -> Widget) -- ^ `\kindWidget typeWidget -> _`
               -> (Maybe Text, Maybe Text) -- ^ `(kindProto, typeProto)`
               -> MForm Handler ((FormResult Text, FormResult Text), Widget) -- ^ `((kindRes, typeRes), typedKindWidget)`
typedKindField collate (kindProto, typeProto) = do
  tOptionId <- ("options" <>) . tshow . hashUnique <$> liftIO newUnique
  let
    tAttrs = [ ("list", tOptionId)
             , ("autocomplete", "off")
             ]
  kOptionId <- ("options" <>) . tshow . hashUnique <$> liftIO newUnique

  let
    kAttrs = [ ("list", kOptionId)
             , ("autocomplete", "off")
             ]

  (kindRes, kindView) <- mreq textField ("" { fsAttrs = kAttrs }) kindProto
  (typeRes, typeView) <- mreq textField ("" { fsAttrs = tAttrs }) typeProto

  kOptions <- lift kinds
  (Set.fromList . map (kindType . entityVal) -> tOptions) <- lift . runDB $ selectList [] []

  return . ((kindRes, typeRes), ) $ do
    toWidget $
      [julius|
             $(function () {
               $("##{rawJS $ fvId kindView}").change(function () {
                 $.ajax({
                   url: '@{TypeR}',
                   type: 'GET',
                   contentType: 'application/json',
                   data: {
                     kind: $(this).val()
                   },
                   success: function (answer) {
                     $("##{rawJS $ fvId typeView}").val(answer);
                    typeChanged = false;
                    }
                 });
               }) ;
             });
             |]
    let
      kindWidget =
        [whamlet|
                $newline never
                ^{fvInput kindView}
                <datalist ##{kOptionId}>
                  $forall opt <- kOptions
                    <option value=#{opt}>
                |]
      typeWidget =
        [whamlet|
                $newline never
                ^{fvInput typeView}
                <datalist ##{tOptionId}>
                  $forall opt <- tOptions
                    <option value=#{opt}>
                |]
    collate kindWidget typeWidget

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

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

type Sort a = a -> a

stockSort :: Sort [WithType (Entity Item)]
stockSort = concat . map (sortOn $ entityVal . typedVal) . sortGroups . group
  where
    group = groupBy ((==) `on` valType) . sortOn valType
    sortGroups = sortOn (fmap minimum . fromNullable . map (entityVal . typedVal))

referenceSort :: Sort [WithType (Entity Reference)]
referenceSort = sortBy referenceOrdering
  where
    referenceOrdering (Entity _ refA `WithType` refAType) (Entity _ refB `WithType` refBType) = compare refAType refBType <> compare refA refB