{-# LANGUAGE Safe, CPP, ConstraintKinds #-}

#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints, RankNTypes #-}
#endif

{- |
    Module      :  SDP.Estimate
    Copyright   :  (c) Andrey Mulik 2019-2021
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    "SDP.Estimate" provides 'Estimate' class, type synonyms and some common
    comparators. This module is exported by "SDP.SafePrelude".
-}
module SDP.Estimate
(
  -- * Exports
  module Data.Functor.Classes,
  
  -- * Estimate
  Estimate (..), Estimate1, Estimate2,
  
#if __GLASGOW_HASKELL__ >= 806
  -- ** Rank 2 quantified constraints
  -- | GHC 8.6.1+ only
  Estimate', Estimate'',
#endif
  
  -- ** Right-side Estimate functions.
  (<=.>), (<.), (>.), (<=.), (>=.), (==.), (/=.)
)
where

import Data.Functor.Classes

import SDP.Comparing

default ()

infixl 4 <==>, .<., .>., .<=., .>=., .==., ./=.

infixl 4 <.=>, .<, .>, .<=, .>=, .==, ./=
infixl 4 <=.>, <., >., <=., >=., ==., /=.

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

{- |
  'Estimate' class provides the lazy comparsion structures by length.
  
  For some types (e.g., lists), this allows you to speed up the comparison or
  make it finite. For others (e.g., arrays), it may be convenient abbreviation.
-}
class Estimate e
  where
    {-# MINIMAL (<.=>), (<==>) #-}
    
    -- | Compare structure length with given number.
    (<.=>) :: e -> Int -> Ordering
    
    -- | Compare pair of structures by length.
    (<==>) :: Compare e
    
    -- | Compare structure length with given number.
    (.==), (./=), (.<=), (.>=), (.<), (.>) :: e -> Int -> Bool
    
    -- | Compare pair of structures by length.
    (.<.), (.>.), (.<=.), (.>=.), (.==.), (./=.) :: e -> e -> Bool
    
    e
e .<  Int
i = case e
e e -> Int -> Ordering
forall e. Estimate e => e -> Int -> Ordering
<.=> Int
i of {Ordering
LT -> Bool
True; Ordering
_ -> Bool
False}
    e
e .>  Int
i = case e
e e -> Int -> Ordering
forall e. Estimate e => e -> Int -> Ordering
<.=> Int
i of {Ordering
GT -> Bool
True; Ordering
_ -> Bool
False}
    e
e .<= Int
i = case e
e e -> Int -> Ordering
forall e. Estimate e => e -> Int -> Ordering
<.=> Int
i of {Ordering
GT -> Bool
False; Ordering
_ -> Bool
True}
    e
e .>= Int
i = case e
e e -> Int -> Ordering
forall e. Estimate e => e -> Int -> Ordering
<.=> Int
i of {Ordering
LT -> Bool
False; Ordering
_ -> Bool
True}
    e
e .== Int
i = case e
e e -> Int -> Ordering
forall e. Estimate e => e -> Int -> Ordering
<.=> Int
i of {Ordering
EQ -> Bool
True; Ordering
_ -> Bool
False}
    e
e ./= Int
i = case e
e e -> Int -> Ordering
forall e. Estimate e => e -> Int -> Ordering
<.=> Int
i of {Ordering
EQ -> Bool
False; Ordering
_ -> Bool
True}
    
    e
e1 .<.  e
e2 = case e
e1 Compare e
forall e. Estimate e => Compare e
<==> e
e2 of {Ordering
LT -> Bool
True; Ordering
_ -> Bool
False}
    e
e1 .>.  e
e2 = case e
e1 Compare e
forall e. Estimate e => Compare e
<==> e
e2 of {Ordering
GT -> Bool
True; Ordering
_ -> Bool
False}
    e
e1 .<=. e
e2 = case e
e1 Compare e
forall e. Estimate e => Compare e
<==> e
e2 of {Ordering
GT -> Bool
False; Ordering
_ -> Bool
True}
    e
e1 .>=. e
e2 = case e
e1 Compare e
forall e. Estimate e => Compare e
<==> e
e2 of {Ordering
LT -> Bool
False; Ordering
_ -> Bool
True}
    e
e1 .==. e
e2 = case e
e1 Compare e
forall e. Estimate e => Compare e
<==> e
e2 of {Ordering
EQ -> Bool
True; Ordering
_ -> Bool
False}
    e
e1 ./=. e
e2 = case e
e1 Compare e
forall e. Estimate e => Compare e
<==> e
e2 of {Ordering
EQ -> Bool
False; Ordering
_ -> Bool
True}

-- | Compare given number with structure length.
(<=.>) :: (Estimate e) => Int -> e -> Ordering
Int
i <=.> :: Int -> e -> Ordering
<=.> e
e = case e
e e -> Int -> Ordering
forall e. Estimate e => e -> Int -> Ordering
<.=> Int
i of {Ordering
LT -> Ordering
GT; Ordering
EQ -> Ordering
EQ; Ordering
GT -> Ordering
LT}

-- | Compare given number with structure length.
(==.), (/=.), (<=.), (>=.), (<.), (>.) :: (Estimate e) => Int -> e -> Bool

==. :: Int -> e -> Bool
(==.) = (e -> Int -> Bool) -> Int -> e -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> Int -> Bool
forall e. Estimate e => e -> Int -> Bool
(.==)
/=. :: Int -> e -> Bool
(/=.) = (e -> Int -> Bool) -> Int -> e -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> Int -> Bool
forall e. Estimate e => e -> Int -> Bool
(./=)
<=. :: Int -> e -> Bool
(<=.) = (e -> Int -> Bool) -> Int -> e -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> Int -> Bool
forall e. Estimate e => e -> Int -> Bool
(.>=)
>=. :: Int -> e -> Bool
(>=.) = (e -> Int -> Bool) -> Int -> e -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> Int -> Bool
forall e. Estimate e => e -> Int -> Bool
(.<=)
<. :: Int -> e -> Bool
(<.)  = (e -> Int -> Bool) -> Int -> e -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> Int -> Bool
forall e. Estimate e => e -> Int -> Bool
(.>)
>. :: Int -> e -> Bool
(>.)  = (e -> Int -> Bool) -> Int -> e -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> Int -> Bool
forall e. Estimate e => e -> Int -> Bool
(.<)

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

-- | @(Type -> Type)@ kind 'Estimate'.
type Estimate1 rep e = Estimate (rep e)

-- | @(Type -> Type -> Type)@ kind 'Estimate'.
type Estimate2 rep i e = Estimate (rep i e)

#if __GLASGOW_HASKELL__ >= 806
-- | 'Estimate' quantified contraint for @(Type -> Type)@-kind types.
type Estimate' rep = forall e . Estimate (rep e)

-- | 'Estimate' quantified contraint for @(Type -> Type -> Type)@-kind types.
type Estimate'' rep = forall i e . Estimate (rep i e)
#endif

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

instance Estimate [a]
  where
    [] <==> :: Compare [a]
<==> [] = Ordering
EQ
    [] <==>  [a]
_ = Ordering
LT
    [a]
_  <==> [] = Ordering
GT
    [a]
xs <==> [a]
ys = [a] -> [a]
forall a. [a] -> [a]
tail [a]
xs Compare [a]
forall e. Estimate e => Compare e
<==> [a] -> [a]
forall a. [a] -> [a]
tail [a]
ys
    
    [] <.=> :: [a] -> Int -> Ordering
<.=> Int
n = Int
0 Compare Int
forall o. Ord o => Compare o
<=> Int
n
    [a]
es <.=> Int
n =
      let go :: [a] -> t -> Ordering
go [a]
xs t
c | t
c t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = Ordering
GT | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = t
0 Compare t
forall o. Ord o => Compare o
<=> t
c | Bool
True = [a] -> [a]
forall a. [a] -> [a]
tail [a]
xs [a] -> t -> Ordering
`go` (t
c t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
      in  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Ordering
LT else [a] -> Int -> Ordering
forall t a. (Num t, Ord t) => [a] -> t -> Ordering
go [a]
es Int
n