module Handler.Utils.Form.Occurrences
  ( occurrencesAForm
  ) where

import Import
import Handler.Utils.Form
import Handler.Utils.DateTime

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

import Utils.Lens

  
data OccurrenceScheduleKind = ScheduleKindWeekly
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)

instance Universe OccurrenceScheduleKind
instance Finite OccurrenceScheduleKind

nullaryPathPiece ''OccurrenceScheduleKind $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''OccurrenceScheduleKind id

data OccurrenceExceptionKind = ExceptionKindOccur
                             | ExceptionKindNoOccur
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)

instance Universe OccurrenceExceptionKind
instance Finite OccurrenceExceptionKind

nullaryPathPiece ''OccurrenceExceptionKind $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''OccurrenceExceptionKind id


occurrencesAForm :: PathPiece ident => ident -> Maybe Occurrences -> AForm Handler Occurrences
occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
  Just cRoute <- getCurrentRoute
  
  let
    scheduled :: AForm Handler (Set OccurrenceSchedule)
    scheduled = Set.fromList <$> massInputAccumA
      miAdd'
      miCell'
      (\p -> Just . SomeRoute $ cRoute :#: p)
      miLayout'
      (miIdent' <> "__scheduled" :: Text)
      (fslI MsgScheduleRegular & setTooltip MsgMassInputTip)
      False
      (Set.toList . occurrencesScheduled <$> mPrev)
      where
        miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([OccurrenceSchedule] -> FormResult [OccurrenceSchedule])
        miAdd' nudge submitView = over (mapped . mapped . _2) (\addWidget -> $(widgetFile "widgets/occurrence/form/scheduled-add")) . renderAForm FormStandard . wFormToAForm $ do
          newSched <- multiActionW
            (Map.fromList [ ( ScheduleKindWeekly
                            , ScheduleWeekly
                                <$> apreq (selectField optionsFinite) (fslI MsgWeekDay & addName (nudge "occur-week-day")) Nothing
                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
                            )
                          ]
            ) (fslI MsgScheduleRegularKind & addName (nudge "kind")) Nothing
          MsgRenderer mr <- getMsgRenderer
          return $ newSched <&> \newSched' oldScheds -> if
            | newSched' `elem` oldScheds -> FormFailure [mr MsgScheduleExists]
            | otherwise -> FormSuccess $ pure newSched'

        miCell' :: OccurrenceSchedule -> Widget
        miCell' ScheduleWeekly{..} = do
          scheduleStart' <- formatTime SelFormatTime scheduleStart
          scheduleEnd' <- formatTime SelFormatTime scheduleEnd
          $(widgetFile "widgets/occurrence/form/weekly")

        miLayout' :: MassInputLayout ListLength OccurrenceSchedule ()
        miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/occurrence/form/scheduled-layout")

    exceptions :: AForm Handler (Set OccurrenceException)
    exceptions = Set.fromList <$> massInputAccumA
      miAdd'
      miCell'
      (\p -> Just . SomeRoute $ cRoute :#: p)
      miLayout'
      (miIdent' <> "__exceptions" :: Text)
      (fslI MsgScheduleExceptions & setTooltip (UniWorXMessages [SomeMessage MsgScheduleExceptionsTip, SomeMessage MsgMassInputTip]))
      False
      (Set.toList . occurrencesExceptions <$> mPrev)
      where
        miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([OccurrenceException] -> FormResult [OccurrenceException])
        miAdd' nudge submitView = over (mapped . mapped . _2) (\addWidget -> $(widgetFile "widgets/occurrence/form/except-add")) . renderAForm FormStandard . wFormToAForm $ do
          newExc <- multiActionW
            (Map.fromList [ ( ExceptionKindOccur
                            , ExceptOccurr
                                <$> apreq dayField (fslI MsgDay & addName (nudge "occur-day")) Nothing
                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
                            )
                          , ( ExceptionKindNoOccur
                            , ExceptNoOccurr
                                <$> apreq localTimeField (fslI MsgExceptionNoOccurAt & addName (nudge "no-occur-time")) Nothing
                            )
                          ]
            ) (fslI MsgExceptionKind & addName (nudge "kind")) Nothing
          MsgRenderer mr <- getMsgRenderer
          return $ newExc <&> \newExc' oldExcs -> if
            | newExc' `elem` oldExcs -> FormFailure [mr MsgExceptionExists]
            | otherwise -> FormSuccess $ pure newExc'
          

        miCell' :: OccurrenceException -> Widget
        miCell' ExceptOccurr{..} = do
          exceptStart' <- formatTime SelFormatDateTime (LocalTime exceptDay exceptStart)
          exceptEnd'   <- formatTime SelFormatTime     exceptEnd
          $(widgetFile "widgets/occurrence/form/except-occur")
        miCell' ExceptNoOccurr{..} = do
          exceptTime' <- formatTime SelFormatDateTime exceptTime
          $(widgetFile "widgets/occurrence/form/except-no-occur")

        miLayout' :: MassInputLayout ListLength OccurrenceException ()
        miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/occurrence/form/except-layout")

  aFormToWForm $ Occurrences
    <$> scheduled
    <*> exceptions