module Handler.Schedule
  ( getScheduleR, postScheduleR
  ) where

import Import

import Handler.Utils.Form
import Handler.Utils.I18n

import Utils.Schedule.Types
import Utils.Schedule.Week


getScheduleR, postScheduleR :: Handler Html
getScheduleR = postScheduleR
postScheduleR = do
  now <- liftIO getCurrentTime
  user@(Entity _uid User{userScheduleView}) <- requireAuth

  -- TODO: local instead of global get params?
  mOptions <- lookupGlobalGetParam GetScheduleOptions

  let
    defaultScheduleOptions :: ScheduleOptions
    defaultScheduleOptions = ScheduleOptions
                             { scheduleView   = userScheduleView
                             , scheduleOffset = ScheduleOffsetNone
                             , scheduleOptionsAction = ScheduleSetDefault
                             }

    currentScheduleOptions :: ScheduleOptions
    currentScheduleOptions = fromMaybe defaultScheduleOptions mOptions

    scheduleOptionsForm :: Html -> MForm (HandlerFor UniWorX) (FormResult ScheduleOptions, Widget)
    scheduleOptionsForm csrf = do
      (viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \sView ->
        mopt (buttonFieldNoParse ScheduleOptions
                                 { scheduleView   = sView
                                 , scheduleOffset = ScheduleOffsetNone
                                 , scheduleOptionsAction = ScheduleSetView
                                 })
             ("" { fsName  = Just $ toPathPiece GetScheduleOptions
                 , fsAttrs = if sView == scheduleView currentScheduleOptions then [("disabled","")] else mempty
                 }) Nothing
      viewRes <- if
        | Just errs <- fromNullable (filter (is _FormFailure) viewRess) -> do
          mapM_ formFailure2Alerts errs
          (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs
        | otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> viewRess) of
          [ScheduleOptions{scheduleView=sView}] -> (return . FormSuccess) $ ScheduleOptions
                                                   { scheduleView   = sView
                                                   , scheduleOffset = ScheduleOffsetNone
                                                   , scheduleOptionsAction = ScheduleSetView
                                                   }
          _ -> return $ FormSuccess $ currentScheduleOptions
                                      { scheduleOffset        = ScheduleOffsetNone
                                      , scheduleOptionsAction = ScheduleSetView
                                      }

      let
        offsetBtns = case viewRes of
          FormSuccess ScheduleOptions{scheduleView=ScheduleViewWeek}
            -> weekOffsets now user (scheduleOffset currentScheduleOptions)
               <&> (\sNewOffset -> currentScheduleOptions
                       { scheduleOffset = case sNewOffset of
                           ScheduleOffsetNone -> ScheduleOffsetNone
                           _ -> scheduleOffset currentScheduleOptions `addOffset` sNewOffset
                       , scheduleOptionsAction = ScheduleSetOffset sNewOffset
                       })
          _ -> mempty

      (offsetRess, offsetWidgets) <- fmap unzip . for offsetBtns $ \btn ->
        mopt (buttonFieldNoParse btn) ("" { fsName  = Just $ toPathPiece GetScheduleOptions
                                          , fsAttrs = if ((==) `on `offsetInDays) (scheduleOffset btn) (scheduleOffset currentScheduleOptions)
                                                      then [("disabled","")]
                                                      else mempty
                                          }) Nothing
      offsetRes <- if
        | Just errs <- fromNullable (filter (is _FormFailure) offsetRess) -> do
          mapM_ formFailure2Alerts errs
          (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs
        | otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> offsetRess) of
          [opt] -> return $ FormSuccess opt
          _ -> return $ FormSuccess currentScheduleOptions

      let
        scheduleResult = case (viewRes, offsetRes) of
          (_, opts@(FormSuccess _)) -> opts
          (opts@(FormSuccess _), _) -> opts
          _ -> FormSuccess currentScheduleOptions
        optionsWidget = $(widgetFile "schedule/options")
      
      return (scheduleResult, optionsWidget)

  ((optionsRes, optionsWidget), optionsEnctype) <- runFormGet scheduleOptionsForm

  schedule <- case optionsRes of
    FormSuccess ScheduleOptions{scheduleView=ScheduleViewWeek,..} -> return $ weekSchedule now user scheduleOffset
    other -> formFailure2Alerts other >> return mempty

  let scheduleExplanation = $(i18nWidgetFile "schedule-explanation")

  siteLayoutMsg MsgMenuSchedule $ do
    setTitleI MsgMenuSchedule
    $(widgetFile "schedule")
