{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE NoImplicitPrelude #-}

{-|
Module      : Data.PartialOrd
Description : Provides the PartialOrd Typeclass.
Copyright   : (c) 2016 Moritz Schulte
License     : BSD3
Maintainer  : mtesseract@silverratio.net
Stability   : experimental
Portability : POSIX

This module provides the `PartialOrd' typeclass suitable for types
admitting a partial order.

Along with the `PartialOrd' typeclass and some utility functions for
working with partially ordered types, it exports implementations for
the numeric types several numeric types, lists and sets.
-}

-- Code imported into camfort to avoid build-dependency hell with
-- unmaintained upstream package.

module Camfort.Specification.Stencils.PartialOrd
  ( PartialOrd(..)
  , maxima, minima
  , elem, notElem
  , nub ) where

import Data.Bool
import Data.Maybe
import Prelude (Int, Integer, Float, Double, ($))
import qualified Data.Ord as Ord
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Foldable as Foldable

class PartialOrd a where

  -- | Less-than-or-equal relation.
  (<=) :: a -> a -> Bool

  -- | Bigger-than-or-equal relation. Defined in terms of `<='.
  (>=) :: a -> a -> Bool
  a
a >= a
a' = a
a' a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
<= a
a

  -- | Equality relation. Defined in terms of `<='.
  (==) :: a -> a -> Bool
  a
a == a
a' = a
a a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
<= a
a' Bool -> Bool -> Bool
&& a
a' a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
<= a
a

  -- | Inequality relation. Defined in terms of `=='.
  (/=) :: a -> a -> Bool
  a
a /= a
a' = Bool -> Bool
not (a
a a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
== a
a')

  -- | Less-than relation relation. Defined in terms of `<=' and `/='.
  (<) :: a -> a -> Bool
  a
a < a
a' = a
a a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
<= a
a' Bool -> Bool -> Bool
&& (a
a a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
/= a
a')

  -- | Bigger-than relation. Defined in terms of `<=` and `/='.
  (>) :: a -> a -> Bool
  a
a > a
a' = a
a' a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
<= a
a Bool -> Bool -> Bool
&& (a
a a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
/= a
a')

  -- | Compare function, returning either `Just' an `Ordering' or
  -- `Nothing'.
  compare :: a -> a -> Maybe Ord.Ordering
  compare a
a a
a' = if | a
a a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
== a
a'   -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
Ord.EQ
                    | a
a a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
<= a
a'   -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
Ord.LT
                    | a
a a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
>= a
a'   -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
Ord.GT
                    | Bool
otherwise -> Maybe Ordering
forall a. Maybe a
Nothing

  {-# MINIMAL (<=) #-}

-- | Derive the partial order from the total order for the following
-- types:
instance PartialOrd Int where
  <= :: Int -> Int -> Bool
(<=) = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(Ord.<=)

instance PartialOrd Integer where
  <= :: Integer -> Integer -> Bool
(<=) = Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(Ord.<=)

instance PartialOrd Double where
  <= :: Double -> Double -> Bool
(<=) = Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(Ord.<=)

instance PartialOrd Float where
  <= :: Float -> Float -> Bool
(<=) = Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
(Ord.<=)

-- | Define the partial order in terms of the subset relation.
instance (Ord.Ord a) => PartialOrd (Set.Set a) where
  <= :: Set a -> Set a -> Bool
(<=) = Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf

-- | Define the partial order in terms of the sublist relation.
instance PartialOrd a => PartialOrd [a] where
  <= :: [a] -> [a] -> Bool
(<=) = [a] -> [a] -> Bool
forall a. PartialOrd a => [a] -> [a] -> Bool
isSublistOf

-- | Return True if the first list is a sublist of the second list.
isSublistOf :: PartialOrd a => [a] -> [a] -> Bool
isSublistOf :: [a] -> [a] -> Bool
isSublistOf [] [a]
_ = Bool
True
isSublistOf (a
a:[a]
as) [a]
a' = a
a a -> [a] -> Bool
forall a (t :: * -> *).
(PartialOrd a, Foldable t) =>
a -> t a -> Bool
`elem` [a]
a' Bool -> Bool -> Bool
&& [a]
as [a] -> [a] -> Bool
forall a. PartialOrd a => [a] -> [a] -> Bool
`isSublistOf` [a]
a'

-- | Compute the list of all elements that are not less than any other
-- element in the list.
maxima :: PartialOrd a => [a] -> [a]
maxima :: [a] -> [a]
maxima [a]
as = [a] -> [a]
forall a. PartialOrd a => [a] -> [a]
nub ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a]
forall a. PartialOrd a => (a -> a -> Bool) -> [a] -> [a]
extrema a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
(<=) [a]
as

-- | Compute the list of all elements that are not bigger than any
-- other element in the list.
minima :: PartialOrd a => [a] -> [a]
minima :: [a] -> [a]
minima [a]
as = [a] -> [a]
forall a. PartialOrd a => [a] -> [a]
nub ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a]
forall a. PartialOrd a => (a -> a -> Bool) -> [a] -> [a]
extrema a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
(>=) [a]
as

extrema :: PartialOrd a => (a -> a -> Bool) -> [a] -> [a]
extrema :: (a -> a -> Bool) -> [a] -> [a]
extrema a -> a -> Bool
f [a]
as = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
List.filter a -> Bool
isExtremal [a]
as
  where isExtremal :: a -> Bool
isExtremal a
a =
          -- Return true if there exists no a' in as \ {a} such that
          --   a `f` a'.
          let as' :: [a]
as' = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
/= a
a) [a]
as
          in Bool -> Bool
not ((a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.any (a
a a -> a -> Bool
`f`) [a]
as')

-- | Version of the traditional elem function using the PartialOrd
-- notion of equality.
elem :: (PartialOrd a, Foldable.Foldable t) => a -> t a -> Bool
elem :: a -> t a -> Bool
elem a
x t a
xs = (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.any (a
x a -> a -> Bool
forall a. PartialOrd a => a -> a -> Bool
==) t a
xs

-- | Version of the traditional notElem function using the PartialOrd
-- notion of equality.
notElem :: (PartialOrd a, Foldable.Foldable t) => a -> t a -> Bool
notElem :: a -> t a -> Bool
notElem a
x t a
xs = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> t a -> Bool
forall a (t :: * -> *).
(PartialOrd a, Foldable t) =>
a -> t a -> Bool
elem a
x t a
xs

-- | Version of the traditional nub function using the PartialOrd
-- notion of equality.
nub :: PartialOrd a => [a] -> [a]
nub :: [a] -> [a]
nub [a]
as = [a] -> [a]
forall a. [a] -> [a]
List.reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' [a] -> a -> [a]
forall a. PartialOrd a => [a] -> a -> [a]
collect [] [a]
as
  where collect :: [a] -> a -> [a]
collect [a]
uniques a
a =
          if a
a a -> [a] -> Bool
forall a (t :: * -> *).
(PartialOrd a, Foldable t) =>
a -> t a -> Bool
`elem` [a]
uniques
          then [a]
uniques
          else a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
uniques