{-# 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 .< i = case e <.=> i of {LT -> True; _ -> False} e .> i = case e <.=> i of {GT -> True; _ -> False} e .<= i = case e <.=> i of {GT -> False; _ -> True} e .>= i = case e <.=> i of {LT -> False; _ -> True} e .== i = case e <.=> i of {EQ -> True; _ -> False} e ./= i = case e <.=> i of {EQ -> False; _ -> True} e1 .<. e2 = case e1 <==> e2 of {LT -> True; _ -> False} e1 .>. e2 = case e1 <==> e2 of {GT -> True; _ -> False} e1 .<=. e2 = case e1 <==> e2 of {GT -> False; _ -> True} e1 .>=. e2 = case e1 <==> e2 of {LT -> False; _ -> True} e1 .==. e2 = case e1 <==> e2 of {EQ -> True; _ -> False} e1 ./=. e2 = case e1 <==> e2 of {EQ -> False; _ -> True} -- | Compare given number with structure length. (<=.>) :: (Estimate e) => Int -> e -> Ordering i <=.> e = case e <.=> i of {LT -> GT; EQ -> EQ; GT -> LT} -- | Compare given number with structure length. (==.), (/=.), (<=.), (>=.), (<.), (>.) :: (Estimate e) => Int -> e -> Bool (==.) = flip (.==) (/=.) = flip (./=) (<=.) = flip (.>=) (>=.) = flip (.<=) (<.) = flip (.>) (>.) = flip (.<) -------------------------------------------------------------------------------- -- | @(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 [] <==> [] = EQ [] <==> _ = LT _ <==> [] = GT xs <==> ys = tail xs <==> tail ys [] <.=> n = 0 <=> n es <.=> n = let go xs c | c == 0 = GT | null xs = 0 <=> c | True = tail xs `go` (c - 1) in if n < 0 then LT else go es n