{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-|
Module      : Interval Algebra Utilities
Description : Functions for operating on containers of Intervals.
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
Stability   : experimental

In the examples below, @iv@ is a synonym for 'beginerval' used to save space.
-}

module IntervalAlgebra.IntervalUtilities (
      combineIntervals
    , combineIntervals'
    , gaps
    , gaps'
    , durations
    , clip
    , relations
    , relations'
    , gapsWithin
    , nothingIf
    , nothingIfNone
    , nothingIfAny
    , nothingIfAll

    -- * Filtering functions
    , compareIntervals
    , filterBefore
    , filterMeets
    , filterOverlaps
    , filterFinishedBy
    , filterContains
    , filterStarts
    , filterEquals
    , filterStartedBy
    , filterDuring
    , filterFinishes
    , filterOverlappedBy
    , filterMetBy
    , filterAfter
    , filterDisjoint
    , filterNotDisjoint
    , filterConcur
    , filterWithin
    , filterEnclose
    , filterEnclosedBy

) where

import GHC.Base         ( otherwise, ($), (.), (<*>), seq, not
                        , Semigroup((<>))
                        , Functor(fmap)
                        , Applicative(pure)
                        , Int, Bool, Ord)
import GHC.Num          ()
import Data.Tuple       ( fst )
import Data.Foldable    ( Foldable(null, foldl', toList), all, any )
import Data.Monoid      ( (<>), Monoid(mempty) )
import Data.Maybe       (mapMaybe, catMaybes, fromMaybe, Maybe(..))
import Data.List        ( (++), map )
import IntervalAlgebra  ( Interval
                        , Intervallic(..)
                        , IntervalAlgebraic(..)
                        , IntervalCombinable(..)
                        , IntervalSizeable(..)
                        , IntervalRelation(..)
                        , ComparativePredicateOf
                        , beginerval
                        , enderval)
import Safe             ( headMay, lastMay, initSafe, tailSafe)
import Witherable       ( Filterable(filter) )

-------------------------------------------------
-- Unexported utilties used in functions below --
-------------------------------------------------

iv :: Int -> Int -> Interval Int
iv = beginerval

-- Fold over consecutive pairs of foldable structure and collect the results in 
-- a monoidal structure.
foldlAccume :: (Foldable f, Applicative m, Monoid (m a))=>
      (b -> b -> a) -- ^ @f@: a function to apply to consecutive elements of @f b@
    -> f b
    -> m a
foldlAccume f x = fst $ foldl' (applyAccume f) (mempty, Nothing) x

-- Apply a function and accumulate the results in a monoidal structure.
applyAccume :: (Monoid (f a), Applicative f) =>
       (b -> b -> a)  -- ^ @f@: a function combining two @b@s to get an @a@
    -> (f a, Maybe b) -- ^ a pair (accumulating monoid for @b@s, optional @a@)
    -> b              -- ^ this will be the second argument to @f@
    -> (f a, Maybe b)
applyAccume f (fs, Nothing) x = (fs, Just x)
applyAccume f (fs, Just x)  y  = (fs <> pure (f x y), Just y)

-- Lifts a list to a foldable, applicative monoid 
liftListToFoldable :: (Applicative f
                      , Monoid (f a)
                      , Foldable f) =>
    [a] -> f a
liftListToFoldable = foldl' (\x y -> x <> pure y) mempty

-- Box to avoid overlapping instances
newtype Box a = Box { unBox :: [a] }

-- Defines how a Box of Intervals are combined. Specifically, the last element of
-- x and first element of y are combined by '<+>'.
instance (IntervalCombinable Interval a) => Semigroup (Box (Interval a)) where
    Box x <> Box y = Box $ initSafe x ++ lastMay x <++> headMay y ++ tailSafe y

(<++>) :: (IntervalCombinable Interval a) => 
       Maybe (Interval a)
    -> Maybe (Interval a) 
    -> [Interval a]
(<++>) Nothing Nothing   = []
(<++>) Nothing (Just y)  = [y]
(<++>) (Just x) Nothing  = [x]
(<++>) (Just x) (Just y) = x <+> y

-------------------------------------------------

-- | Returns a container of intervals where any intervals that meet or share support
--   are combined into one interval. *To work properly, the input should 
--   be sorted*. See 'combineIntervals'' for a version that works only on lists.
--
-- >>> combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
-- [(0, 12),(13, 15)]
combineIntervals :: (IntervalCombinable Interval a
         , Applicative f
         , Monoid (f (Interval a))
         , Foldable f) =>
      f (Interval a) ->
      f (Interval a)
combineIntervals x = liftListToFoldable (combineIntervals' $ toList x)

-- | Returns a list of intervals where any intervals that meet or share support
--   are combined into one interval. *To work properly, the input list should 
--   be sorted*. 
--
-- >>> combineIntervals' [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
-- [(0, 12),(13, 15)]
combineIntervals' :: (IntervalCombinable Interval a) => [Interval a] -> [Interval a]
combineIntervals' l = unBox $ foldl' (<>) (Box []) (map (\z -> Box [z]) l)

-- | Returns a (possibly empty) container of intervals consisting of the gaps 
--   between intervals in the input. *To work properly, the input should be
--   sorted*. See 'gaps'' for a version that returns a list.
--
-- >>> gaps [iv 4 1, iv 4 8, iv 3 11]
-- [(5, 8)]
gaps :: (IntervalCombinable Interval a
         , Applicative f
         , Monoid (f (Interval a))
         , Foldable f) =>
      f (Interval a) ->
      f (Interval a)
gaps x = liftListToFoldable (gaps' x)

-- | Returns a (possibly empty) list of intervals consisting of the gaps between
--   intervals in the input container. *To work properly, the input should be 
--   sorted*. This version outputs a list. See 'gaps' for a version that lifts
--   the result to same input structure @f@.
gaps' :: (IntervalCombinable Interval a
         , Applicative f
         , Monoid (f (Interval a))
         , Foldable f) =>
      f (Interval a) ->
      [Interval a]
gaps' x = catMaybes (foldlAccume (><) x)

-- | Returns the 'duration' of each 'Intervallic i a' in the 'Functor' @f@.
--
-- >>> durations [iv 9 1, iv 10 2, iv 1 5]
-- [9,10,1]
durations :: (Functor f, Intervallic i a, IntervalSizeable a b)=>
       f (i a)
    -> f b
durations = fmap duration

-- | In the case that x y are not disjoint, clips y to the extent of x.
-- 
-- >>> clip (iv 5 0) (iv 3 3)
-- Just (3, 5)
--
-- >>> clip (iv 3 0) (iv 2 4)
-- Nothing
clip :: (IntervalAlgebraic Interval a, IntervalSizeable a b)=>
       Interval a
    -> Interval a
    -> Maybe (Interval a)
clip x y
   | overlaps x y     = Just $ enderval   (diff (end x) (begin y)) (end x)
   | overlappedBy x y = Just $ beginerval (diff (end y) (begin x)) (begin x)
   | jx x y           = Just x
   | jy x y           = Just y
   | disjoint x y     = Nothing
   where jy = equals <|> startedBy <|> contains <|> finishedBy
         jx = starts <|> during <|> finishes

-- | Returns a list of the 'IntervalRelation' between each consecutive pair 
--   of intervals. This the specialized form of 'relations'' which can return
--   any 'Applicative', 'Monoid' structure.
--
-- >>> relations [iv 1 0, iv 1 1] 
-- [Meets]
relations :: (IntervalAlgebraic i a, Foldable f)=>
       f (i a)
    -> [IntervalRelation (i a)]
relations = relations'

-- | A generic form of 'relations' which can output any 'Applicative' and 
--   'Monoid' structure. 
-- >>> (relations' [iv 1 0, iv 1 1]) :: [IntervalRelation (Interval Int)]
-- [Meets]
--
relations' :: ( IntervalAlgebraic i a
              , Foldable f
              , Applicative m
              , Monoid (m (IntervalRelation (i a))) )=>
        f (i a)
     -> m (IntervalRelation (i a))
relations' = foldlAccume relate

-- | Applies 'gaps' to all the non-disjoint intervals in @x@ that are *not* disjoint
-- from @i@. Intervals that 'overlaps' or are 'overlappedBy' @i@ are 'clip'ped 
-- to @i@, so that all the intervals are 'within' @i@. If there are no gaps, then
-- 'Nothing' is returned.
--
-- >>> gapsWithin (iv 9 1) [iv 5 0, iv 2 7, iv 3 12]
-- Just [(5, 7),(9, 10)]
--
gapsWithin :: ( Applicative f
               , Foldable f
               , Monoid (f (Interval a))
               , IntervalSizeable a b
               , IntervalCombinable Interval a
               , Filterable f
               , IntervalAlgebraic Interval a)=>
     Interval a     -- ^ i
  -> f (Interval a) -- ^ x
  -> Maybe (f (Interval a))
gapsWithin i x
  | null ivs  = Nothing
  | otherwise = Just $ gaps $ pure s <> ivs <> pure e
        where s   = enderval   0 (begin i)
              e   = beginerval 0 (end i)
              nd  = toList (filterNotDisjoint i x)
              ivs = liftListToFoldable (mapMaybe (clip i) nd)

-- | Given a predicate combinator, a predicate, and list of intervals, returns 
--   the input unchanged if the predicate combinator is @True@. Otherwise, returns
--   an empty list. See 'nothingIfAny' and 'nothingIfNone' for examples.
nothingIf :: (Monoid (f (i a)), Filterable f, IntervalAlgebraic i a)=>
     ((i a -> Bool) -> f (i a) -> Bool) -- ^ e.g. 'any' or 'all'
  -> (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIf quantifier predicate x = if quantifier predicate x then Nothing else Just x

-- | Returns the 'Nothing' if *none* of the element of input satisfy
--   the predicate condition.
-- 
-- For example, the following returns 'Nothing' because none of the intervals
-- in the input list 'starts' (3, 5).
--
-- >>> nothingIfNone (starts (iv 2 3)) [iv 1 3, iv 1 5]
-- Nothing
--
-- In the following, (3, 5) 'starts' (3, 6), so 'Just' the input is returned.
--
-- >>> nothingIfNone (starts (iv 2 3)) [iv 3 3, iv 1 5]
-- Just [(3, 6),(5, 6)]
--
nothingIfNone :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>
    (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfNone = nothingIf (\f x -> (not.any f) x)

-- | Returns 'Nothing' if *any* of the element of input satisfy the predicate condition.
nothingIfAny :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>
    (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfAny = nothingIf any

-- | Returns 'Nothing' if *all* of the element of input satisfy the predicate condition
nothingIfAll :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>
    (i a -> Bool) -- ^ predicate to apply to each element of input list
  -> f (i a)
  -> Maybe (f (i a))
nothingIfAll = nothingIf all

{- | 
Filter functions provides means for filtering 'Filterable' containers of 
@'Intervallic i a'@s based on @'IntervalAlgebraic'@ relations.
-}

-- | Lifts a predicate to be able to compare two different 'IntervalAlgebraic' 
--   structure by comparing the intervals contain within each. 
compareIntervals :: (IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>
   ComparativePredicateOf (Interval a)
    -> i0 a
    -> i1 a
    -> Bool
compareIntervals pf x y = pf (getInterval x) (getInterval y)

-- | Creates a function for filtering a 'Witherable.Filterable' of @i1 a@s 
--   by comparing the @Interval a@s that of an @i0 a@. 
filterMaker :: (Filterable f
                , IntervalAlgebraic Interval a
                , IntervalAlgebraic i0 a
                , IntervalAlgebraic i1 a) =>
        ComparativePredicateOf (Interval a)
      -> i0 a
      -> (f (i1 a) -> f (i1 a))
filterMaker f p = Witherable.filter (compareIntervals f p)

-- | Filter by 'overlaps'.
filterOverlaps :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterOverlaps = filterMaker overlaps

-- | Filter by 'overlappedBy'.
filterOverlappedBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterOverlappedBy = filterMaker overlappedBy

-- | Filter by 'before'.
filterBefore :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterBefore = filterMaker before

-- | Filter by 'after'.
filterAfter :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterAfter = filterMaker after

-- | Filter by 'starts'.
filterStarts :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterStarts = filterMaker starts

-- | Filter by 'startedBy'.
filterStartedBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterStartedBy = filterMaker startedBy

-- | Filter by 'finishes'.
filterFinishes :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterFinishes = filterMaker finishes

-- | Filter by'finishedBy'.
filterFinishedBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterFinishedBy = filterMaker finishedBy

-- | Filter by 'meets'.
filterMeets :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterMeets = filterMaker meets

-- | Filter by 'metBy'.
filterMetBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterMetBy = filterMaker metBy

-- | Filter by 'during'.
filterDuring :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterDuring = filterMaker during

-- | Filter by 'contains'.
filterContains :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterContains = filterMaker contains

-- | Filter by 'equals'.
filterEquals :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterEquals = filterMaker equals

-- | Filter by 'disjoint'.
filterDisjoint :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterDisjoint = filterMaker disjoint

-- | Filter by 'notDisjoint'.
filterNotDisjoint :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterNotDisjoint = filterMaker notDisjoint

-- | Filter by 'concur'.
filterConcur ::  (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterConcur = filterMaker concur

-- | Filter by 'within'.
filterWithin :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterWithin = filterMaker within

-- | Filter by 'enclose'.
filterEnclose :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterEnclose = filterMaker enclose

-- | Filter by 'enclosedBy'.
filterEnclosedBy :: (Filterable f
                  , IntervalAlgebraic Interval a
                  , IntervalAlgebraic i0 a
                  , IntervalAlgebraic i1 a) =>
                  i0 a -> f (i1 a) -> f (i1 a)
filterEnclosedBy = filterMaker enclosedBy