module Handler.Utils.Communication where

import Import
import Handler.Utils
import Handler.Utils.Form.MassInput
import Utils.Lens

import Jobs.Queue
import Control.Monad.Trans.Reader (mapReaderT)

import qualified Database.Esqueleto as E
import qualified Data.CaseInsensitive as CI
import qualified Data.Map as Map
import qualified Data.Set as Set


data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)

instance Universe RecipientGroup
instance Finite RecipientGroup
nullaryPathPiece ''RecipientGroup $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''RecipientGroup id


data RecipientAddOption
  = AddRecipientGroups
  | AddRecipientGroup RecipientGroup
  | AddRecipientCustom
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

instance Universe RecipientAddOption where
  universe = concat
    [ pure AddRecipientGroups
    , [ AddRecipientGroup g | g <- universe ]
    , pure AddRecipientCustom
    ]
instance Finite RecipientAddOption

instance PathPiece RecipientAddOption where
  toPathPiece AddRecipientGroups    = "recipient-groups"
  toPathPiece AddRecipientCustom    = "recipient-custom"
  toPathPiece (AddRecipientGroup g) = toPathPiece g

  fromPathPiece = finiteFromPathPiece

instance RenderMessage UniWorX RecipientAddOption where
  renderMessage foundation ls = \case
    AddRecipientGroups  -> renderMessage' MsgAddRecipientGroups
    AddRecipientCustom  -> renderMessage' MsgAddRecipientCustom
    AddRecipientGroup g -> renderMessage' g
    where
      renderMessage' :: forall msg. RenderMessage UniWorX msg => msg -> Text
      renderMessage' = renderMessage foundation ls


data CommunicationRoute = CommunicationRoute
  { crRecipients :: Map RecipientGroup (E.SqlQuery (E.SqlExpr (Entity User)))
  , crJob        :: Communication -> DB Job
  , crHeading    :: SomeMessage UniWorX
  , crUltDest    :: SomeRoute UniWorX
  }
-- `Communication` is defined in `Jobs.Types`


commR :: CommunicationRoute -> Handler Html
commR CommunicationRoute{..} =  do
  MsgRenderer mr <- getMsgRenderer
  mbCurrentRoute <- getCurrentRoute

  suggestedRecipients' <- runDB $ traverse E.select crRecipients
  suggestedRecipients <- forM suggestedRecipients' . mapM $ \ent@(Entity rid _) -> (,) <$> (encrypt rid :: Handler CryptoUUIDUser) <*> pure ent

  let recipientAForm :: AForm Handler (Set (Either UserEmail UserId))
      recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients) True (Nothing {- TODO -})
        where
          miAdd _ _ nudge submitView = Just $ \csrf -> do
            let addOptions :: Map RecipientAddOption (AForm Handler (Set (Either UserEmail UserId)))
                addOptions = Map.fromList . concat $
                  [ pure ( AddRecipientGroups
                         , Set.unions <$> apreq (multiSelectField . return $ mkOptionList
                                                   [ Option (mr g) (Set.fromList $ map (Right . entityKey . snd) recs) (toPathPiece g) | (g,recs) <- Map.toList suggestedRecipients ]
                                                ) (fslI AddRecipientGroups & addName (nudge . toPathPiece $ AddRecipientGroups)) Nothing
                         )
                  , do
                      (g,recs) <- Map.toList suggestedRecipients
                      return ( AddRecipientGroup g
                             , Set.unions <$> apreq (multiSelectField . return $ mkOptionList
                                                       [ Option userDisplayName (Set.singleton $ Right rid) (toPathPiece cid) | (cid, Entity rid User{..}) <- recs ]
                                                    ) (fslI (AddRecipientGroup g) & addName (nudge . toPathPiece $ AddRecipientGroup g)) Nothing
                             )
                  , pure ( AddRecipientCustom
                         , Set.fromList . map (Left . CI.mk) <$> apreq multiEmailField (fslI AddRecipientCustom & addName (nudge $ toPathPiece AddRecipientCustom)) Nothing )
                  ]
            (addRes, addWdgt) <- multiActionM addOptions ("foobar" & addName (nudge "select")) Nothing csrf
            -- lookupUserDisplayName :: UserId -> UserDisplayName
            -- lookupUserDisplayName <- liftHandlerT . runDB $ do
            --     let uids = toListOf (_FormSuccess . folded . _Right) addRes
            --     names <- forM uids getJustEntity
            --     return $ \uid -> case filter ((== uid) . entityKey) names of
            --       [Entity _ User{..}] -> userDisplayName
            --       _other              -> error "UserId lookpup failed"
            let addRes'  = addRes <&> \newSet oldMap ->
                            -- if
                            --   | collisions <- newSet `Set.intersection` Set.fromList (Map.elems oldMap)
                            --   , not $ Set.null collisions ->
                            --       -- FormFailure [ mr . MsgCommDuplicateRecipients . map (either CI.original lookupUserDisplayName) $ Set.toList collisions ]
                            --       FormFailure [ mr . MsgCommDuplicateRecipients $ Set.size collisions ]
                            --   | otherwise -> FormSuccess . Map.fromList . zip [maybe 0 (succ . fst) (Map.lookupMax oldMap)..] $ Set.toList newSet
                            let freshSet = newSet `Set.difference` Set.fromList (Map.elems oldMap)
                            in  FormSuccess . Map.fromList . zip [maybe 0 (succ . fst) (Map.lookupMax oldMap)..] $ Set.toList freshSet

                addWdgt' = mconcat [ toWidget csrf, addWdgt, fvInput submitView ]
            return (addRes', addWdgt')

          miCell _ (Left email) _ _nudge csrf
            = return (pure (), toWidget csrf <> toWidget (mailtoHtml email))
          miCell _ (Right rid) _ _nudge csrf = do
            User{..} <- liftHandlerT . runDB $ getJust rid
            return (pure (), toWidget csrf <> nameEmailWidget userEmail userDisplayName userSurname)
          miDelete :: ListLength -> ListPosition -> MaybeT (MForm Handler) (Map ListPosition ListPosition) -- This type signature is needed, so GHC can infer the type of @MassInput{..}@, above
          miDelete = miDeleteList -- default for lists suffices, since there are no restrictions
          miAllowAdd _ _ _ = True
          miButtonAction :: forall p . PathPiece p => p -> Maybe (SomeRoute UniWorX)
          miButtonAction anchor = SomeRoute . (:#: anchor) <$> mbCurrentRoute
          postProcess :: Map ListPosition (Either UserEmail UserId, ()) -> Set (Either UserEmail UserId)
          postProcess = Set.fromList . map fst . Map.elems

  ((commRes,commWdgt),commEncoding) <- runFormPost . identifyForm FIDCommunication . renderAForm FormStandard $ Communication
    <$> recipientAForm
    <*> aopt textField (fslI MsgCommSubject) Nothing
  formResult commRes $ \comm -> do
    runDBJobs $ queueDBJob =<< mapReaderT lift (crJob comm)
    addMessageI Success . MsgCommSuccess . Set.size $ cRecipients comm
    redirect crUltDest


  let formWdgt = wrapForm commWdgt def
        { formMethod   = POST
        , formAction   = SomeRoute <$> mbCurrentRoute
        , formEncoding = commEncoding
        }
  siteLayoutMsg crHeading formWdgt