-- |
-- Module      : Conjure.Utils
-- Copyright   : (c) 2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- An internal module of 'Conjure'.
-- This exports 'Data.List', 'Data.Maybe', 'Data.Function'
-- and a few other simple utitilites.
{-# LANGUAGE CPP #-}
module Conjure.Utils
  ( module Data.List
  , module Data.Function
  , module Data.Maybe
  , module Data.Monoid
  , module Data.Tuple
  , module Data.Typeable

  , count

  , fromLeft
  , fromRight
  , elemBy
  , listEq
  , listOrd
  , maybeEq
  , maybeOrd
  , eitherEq
  , eitherOrd
  , pairEq
  , pairOrd
  , tripleEq
  , tripleOrd
  , quadrupleEq
  , quadrupleOrd
  )
where

import Data.List
import Data.Function
import Data.Maybe
import Data.Monoid
import Data.Tuple
import Data.Typeable

count :: (a -> Bool) -> [a] -> Int
count :: (a -> Bool) -> [a] -> Int
count a -> Bool
p  =  [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p

mapHead :: (a -> a) -> [a] -> [a]
mapHead :: (a -> a) -> [a] -> [a]
mapHead a -> a
f (a
x:[a]
xs)  =  a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
mapHead a -> a
_ []  =  [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"Conjure.Utils.mapHead: empty list"

-- note these versions of fromLeft and fromRight differ from the ones of
-- Data.Either since 4.10.0.0.
fromLeft :: Either a b -> a
fromLeft :: Either a b -> a
fromLeft (Left a
x) = a
x
fromLeft Either a b
_        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"fromLeft: not a left"

fromRight :: Either a b -> b
fromRight :: Either a b -> b
fromRight (Right b
x) = b
x
fromRight Either a b
_         = [Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"fromRight: not a right"

elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy a -> a -> Bool
(==) a
x = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> a -> Bool
== a
x)

listEq :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq a -> a -> Bool
(==) []     []     = Bool
True
listEq a -> a -> Bool
(==) (a
x:[a]
xs) []     = Bool
False
listEq a -> a -> Bool
(==) []     (a
y:[a]
ys) = Bool
False
listEq a -> a -> Bool
(==) (a
x:[a]
xs) (a
y:[a]
ys) = a
x a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& (a -> a -> Bool) -> [a] -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq a -> a -> Bool
(==) [a]
xs [a]
ys

listOrd :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd a -> a -> Bool
(<=) []     []     = Bool
True
listOrd a -> a -> Bool
(<=) (a
x:[a]
xs) []     = Bool
False
listOrd a -> a -> Bool
(<=) []     (a
y:[a]
ys) = Bool
True
listOrd a -> a -> Bool
(<=) (a
x:[a]
xs) (a
y:[a]
ys) = a
x a -> a -> Bool
<  a
y
                          Bool -> Bool -> Bool
|| a
x a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& (a -> a -> Bool) -> [a] -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd a -> a -> Bool
(<=) [a]
xs [a]
ys
  where
  a
x < :: a -> a -> Bool
<  a
y = a
x a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<= a
x)
  a
x == :: a -> a -> Bool
== a
y = a
x a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&&      a
y a -> a -> Bool
<= a
x

maybeEq :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeEq :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeEq a -> a -> Bool
(==) Maybe a
Nothing  Maybe a
Nothing  = Bool
True
maybeEq a -> a -> Bool
(==) Maybe a
Nothing  (Just a
y) = Bool
False
maybeEq a -> a -> Bool
(==) (Just a
x) Maybe a
Nothing  = Bool
False
maybeEq a -> a -> Bool
(==) (Just a
x) (Just a
y) = a
x a -> a -> Bool
== a
y

maybeOrd :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeOrd :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeOrd a -> a -> Bool
(<=) Maybe a
Nothing  Maybe a
Nothing  = Bool
True
maybeOrd a -> a -> Bool
(<=) Maybe a
Nothing  (Just a
y) = Bool
True
maybeOrd a -> a -> Bool
(<=) (Just a
x) Maybe a
Nothing  = Bool
False
maybeOrd a -> a -> Bool
(<=) (Just a
x) (Just a
y) = a
x a -> a -> Bool
<= a
y

eitherEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherEq :: (a -> a -> Bool)
-> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherEq a -> a -> Bool
(==) b -> b -> Bool
_ (Left  a
x) (Left  a
y) = a
x a -> a -> Bool
== a
y
eitherEq a -> a -> Bool
_ b -> b -> Bool
(==) (Right b
x) (Right b
y) = b
x b -> b -> Bool
== b
y
eitherEq a -> a -> Bool
_ b -> b -> Bool
_ Either a b
_ Either a b
_ = Bool
False

eitherOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherOrd :: (a -> a -> Bool)
-> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherOrd a -> a -> Bool
(<=) b -> b -> Bool
_ (Left  a
x) (Left  a
y) = a
x a -> a -> Bool
<= a
y
eitherOrd a -> a -> Bool
_ b -> b -> Bool
(<=) (Right b
x) (Right b
y) = b
x b -> b -> Bool
<= b
y
eitherOrd a -> a -> Bool
_    b -> b -> Bool
_ (Left  a
_) (Right b
_) = Bool
True
eitherOrd a -> a -> Bool
_    b -> b -> Bool
_ (Right b
_) (Left  a
_) = Bool
False

pairEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a,b) -> (a,b) -> Bool
pairEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairEq a -> a -> Bool
(==.) b -> b -> Bool
(.==) (a
x1,b
y1) (a
x2,b
y2) = a
x1 a -> a -> Bool
==. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.== b
y2

pairOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a,b) -> (a,b) -> Bool
pairOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairOrd a -> a -> Bool
(<=.) b -> b -> Bool
(.<=) (a
x1,b
y1) (a
x2,b
y2) = a
x1 a -> a -> Bool
<. a
x2
                                   Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.<= b
y2
  where
  a
x <. :: a -> a -> Bool
<.  a
y = a
x a -> a -> Bool
<=. a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=. a
x)
  a
x ==. :: a -> a -> Bool
==. a
y = a
x a -> a -> Bool
<=. a
y Bool -> Bool -> Bool
&&      a
y a -> a -> Bool
<=. a
x

tripleEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (c -> c -> Bool)
         -> (a,b,c) -> (a,b,c) -> Bool
tripleEq :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleEq a -> a -> Bool
(==..) b -> b -> Bool
(.==.) c -> c -> Bool
(..==) (a
x1,b
y1,c
z1) (a
x2,b
y2,c
z2) =
  a
x1 a -> a -> Bool
==.. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==. b
y2 Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..== c
z2

tripleOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (c -> c -> Bool)
          -> (a,b,c) -> (a,b,c) -> Bool
tripleOrd :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleOrd a -> a -> Bool
(<=..) b -> b -> Bool
(.<=.) c -> c -> Bool
(..<=) (a
x1,b
y1,c
z1) (a
x2,b
y2,c
z2) =
  a
x1 a -> a -> Bool
<.. a
x2 Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==.. a
x2 Bool -> Bool -> Bool
&& (b -> b -> Bool) -> (c -> c -> Bool) -> (b, c) -> (b, c) -> Bool
forall a b.
(a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairOrd b -> b -> Bool
(.<=.) c -> c -> Bool
(..<=) (b
y1,c
z1) (b
y2,c
z2)
  where
  a
x <.. :: a -> a -> Bool
<..  a
y = a
x a -> a -> Bool
<=.. a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=.. a
x)
  a
x ==.. :: a -> a -> Bool
==.. a
y = a
x a -> a -> Bool
<=.. a
y Bool -> Bool -> Bool
&&      a
y a -> a -> Bool
<=.. a
x

quadrupleEq :: (a->a->Bool) -> (b->b->Bool) -> (c->c->Bool) -> (d->d->Bool)
            -> (a,b,c,d) -> (a,b,c,d) -> Bool
quadrupleEq :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (a, b, c, d)
-> (a, b, c, d)
-> Bool
quadrupleEq a -> a -> Bool
(==...) b -> b -> Bool
(.==..) c -> c -> Bool
(..==.) d -> d -> Bool
(...==) (a
x1,b
y1,c
z1,d
w1) (a
x2,b
y2,c
z2,d
w2) =
  a
x1 a -> a -> Bool
==... a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==.. b
y2 Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..==. c
z2 Bool -> Bool -> Bool
&& d
w1 d -> d -> Bool
...== d
w2

quadrupleOrd :: (a->a->Bool) -> (b->b->Bool) -> (c->c->Bool) -> (d->d->Bool)
             -> (a,b,c,d) -> (a,b,c,d) -> Bool
quadrupleOrd :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (a, b, c, d)
-> (a, b, c, d)
-> Bool
quadrupleOrd a -> a -> Bool
(<=...) b -> b -> Bool
(.<=..) c -> c -> Bool
(..<=.) d -> d -> Bool
(...<=) (a
x1,b
y1,c
z1,d
w1) (a
x2,b
y2,c
z2,d
w2) =
  a
x1 a -> a -> Bool
<... a
x2 Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==... a
x2 Bool -> Bool -> Bool
&& (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (b, c, d)
-> (b, c, d)
-> Bool
forall a b c.
(a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleOrd b -> b -> Bool
(.<=..) c -> c -> Bool
(..<=.) d -> d -> Bool
(...<=) (b
y1,c
z1,d
w1) (b
y2,c
z2,d
w2)
  where
  a
x <... :: a -> a -> Bool
<...  a
y = a
x a -> a -> Bool
<=... a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=... a
x)
  a
x ==... :: a -> a -> Bool
==... a
y = a
x a -> a -> Bool
<=... a
y Bool -> Bool -> Bool
&&      a
y a -> a -> Bool
<=... a
x