    {-# LANGUAGE GeneralizedNewtypeDeriving #-}

    -- | Maintaining a list of favorites of some partially ordered type.
    --   Only the best elements are kept.
    --
    --   To avoid name clashes, import this module qualified, as in
    --   @
    --      import Agda.Utils.Favorites (Favorites)
    --      import qualified Agda.Utils.Favorites as Fav
    --   @

    module Agda.Utils.Favorites where

    import Prelude hiding ( null )

    import Data.Foldable (Foldable)
    import Data.Functor
    import Data.Semigroup
    import qualified Data.List as List
    import qualified Data.Set as Set

    import Agda.Utils.Null
    import Agda.Utils.PartialOrd
    import Agda.Utils.Singleton
    import Agda.Utils.Tuple

    -- | A list of incomparable favorites.
    newtype Favorites a = Favorites { toList :: [a] }
      deriving (Foldable, Show, Null, Singleton a)

    -- | Equality checking is a bit expensive, since we need to sort!
    --   Maybe use a 'Set' of favorites in the first place?
    instance Ord a => Eq (Favorites a) where
      as == bs = Set.fromList (toList as) == Set.fromList (toList bs)

    -- | Result of comparing a candidate with the current favorites.
    data CompareResult a
      = Dominates   { dominated :: [a], notDominated :: [a] }
        -- ^ Great, you are dominating a possibly (empty list of favorites)
        --   but there is also a rest that is not dominated.
        --   If @null dominated@, then @notDominated@ is necessarily the
        --   complete list of favorites.
      | IsDominated { dominator :: a }
        -- ^ Sorry, but you are dominated by that favorite.

    -- | Gosh, got some pretty @a@ here, compare with my current favorites!
    --   Discard it if there is already one that is better or equal.
    --   (Skewed conservatively: faithful to the old favorites.)
    --   If there is no match for it, add it, and
    --   dispose of all that are worse than @a@.
    --
    --   We require a partial ordering.  Less is better! (Maybe paradoxically.)
    compareWithFavorites :: PartialOrd a => a -> Favorites a -> CompareResult a
    compareWithFavorites a favs = loop $ toList favs where
      loop []          = Dominates [] []
      loop as@(b : bs) = case comparable a b of
        POLT -> dominates b $ loop bs  -- @a@ is a new favorite, bye-bye, @b@
        POLE -> dominates b $ loop bs  -- ditto
        POEQ -> IsDominated b          -- @b@ is as least as good as @a@, bye-bye, @a@
        POGE -> IsDominated b          -- ditto
        POGT -> IsDominated b          -- ditto
        POAny -> doesnotd b $ loop bs -- don't know, compare with my other favorites
      -- add an outperformed favorite
      dominates b (Dominates bs as) = Dominates (b : bs) as
      dominates b r@IsDominated{}   = r
      -- add an uncomparable favorite
      doesnotd  b (Dominates as bs) = Dominates as (b : bs)
      doesnotd  b r@IsDominated{}   = r

    -- | Compare a new set of favorites to an old one and discard
    --   the new favorites that are dominated by the old ones
    --   and vice verse.
    --   (Skewed conservatively: faithful to the old favorites.)
    --
    --   @compareFavorites new old = (new', old')@
    compareFavorites :: PartialOrd a => Favorites a -> Favorites a ->
                        (Favorites a, Favorites a)
    compareFavorites new old = mapFst Favorites $ loop (toList new) old where
      loop []        old = ([], old)
      loop (a : new) old = case compareWithFavorites a old of
        -- Better: Discard all @old@ ones that @a@ dominates and keep @a@
        Dominates _ old -> mapFst (a:) $ loop new (Favorites old)
        -- Not better:  Discard @a@
        IsDominated{}   -> loop new old

    unionCompared :: (Favorites a, Favorites a) -> Favorites a
    unionCompared (Favorites new, Favorites old) = Favorites $ new ++ old

    -- | After comparing, do the actual insertion.
    insertCompared :: a -> Favorites a -> CompareResult a -> Favorites a
    insertCompared a _ (Dominates _ as) = Favorites (a : as)
    insertCompared _ l IsDominated{}    = l

    -- | Compare, then insert accordingly.
    --   @insert a l = insertCompared a l (compareWithFavorites a l)@
    insert :: PartialOrd a => a -> Favorites a -> Favorites a
    insert a l = insertCompared a l (compareWithFavorites a l)

    -- | Insert all the favorites from the first list into the second.
    union :: PartialOrd a => Favorites a -> Favorites a -> Favorites a
    union (Favorites as) bs = List.foldr insert bs as

    -- | Construct favorites from elements of a partial order.
    --   The result depends on the order of the list if it
    --   contains equal elements, since earlier seen elements
    --   are favored over later seen equals.
    --   The first element of the list is seen first.
    fromList :: PartialOrd a => [a] -> Favorites a
    fromList = List.foldl' (flip insert) empty

    -- | 'Favorites' forms a 'Monoid' under 'empty' and 'union.
    instance PartialOrd a => Semigroup (Favorites a) where
      (<>) = union
    instance PartialOrd a => Monoid (Favorites a) where
      mempty  = empty
      mappend = (<>)