{-# LANGUAGE
      DerivingVia,
      PatternSynonyms,
      StandaloneDeriving
  #-}

-- | Partial orders
module Data.PartialOrd (
  -- * Comparisons in partial orders
  PartialOrdering(..),
  fromOrd,
  toMaybeOrd,
  fromMaybeOrd,
  fromLeqGeq,
  fromCompare,
  -- * Partial orderings
  PartialOrd(..),
  comparable,
  -- * Special partial orderings
  FullyOrd(..),
  Discrete(..),
  -- * Maxima and minima
  Maxima(..),
  maxima,
  Minima(..),
  minima,
  -- * Partial orders on lists
  Infix(..),
  Prefix(..),
  Suffix(..),
  Subseq(..),
  ) where

import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.List (isInfixOf, isPrefixOf, isSuffixOf, isSubsequenceOf)
import Data.Monoid ()
import Data.Semigroup ()
import Data.Set (Set)
import qualified Data.Set as S


-- | A data type representing relationships between two objects in a
-- poset: they can be related (by EQ', LT' or GT'; like EQ, LT or GT),
-- or unrelated (NT').
data PartialOrdering = EQ' | LT' | GT' | NT'
  deriving (PartialOrdering -> PartialOrdering -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialOrdering -> PartialOrdering -> Bool
$c/= :: PartialOrdering -> PartialOrdering -> Bool
== :: PartialOrdering -> PartialOrdering -> Bool
$c== :: PartialOrdering -> PartialOrdering -> Bool
Eq, Int -> PartialOrdering -> ShowS
[PartialOrdering] -> ShowS
PartialOrdering -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialOrdering] -> ShowS
$cshowList :: [PartialOrdering] -> ShowS
show :: PartialOrdering -> String
$cshow :: PartialOrdering -> String
showsPrec :: Int -> PartialOrdering -> ShowS
$cshowsPrec :: Int -> PartialOrdering -> ShowS
Show)

-- | Convert an ordering into a partial ordering
fromOrd :: Ordering -> PartialOrdering
fromOrd :: Ordering -> PartialOrdering
fromOrd Ordering
EQ = PartialOrdering
EQ'
fromOrd Ordering
LT = PartialOrdering
LT'
fromOrd Ordering
GT = PartialOrdering
GT'

-- | Lift a `compare` to a `compare'`
fromCompare :: Ord a => a -> a -> PartialOrdering
fromCompare :: forall a. Ord a => a -> a -> PartialOrdering
fromCompare a
x a
y = Ordering -> PartialOrdering
fromOrd forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare a
x a
y

-- | Convert a partial ordering to an ordering
toMaybeOrd :: PartialOrdering -> Maybe Ordering
toMaybeOrd :: PartialOrdering -> Maybe Ordering
toMaybeOrd PartialOrdering
EQ' = forall a. a -> Maybe a
Just Ordering
EQ
toMaybeOrd PartialOrdering
LT' = forall a. a -> Maybe a
Just Ordering
LT
toMaybeOrd PartialOrdering
GT' = forall a. a -> Maybe a
Just Ordering
GT
toMaybeOrd PartialOrdering
NT' = forall a. Maybe a
Nothing

-- | Convert an ordering into a partial ordering
fromMaybeOrd :: Maybe Ordering -> PartialOrdering
fromMaybeOrd :: Maybe Ordering -> PartialOrdering
fromMaybeOrd (Just Ordering
EQ) = PartialOrdering
EQ'
fromMaybeOrd (Just Ordering
LT) = PartialOrdering
LT'
fromMaybeOrd (Just Ordering
GT) = PartialOrdering
GT'
fromMaybeOrd Maybe Ordering
Nothing   = PartialOrdering
NT'

-- | Convert from `leq` and `geq` to a partial ordering
fromLeqGeq :: Bool -> Bool -> PartialOrdering
fromLeqGeq :: Bool -> Bool -> PartialOrdering
fromLeqGeq Bool
True Bool
True = PartialOrdering
EQ'
fromLeqGeq Bool
True Bool
False = PartialOrdering
LT'
fromLeqGeq Bool
False Bool
True = PartialOrdering
GT'
fromLeqGeq Bool
False Bool
False = PartialOrdering
NT'


-- | A helper type for constructing partial orderings from total
-- orderings (using deriving via)
newtype FullyOrd a = FullyOrd {
  forall a. FullyOrd a -> a
getOrd :: a
} deriving (FullyOrd a -> FullyOrd a -> Bool
forall a. Eq a => FullyOrd a -> FullyOrd a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FullyOrd a -> FullyOrd a -> Bool
$c/= :: forall a. Eq a => FullyOrd a -> FullyOrd a -> Bool
== :: FullyOrd a -> FullyOrd a -> Bool
$c== :: forall a. Eq a => FullyOrd a -> FullyOrd a -> Bool
Eq, FullyOrd a -> FullyOrd a -> Bool
FullyOrd a -> FullyOrd a -> Ordering
FullyOrd a -> FullyOrd a -> FullyOrd a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (FullyOrd a)
forall a. Ord a => FullyOrd a -> FullyOrd a -> Bool
forall a. Ord a => FullyOrd a -> FullyOrd a -> Ordering
forall a. Ord a => FullyOrd a -> FullyOrd a -> FullyOrd a
min :: FullyOrd a -> FullyOrd a -> FullyOrd a
$cmin :: forall a. Ord a => FullyOrd a -> FullyOrd a -> FullyOrd a
max :: FullyOrd a -> FullyOrd a -> FullyOrd a
$cmax :: forall a. Ord a => FullyOrd a -> FullyOrd a -> FullyOrd a
>= :: FullyOrd a -> FullyOrd a -> Bool
$c>= :: forall a. Ord a => FullyOrd a -> FullyOrd a -> Bool
> :: FullyOrd a -> FullyOrd a -> Bool
$c> :: forall a. Ord a => FullyOrd a -> FullyOrd a -> Bool
<= :: FullyOrd a -> FullyOrd a -> Bool
$c<= :: forall a. Ord a => FullyOrd a -> FullyOrd a -> Bool
< :: FullyOrd a -> FullyOrd a -> Bool
$c< :: forall a. Ord a => FullyOrd a -> FullyOrd a -> Bool
compare :: FullyOrd a -> FullyOrd a -> Ordering
$ccompare :: forall a. Ord a => FullyOrd a -> FullyOrd a -> Ordering
Ord, Int -> FullyOrd a -> ShowS
forall a. Show a => Int -> FullyOrd a -> ShowS
forall a. Show a => [FullyOrd a] -> ShowS
forall a. Show a => FullyOrd a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullyOrd a] -> ShowS
$cshowList :: forall a. Show a => [FullyOrd a] -> ShowS
show :: FullyOrd a -> String
$cshow :: forall a. Show a => FullyOrd a -> String
showsPrec :: Int -> FullyOrd a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FullyOrd a -> ShowS
Show)

instance (Ord a) => PartialOrd (FullyOrd a) where
  compare' :: FullyOrd a -> FullyOrd a -> PartialOrdering
compare' (FullyOrd a
x) (FullyOrd a
y) = Ordering -> PartialOrdering
fromOrd forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare a
x a
y


-- | A helper type for constructing partial orderings where everything
-- is equal or incomparable.
newtype Discrete a = Discrete {
  forall a. Discrete a -> a
getDiscrete :: a
} deriving (Discrete a -> Discrete a -> Bool
forall a. Eq a => Discrete a -> Discrete a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Discrete a -> Discrete a -> Bool
$c/= :: forall a. Eq a => Discrete a -> Discrete a -> Bool
== :: Discrete a -> Discrete a -> Bool
$c== :: forall a. Eq a => Discrete a -> Discrete a -> Bool
Eq, Int -> Discrete a -> ShowS
forall a. Show a => Int -> Discrete a -> ShowS
forall a. Show a => [Discrete a] -> ShowS
forall a. Show a => Discrete a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Discrete a] -> ShowS
$cshowList :: forall a. Show a => [Discrete a] -> ShowS
show :: Discrete a -> String
$cshow :: forall a. Show a => Discrete a -> String
showsPrec :: Int -> Discrete a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Discrete a -> ShowS
Show)

instance (Eq a) => PartialOrd (Discrete a) where
  compare' :: Discrete a -> Discrete a -> PartialOrdering
compare' (Discrete a
x) (Discrete a
y)
    | a
x forall a. Eq a => a -> a -> Bool
== a
y    = PartialOrdering
EQ'
    | Bool
otherwise = PartialOrdering
NT'


-- | A comparison (less than or equal, greater than or equal) holds if
-- and only if it does on both arguments.
instance Semigroup PartialOrdering where
  PartialOrdering
NT' <> :: PartialOrdering -> PartialOrdering -> PartialOrdering
<> PartialOrdering
_   = PartialOrdering
NT'
  PartialOrdering
EQ' <> PartialOrdering
x   = PartialOrdering
x
  PartialOrdering
_   <> PartialOrdering
NT' = PartialOrdering
NT'
  PartialOrdering
x   <> PartialOrdering
EQ' = PartialOrdering
x
  PartialOrdering
LT' <> PartialOrdering
LT' = PartialOrdering
LT'
  PartialOrdering
GT' <> PartialOrdering
GT' = PartialOrdering
GT'
  PartialOrdering
_   <> PartialOrdering
_   = PartialOrdering
NT'

instance Monoid PartialOrdering where
  mempty :: PartialOrdering
mempty = PartialOrdering
EQ'

-- | A typeclass expressing partially ordered types: any two elements
-- are related by a `PartialOrdering`.
class PartialOrd a where
  {-# MINIMAL compare' | leq #-}

  compare' :: a -> a -> PartialOrdering
  compare' a
a a
b = Bool -> Bool -> PartialOrdering
fromLeqGeq (a
a forall a. PartialOrd a => a -> a -> Bool
`leq` a
b) (a
a forall a. PartialOrd a => a -> a -> Bool
`geq` a
b)

  leq :: a -> a -> Bool
  a
a `leq` a
b = case forall a. PartialOrd a => a -> a -> PartialOrdering
compare' a
a a
b of
    PartialOrdering
LT' -> Bool
True
    PartialOrdering
EQ' -> Bool
True
    PartialOrdering
_   -> Bool
False

  geq :: a -> a -> Bool
  a
a `geq` a
b = a
b forall a. PartialOrd a => a -> a -> Bool
`leq` a
a

-- | Are they LT', EQ', GT'
comparable :: PartialOrd a => a -> a -> Bool
comparable :: forall a. PartialOrd a => a -> a -> Bool
comparable a
a a
b = case forall a. PartialOrd a => a -> a -> PartialOrdering
compare' a
a a
b of
  PartialOrdering
NT' -> Bool
False
  PartialOrdering
_   -> Bool
True

-- | It's hard to imagine another sensible instance
deriving via FullyOrd Int instance PartialOrd Int

-- | It's hard to imagine another sensible instance
deriving via FullyOrd Integer instance PartialOrd Integer


instance PartialOrd () where
  compare' :: () -> () -> PartialOrdering
compare' ()
_ ()
_ = PartialOrdering
EQ'

-- | This is equivalent to
--
--   >   compare' (a,b) (c,d) = compare' a c <> compare' b d
--
--   but may be more efficient: if compare' a1 a2 is LT' or GT' we seek less
--   information about b1 and b2 (and this can be faster).
instance (PartialOrd a, PartialOrd b) => PartialOrd (a,b) where
  compare' :: (a, b) -> (a, b) -> PartialOrdering
compare' (a
a1,b
b1) (a
a2,b
b2) = case forall a. PartialOrd a => a -> a -> PartialOrdering
compare' a
a1 a
a2 of
    PartialOrdering
NT' -> PartialOrdering
NT'
    PartialOrdering
EQ' -> forall a. PartialOrd a => a -> a -> PartialOrdering
compare' b
b1 b
b2
    PartialOrdering
LT' -> if b
b1 forall a. PartialOrd a => a -> a -> Bool
`leq` b
b2 then PartialOrdering
LT' else PartialOrdering
NT'
    PartialOrdering
GT' -> if b
b1 forall a. PartialOrd a => a -> a -> Bool
`geq` b
b2 then PartialOrdering
GT' else PartialOrdering
NT'
  (a
a1,b
b1) leq :: (a, b) -> (a, b) -> Bool
`leq` (a
a2,b
b2) = a
a1 forall a. PartialOrd a => a -> a -> Bool
`leq` a
a2 Bool -> Bool -> Bool
&& b
b1 forall a. PartialOrd a => a -> a -> Bool
`leq` b
b2

instance (PartialOrd a, PartialOrd b, PartialOrd c) => PartialOrd (a,b,c) where
  compare' :: (a, b, c) -> (a, b, c) -> PartialOrdering
compare' (a
a1,b
b1,c
c1) (a
a2,b
b2,c
c2) = forall a. PartialOrd a => a -> a -> PartialOrdering
compare' ((a
a1,b
b1),c
c1) ((a
a2,b
b2),c
c2)
  (a
a1,b
b1,c
c1) leq :: (a, b, c) -> (a, b, c) -> Bool
`leq` (a
a2,b
b2,c
c2) = a
a1 forall a. PartialOrd a => a -> a -> Bool
`leq` a
a2 Bool -> Bool -> Bool
&& b
b1 forall a. PartialOrd a => a -> a -> Bool
`leq` b
b2 Bool -> Bool -> Bool
&& c
c1 forall a. PartialOrd a => a -> a -> Bool
`leq` c
c2

instance (PartialOrd a, PartialOrd b, PartialOrd c, PartialOrd d) => PartialOrd (a,b,c,d) where
  compare' :: (a, b, c, d) -> (a, b, c, d) -> PartialOrdering
compare' (a
a1,b
b1,c
c1,d
d1) (a
a2,b
b2,c
c2,d
d2) = forall a. PartialOrd a => a -> a -> PartialOrdering
compare' (((a
a1,b
b1),c
c1),d
d1) (((a
a2,b
b2),c
c2),d
d2)
  (a
a1,b
b1,c
c1,d
d1) leq :: (a, b, c, d) -> (a, b, c, d) -> Bool
`leq` (a
a2,b
b2,c
c2,d
d2) = a
a1 forall a. PartialOrd a => a -> a -> Bool
`leq` a
a2 Bool -> Bool -> Bool
&& b
b1 forall a. PartialOrd a => a -> a -> Bool
`leq` b
b2 Bool -> Bool -> Bool
&& c
c1 forall a. PartialOrd a => a -> a -> Bool
`leq` c
c2 Bool -> Bool -> Bool
&& d
d1 forall a. PartialOrd a => a -> a -> Bool
`leq` d
d2

instance (PartialOrd a, PartialOrd b, PartialOrd c, PartialOrd d, PartialOrd e) => PartialOrd (a,b,c,d,e) where
  compare' :: (a, b, c, d, e) -> (a, b, c, d, e) -> PartialOrdering
compare' (a
a1,b
b1,c
c1,d
d1,e
e1) (a
a2,b
b2,c
c2,d
d2,e
e2) = forall a. PartialOrd a => a -> a -> PartialOrdering
compare' ((((a
a1,b
b1),c
c1),d
d1),e
e1) ((((a
a2,b
b2),c
c2),d
d2),e
e2)
  (a
a1,b
b1,c
c1,d
d1,e
e1) leq :: (a, b, c, d, e) -> (a, b, c, d, e) -> Bool
`leq` (a
a2,b
b2,c
c2,d
d2,e
e2) = a
a1 forall a. PartialOrd a => a -> a -> Bool
`leq` a
a2 Bool -> Bool -> Bool
&& b
b1 forall a. PartialOrd a => a -> a -> Bool
`leq` b
b2 Bool -> Bool -> Bool
&& c
c1 forall a. PartialOrd a => a -> a -> Bool
`leq` c
c2 Bool -> Bool -> Bool
&& d
d1 forall a. PartialOrd a => a -> a -> Bool
`leq` d
d2 Bool -> Bool -> Bool
&& e
e1 forall a. PartialOrd a => a -> a -> Bool
`leq` e
e2


instance Ord a => PartialOrd (Set a) where
  leq :: Set a -> Set a -> Bool
leq = forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf

  compare' :: Set a -> Set a -> PartialOrdering
compare' Set a
u Set a
v = case forall a. Ord a => a -> a -> Ordering
compare (forall a. Set a -> Int
S.size Set a
u) (forall a. Set a -> Int
S.size Set a
v) of
    Ordering
LT -> if forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set a
u Set a
v then PartialOrdering
LT' else PartialOrdering
NT'
    Ordering
GT -> if forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set a
v Set a
u then PartialOrdering
GT' else PartialOrdering
NT'
    Ordering
EQ -> if Set a
u forall a. Eq a => a -> a -> Bool
== Set a
v then PartialOrdering
EQ' else PartialOrdering
NT'

instance PartialOrd IntSet where
  leq :: IntSet -> IntSet -> Bool
leq = IntSet -> IntSet -> Bool
IS.isSubsetOf

  compare' :: IntSet -> IntSet -> PartialOrdering
compare' IntSet
u IntSet
v = case forall a. Ord a => a -> a -> Ordering
compare (IntSet -> Int
IS.size IntSet
u) (IntSet -> Int
IS.size IntSet
v) of
    Ordering
LT -> if IntSet -> IntSet -> Bool
IS.isSubsetOf IntSet
u IntSet
v then PartialOrdering
LT' else PartialOrdering
NT'
    Ordering
GT -> if IntSet -> IntSet -> Bool
IS.isSubsetOf IntSet
u IntSet
v then PartialOrdering
GT' else PartialOrdering
NT'
    Ordering
EQ -> if IntSet
u forall a. Eq a => a -> a -> Bool
== IntSet
v then PartialOrdering
EQ' else PartialOrdering
NT'


-- | Lists partially ordered by infix inclusion
newtype Infix a = Infix {
  forall a. Infix a -> [a]
unInfix :: [a]
} deriving (Infix a -> Infix a -> Bool
forall a. Eq a => Infix a -> Infix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Infix a -> Infix a -> Bool
$c/= :: forall a. Eq a => Infix a -> Infix a -> Bool
== :: Infix a -> Infix a -> Bool
$c== :: forall a. Eq a => Infix a -> Infix a -> Bool
Eq, Int -> Infix a -> ShowS
forall a. Show a => Int -> Infix a -> ShowS
forall a. Show a => [Infix a] -> ShowS
forall a. Show a => Infix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Infix a] -> ShowS
$cshowList :: forall a. Show a => [Infix a] -> ShowS
show :: Infix a -> String
$cshow :: forall a. Show a => Infix a -> String
showsPrec :: Int -> Infix a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Infix a -> ShowS
Show)

instance Eq a => PartialOrd (Infix a) where
  Infix [a]
a leq :: Infix a -> Infix a -> Bool
`leq` Infix [a]
b = forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
a [a]
b

-- | Lists partially ordered by prefix inclusion
newtype Prefix a = Prefix {
  forall a. Prefix a -> [a]
unPrefix :: [a]
} deriving (Prefix a -> Prefix a -> Bool
forall a. Eq a => Prefix a -> Prefix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prefix a -> Prefix a -> Bool
$c/= :: forall a. Eq a => Prefix a -> Prefix a -> Bool
== :: Prefix a -> Prefix a -> Bool
$c== :: forall a. Eq a => Prefix a -> Prefix a -> Bool
Eq, Int -> Prefix a -> ShowS
forall a. Show a => Int -> Prefix a -> ShowS
forall a. Show a => [Prefix a] -> ShowS
forall a. Show a => Prefix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prefix a] -> ShowS
$cshowList :: forall a. Show a => [Prefix a] -> ShowS
show :: Prefix a -> String
$cshow :: forall a. Show a => Prefix a -> String
showsPrec :: Int -> Prefix a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Prefix a -> ShowS
Show)

instance Eq a => PartialOrd (Prefix a) where
  compare' :: Prefix a -> Prefix a -> PartialOrdering
compare' (Prefix [a]
a) (Prefix [a]
b) = let
    inner :: [a] -> [a] -> PartialOrdering
inner [] [] = PartialOrdering
EQ'
    inner [] [a]
_ = PartialOrdering
LT'
    inner [a]
_ [] = PartialOrdering
GT'
    inner (a
x:[a]
xs) (a
y:[a]
ys)
      | a
x forall a. Eq a => a -> a -> Bool
== a
y    = [a] -> [a] -> PartialOrdering
inner [a]
xs [a]
ys
      | Bool
otherwise = PartialOrdering
NT'
    in forall {a}. Eq a => [a] -> [a] -> PartialOrdering
inner [a]
a [a]
b
  Prefix [a]
a leq :: Prefix a -> Prefix a -> Bool
`leq` Prefix [a]
b = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
a [a]
b


-- | Lists partially ordered by suffix inclusion
newtype Suffix a = Suffix {
  forall a. Suffix a -> [a]
unSuffix :: [a]
} deriving (Suffix a -> Suffix a -> Bool
forall a. Eq a => Suffix a -> Suffix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Suffix a -> Suffix a -> Bool
$c/= :: forall a. Eq a => Suffix a -> Suffix a -> Bool
== :: Suffix a -> Suffix a -> Bool
$c== :: forall a. Eq a => Suffix a -> Suffix a -> Bool
Eq, Int -> Suffix a -> ShowS
forall a. Show a => Int -> Suffix a -> ShowS
forall a. Show a => [Suffix a] -> ShowS
forall a. Show a => Suffix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Suffix a] -> ShowS
$cshowList :: forall a. Show a => [Suffix a] -> ShowS
show :: Suffix a -> String
$cshow :: forall a. Show a => Suffix a -> String
showsPrec :: Int -> Suffix a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Suffix a -> ShowS
Show)

instance Eq a => PartialOrd (Suffix a) where
  Suffix [a]
a leq :: Suffix a -> Suffix a -> Bool
`leq` Suffix [a]
b = forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [a]
a [a]
b


-- | Lists partially ordered by the subsequence relation
newtype Subseq a = Subseq {
  forall a. Subseq a -> [a]
unSubseq :: [a]
} deriving (Subseq a -> Subseq a -> Bool
forall a. Eq a => Subseq a -> Subseq a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subseq a -> Subseq a -> Bool
$c/= :: forall a. Eq a => Subseq a -> Subseq a -> Bool
== :: Subseq a -> Subseq a -> Bool
$c== :: forall a. Eq a => Subseq a -> Subseq a -> Bool
Eq, Int -> Subseq a -> ShowS
forall a. Show a => Int -> Subseq a -> ShowS
forall a. Show a => [Subseq a] -> ShowS
forall a. Show a => Subseq a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subseq a] -> ShowS
$cshowList :: forall a. Show a => [Subseq a] -> ShowS
show :: Subseq a -> String
$cshow :: forall a. Show a => Subseq a -> String
showsPrec :: Int -> Subseq a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Subseq a -> ShowS
Show)

instance Eq a => PartialOrd (Subseq a) where
  Subseq [a]
a leq :: Subseq a -> Subseq a -> Bool
`leq` Subseq [a]
b = forall a. Eq a => [a] -> [a] -> Bool
isSubsequenceOf [a]
a [a]
b


-- | Sets of incomparable elements, with a monoidal structure obtained
-- by taking the maximal ones.
--
-- Unfortunately, we need a full ordering for these to work (since
-- they use sets), though we don't assume this ordering has any
-- compatibility with the partial order. The monoid structures are
-- most efficient with pre-reduced sets as the left-hand argument.
newtype Maxima a = Maxima {
  forall a. Maxima a -> Set a
maxSet :: Set a
}

instance (Ord a, PartialOrd a) => Semigroup (Maxima a) where
  Maxima Set a
s1 <> :: Maxima a -> Maxima a -> Maxima a
<> Maxima Set a
s2 = let
    noLarger :: Set a -> a -> Bool
noLarger Set a
s a
x = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== PartialOrdering
LT') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PartialOrd a => a -> a -> PartialOrdering
compare' a
x) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set a
s
    s2' :: Set a
s2' = forall a. (a -> Bool) -> Set a -> Set a
S.filter (forall {a}. PartialOrd a => Set a -> a -> Bool
noLarger Set a
s1) Set a
s2
    s1' :: Set a
s1' = forall a. (a -> Bool) -> Set a -> Set a
S.filter (forall {a}. PartialOrd a => Set a -> a -> Bool
noLarger Set a
s2') Set a
s1
    in forall a. Set a -> Maxima a
Maxima forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
s1' Set a
s2'

instance (Ord a, PartialOrd a) => Monoid (Maxima a) where
  mempty :: Maxima a
mempty = forall a. Set a -> Maxima a
Maxima forall a. Set a
S.empty
  mappend :: Maxima a -> Maxima a -> Maxima a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Find the maxima of a list (passing it through the machinery above)
maxima :: (Ord a, PartialOrd a) => [a] -> [a]
maxima :: forall a. (Ord a, PartialOrd a) => [a] -> [a]
maxima = forall a. Set a -> [a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maxima a -> Set a
maxSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Set a -> Maxima a
Maxima forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Set a
S.singleton)


-- | As above, but with minima
newtype Minima a = Minima {
  forall a. Minima a -> Set a
minSet :: Set a
}

instance (Ord a, PartialOrd a) => Semigroup (Minima a) where
  Minima Set a
s1 <> :: Minima a -> Minima a -> Minima a
<> Minima Set a
s2 = let
    noSmaller :: Set a -> a -> Bool
noSmaller Set a
s a
x = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== PartialOrdering
GT') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PartialOrd a => a -> a -> PartialOrdering
compare' a
x) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set a
s
    s2' :: Set a
s2' = forall a. (a -> Bool) -> Set a -> Set a
S.filter (forall {a}. PartialOrd a => Set a -> a -> Bool
noSmaller Set a
s1) Set a
s2
    s1' :: Set a
s1' = forall a. (a -> Bool) -> Set a -> Set a
S.filter (forall {a}. PartialOrd a => Set a -> a -> Bool
noSmaller Set a
s2') Set a
s1
    in forall a. Set a -> Minima a
Minima forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
s1' Set a
s2'

instance (Ord a, PartialOrd a) => Monoid (Minima a) where
  mempty :: Minima a
mempty = forall a. Set a -> Minima a
Minima forall a. Set a
S.empty
  mappend :: Minima a -> Minima a -> Minima a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Find the minima of a list (passing it through the machinery above)
minima :: (Ord a, PartialOrd a) => [a] -> [a]
minima :: forall a. (Ord a, PartialOrd a) => [a] -> [a]
minima = forall a. Set a -> [a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Minima a -> Set a
minSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Set a -> Minima a
Minima forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Set a
S.singleton)