module Handler.Utils.Form.Occurences
  ( occurencesAForm
  ) where

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

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

import Utils.Lens

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

instance Universe OccurenceScheduleKind
instance Finite OccurenceScheduleKind

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

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

instance Universe OccurenceExceptionKind
instance Finite OccurenceExceptionKind

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


occurencesAForm :: PathPiece ident => ident -> Maybe Occurences -> AForm Handler Occurences
occurencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
  Just cRoute <- getCurrentRoute
  
  let
    scheduled :: AForm Handler (Set OccurenceSchedule)
    scheduled = Set.fromList <$> massInputAccumA
      miAdd'
      miCell'
      (\p -> Just . SomeRoute $ cRoute :#: p)
      miLayout'
      (miIdent' <> "__scheduled" :: Text)
      (fslI MsgScheduleRegular & setTooltip MsgMassInputTip)
      False
      (Set.toList . occurencesScheduled <$> mPrev)
      where
        miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([OccurenceSchedule] -> FormResult [OccurenceSchedule])
        miAdd' nudge submitView = over (mapped . mapped . _2) (\addWidget -> $(widgetFile "widgets/occurence/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 MsgOccurenceStart & addName (nudge "occur-start")) Nothing
                                <*> apreq timeFieldTypeTime (fslI MsgOccurenceEnd & 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' :: OccurenceSchedule -> Widget
        miCell' ScheduleWeekly{..} = do
          scheduleStart' <- formatTime SelFormatTime scheduleStart
          scheduleEnd' <- formatTime SelFormatTime scheduleEnd
          $(widgetFile "widgets/occurence/form/weekly")

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

    exceptions :: AForm Handler (Set OccurenceException)
    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 . occurencesExceptions <$> mPrev)
      where
        miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([OccurenceException] -> FormResult [OccurenceException])
        miAdd' nudge submitView = over (mapped . mapped . _2) (\addWidget -> $(widgetFile "widgets/occurence/form/except-add")) . renderAForm FormStandard . wFormToAForm $ do
          newExc <- multiActionW
            (Map.fromList [ ( ExceptionKindOccur
                            , ExceptOccur
                                <$> apreq dayField (fslI MsgDay & addName (nudge "occur-day")) Nothing
                                <*> apreq timeFieldTypeTime (fslI MsgOccurenceStart & addName (nudge "occur-start")) Nothing
                                <*> apreq timeFieldTypeTime (fslI MsgOccurenceEnd & addName (nudge "occur-end")) Nothing
                            )
                          , ( ExceptionKindNoOccur
                            , ExceptNoOccur
                                <$> 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' :: OccurenceException -> Widget
        miCell' ExceptOccur{..} = do
          exceptStart' <- formatTime SelFormatDateTime (LocalTime exceptDay exceptStart)
          exceptEnd'   <- formatTime SelFormatTime     exceptEnd
          $(widgetFile "widgets/occurence/form/except-occur")
        miCell' ExceptNoOccur{..} = do
          exceptTime' <- formatTime SelFormatDateTime exceptTime
          $(widgetFile "widgets/occurence/form/except-no-occur")

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

  aFormToWForm $ Occurences
    <$> scheduled
    <*> exceptions