-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.Term
  ( groupHolidays
  , getCurrentTerm
  , getActiveTerms
  , module Utils.Term
  ) where

import Import

import qualified Data.Set as Set
import qualified Data.Sequence as Seq

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E

import Utils.Term

import qualified Data.Conduit.Combinators as C


groupHolidays :: ( MonoFoldable mono
                 , Enum (Element mono)
                 , Ord (Element mono)
                 )
              => mono -> [Either (Element mono) (Element mono, Element mono)]
groupHolidays = go Seq.empty . foldMap Set.singleton
  where go (acc Seq.:|> Left   x')       (Set.minView -> Just (x, xs))
          | x <= succ x' = go (acc Seq.:|> Right (x', x)) xs
        go (acc Seq.:|> Right (x', x'')) (Set.minView -> Just (x, xs))
          | x <= succ x'' = go (acc Seq.:|> Right (x', x)) xs
        go  acc                          xs'
          | Just (x, xs) <- Set.minView xs' = go (acc Seq.:|> Left x) xs
          | otherwise                       = toList acc

getCurrentTerm :: MonadIO m => SqlReadT m (Maybe TermId)
-- ^ Current, generally active, term (i.e. `termIsActiveE` with `Nothing` as `maybeAuthId`)
getCurrentTerm = do
  now <- liftIO getCurrentTime
  fmap (fmap E.unValue) . E.selectMaybe . E.from $ \term -> do
    E.where_ . termIsActiveE (E.val now) E.nothing $ term E.^. TermId
    E.orderBy [E.desc $ term E.^. TermName]
    return $ term E.^. TermId

getActiveTerms :: ( MonadHandler m, HandlerSite m ~ UniWorX
                  , BackendCompatible SqlBackend backend
                  , IsPersistBackend backend
                  , PersistQueryRead backend, PersistUniqueRead backend
                  )
               => ReaderT backend m (Set TermId)
getActiveTerms = do
  now <- liftIO getCurrentTime
  muid <- maybeAuthId

  let activeTermsQuery = E.from $ \term -> E.distinctOnOrderBy [E.asc $ term E.^. TermId] $ do
        E.where_ . termIsActiveE (E.val now) (E.val muid) $ term E.^. TermId
        return $ term E.^. TermId

  fmap Set.fromDistinctAscList . runConduit $
    E.selectSource activeTermsQuery .| C.map E.unValue .| C.sinkList