-- |
-- Module      : Foundation.Collection.Collection
-- License     : BSD-style
-- Maintainer  : Foundation
-- Stability   : experimental
-- Portability : portable
--
-- Provide basic collection information. It's difficult to provide a
-- unified interface to all sorts of collection, but when creating this
-- API we had the following types in mind:
--
-- * List (e.g [a])
-- * Array
-- * Collection of collection (e.g. deque)
-- * Hashtables, Trees
--
-- an API to rules them all, and in the darkness bind them.
--
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
module Foundation.Collection.Collection
    ( Collection(..)
    -- * NonEmpty Property
    , NonEmpty
    , getNonEmpty
    , nonEmpty
    , nonEmpty_
    , nonEmptyFmap
    , and
    , or
    ) where

import           Basement.Compat.Base hiding (and)
import           Basement.Types.OffsetSize
import           Basement.Types.AsciiString
import           Basement.Exception (NonEmptyCollectionIsEmpty(..))
import           Foundation.Collection.Element
import           Basement.NonEmpty
import qualified Data.List
import qualified Basement.Block as BLK
import qualified Basement.UArray as UV
import qualified Basement.BoxedArray as BA
import qualified Basement.String as S

-- | Smart constructor to create a NonEmpty collection
--
-- If the collection is empty, then Nothing is returned
-- Otherwise, the collection is wrapped in the NonEmpty property
nonEmpty :: Collection c => c -> Maybe (NonEmpty c)
nonEmpty :: forall c. Collection c => c -> Maybe (NonEmpty c)
nonEmpty c
c
    | forall c. Collection c => c -> Bool
null c
c    = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. a -> NonEmpty a
NonEmpty c
c)

-- | same as 'nonEmpty', but assume that the collection is non empty,
-- and return an asynchronous error if it is.
nonEmpty_ :: Collection c => c -> NonEmpty c
nonEmpty_ :: forall c. Collection c => c -> NonEmpty c
nonEmpty_ c
c
    | forall c. Collection c => c -> Bool
null c
c    = forall a e. Exception e => e -> a
throw NonEmptyCollectionIsEmpty
NonEmptyCollectionIsEmpty
    | Bool
otherwise = forall a. a -> NonEmpty a
NonEmpty c
c

nonEmptyFmap :: Functor f => (a -> b) -> NonEmpty (f a) -> NonEmpty (f b)
nonEmptyFmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> NonEmpty (f a) -> NonEmpty (f b)
nonEmptyFmap a -> b
f (NonEmpty f a
l) = forall a. a -> NonEmpty a
NonEmpty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
l)

-- | A set of methods for ordered colection
class (IsList c, Item c ~ Element c) => Collection c where
    {-# MINIMAL null, length, (elem | notElem), minimum, maximum, all, any #-}
    -- | Check if a collection is empty
    null :: c -> Bool

    -- | Length of a collection (number of Element c)
    length :: c -> CountOf (Element c)

    -- | Check if a collection contains a specific element
    --
    -- This is the inverse of `notElem`.
    elem :: forall a . (Eq a, a ~ Element c) => Element c -> c -> Bool
    elem Element c
e c
col = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Element c
e forall c a.
(Collection c, Eq a, a ~ Element c) =>
Element c -> c -> Bool
`notElem` c
col
    -- | Check if a collection does *not* contain a specific element
    --
    -- This is the inverse of `elem`.
    notElem :: forall a . (Eq a, a ~ Element c) => Element c -> c -> Bool
    notElem Element c
e c
col = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Element c
e forall c a.
(Collection c, Eq a, a ~ Element c) =>
Element c -> c -> Bool
`elem` c
col

    -- | Get the maximum element of a collection
    maximum :: forall a . (Ord a, a ~ Element c) => NonEmpty c -> Element c
    -- | Get the minimum element of a collection
    minimum :: forall a . (Ord a, a ~ Element c) => NonEmpty c -> Element c

    -- | Determine is any elements of the collection satisfy the predicate
    any :: (Element c -> Bool) -> c -> Bool

    -- | Determine is all elements of the collection satisfy the predicate
    all :: (Element c -> Bool) -> c -> Bool

instance Collection [a] where
    null :: [a] -> Bool
null = forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.List.null
    length :: [a] -> CountOf (Element [a])
length = forall ty. Int -> CountOf ty
CountOf forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length

    elem :: forall a. (Eq a, a ~ Element [a]) => Element [a] -> [a] -> Bool
elem = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem
    notElem :: forall a. (Eq a, a ~ Element [a]) => Element [a] -> [a] -> Bool
notElem = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.notElem

    minimum :: forall a. (Ord a, a ~ Element [a]) => NonEmpty [a] -> Element [a]
minimum = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.minimum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty
    maximum :: forall a. (Ord a, a ~ Element [a]) => NonEmpty [a] -> Element [a]
maximum = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.maximum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty

    any :: (Element [a] -> Bool) -> [a] -> Bool
any = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.any
    all :: (Element [a] -> Bool) -> [a] -> Bool
all = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.all

instance UV.PrimType ty => Collection (BLK.Block ty) where
    null :: Block ty -> Bool
null = forall a. Eq a => a -> a -> Bool
(==) CountOf ty
0 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall ty. PrimType ty => Block ty -> CountOf ty
BLK.length
    length :: Block ty -> CountOf (Element (Block ty))
length = forall ty. PrimType ty => Block ty -> CountOf ty
BLK.length
    elem :: forall a.
(Eq a, a ~ Element (Block ty)) =>
Element (Block ty) -> Block ty -> Bool
elem = forall ty. PrimType ty => ty -> Block ty -> Bool
BLK.elem
    minimum :: forall a.
(Ord a, a ~ Element (Block ty)) =>
NonEmpty (Block ty) -> Element (Block ty)
minimum = forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
BLK.foldl1' forall a. Ord a => a -> a -> a
min
    maximum :: forall a.
(Ord a, a ~ Element (Block ty)) =>
NonEmpty (Block ty) -> Element (Block ty)
maximum = forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
BLK.foldl1' forall a. Ord a => a -> a -> a
max
    all :: (Element (Block ty) -> Bool) -> Block ty -> Bool
all = forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Bool
BLK.all
    any :: (Element (Block ty) -> Bool) -> Block ty -> Bool
any = forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Bool
BLK.any

instance UV.PrimType ty => Collection (UV.UArray ty) where
    null :: UArray ty -> Bool
null    = forall ty. UArray ty -> Bool
UV.null
    length :: UArray ty -> CountOf (Element (UArray ty))
length  = forall ty. UArray ty -> CountOf ty
UV.length
    elem :: forall a.
(Eq a, a ~ Element (UArray ty)) =>
Element (UArray ty) -> UArray ty -> Bool
elem    = forall ty. PrimType ty => ty -> UArray ty -> Bool
UV.elem
    minimum :: forall a.
(Ord a, a ~ Element (UArray ty)) =>
NonEmpty (UArray ty) -> Element (UArray ty)
minimum = forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
UV.foldl1' forall a. Ord a => a -> a -> a
min
    maximum :: forall a.
(Ord a, a ~ Element (UArray ty)) =>
NonEmpty (UArray ty) -> Element (UArray ty)
maximum = forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
UV.foldl1' forall a. Ord a => a -> a -> a
max
    all :: (Element (UArray ty) -> Bool) -> UArray ty -> Bool
all     = forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> Bool
UV.all
    any :: (Element (UArray ty) -> Bool) -> UArray ty -> Bool
any     = forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> Bool
UV.any


instance Collection (BA.Array ty) where
    null :: Array ty -> Bool
null    = forall ty. Array ty -> Bool
BA.null
    length :: Array ty -> CountOf (Element (Array ty))
length  = forall a. Array a -> CountOf a
BA.length
    elem :: forall a.
(Eq a, a ~ Element (Array ty)) =>
Element (Array ty) -> Array ty -> Bool
elem    = forall ty. Eq ty => ty -> Array ty -> Bool
BA.elem
    minimum :: forall a.
(Ord a, a ~ Element (Array ty)) =>
NonEmpty (Array ty) -> Element (Array ty)
minimum = forall ty. (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty
BA.foldl1' forall a. Ord a => a -> a -> a
min
    maximum :: forall a.
(Ord a, a ~ Element (Array ty)) =>
NonEmpty (Array ty) -> Element (Array ty)
maximum = forall ty. (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty
BA.foldl1' forall a. Ord a => a -> a -> a
max
    all :: (Element (Array ty) -> Bool) -> Array ty -> Bool
all     = forall ty. (ty -> Bool) -> Array ty -> Bool
BA.all
    any :: (Element (Array ty) -> Bool) -> Array ty -> Bool
any     = forall ty. (ty -> Bool) -> Array ty -> Bool
BA.any

deriving instance Collection AsciiString

instance Collection S.String where
    null :: String -> Bool
null = String -> Bool
S.null
    length :: String -> CountOf (Element String)
length = String -> CountOf Char
S.length
    elem :: forall a.
(Eq a, a ~ Element String) =>
Element String -> String -> Bool
elem = Char -> String -> Bool
S.elem
    minimum :: forall a.
(Ord a, a ~ Element String) =>
NonEmpty String -> Element String
minimum = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.minimum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall l. IsList l => l -> [Item l]
toList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty -- TODO faster implementation
    maximum :: forall a.
(Ord a, a ~ Element String) =>
NonEmpty String -> Element String
maximum = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.maximum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall l. IsList l => l -> [Item l]
toList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty -- TODO faster implementation
    all :: (Element String -> Bool) -> String -> Bool
all = (Char -> Bool) -> String -> Bool
S.all
    any :: (Element String -> Bool) -> String -> Bool
any = (Char -> Bool) -> String -> Bool
S.any

instance Collection c => Collection (NonEmpty c) where
    null :: NonEmpty c -> Bool
null NonEmpty c
_ = Bool
False
    length :: NonEmpty c -> CountOf (Element (NonEmpty c))
length = forall c. Collection c => c -> CountOf (Element c)
length forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty
    elem :: forall a.
(Eq a, a ~ Element (NonEmpty c)) =>
Element (NonEmpty c) -> NonEmpty c -> Bool
elem Element (NonEmpty c)
e = forall c a.
(Collection c, Eq a, a ~ Element c) =>
Element c -> c -> Bool
elem Element (NonEmpty c)
e forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty
    maximum :: forall a.
(Ord a, a ~ Element (NonEmpty c)) =>
NonEmpty (NonEmpty c) -> Element (NonEmpty c)
maximum = forall c a.
(Collection c, Ord a, a ~ Element c) =>
NonEmpty c -> Element c
maximum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty
    minimum :: forall a.
(Ord a, a ~ Element (NonEmpty c)) =>
NonEmpty (NonEmpty c) -> Element (NonEmpty c)
minimum = forall c a.
(Collection c, Ord a, a ~ Element c) =>
NonEmpty c -> Element c
minimum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty
    all :: (Element (NonEmpty c) -> Bool) -> NonEmpty c -> Bool
all Element (NonEmpty c) -> Bool
p = forall c. Collection c => (Element c -> Bool) -> c -> Bool
all Element (NonEmpty c) -> Bool
p forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty
    any :: (Element (NonEmpty c) -> Bool) -> NonEmpty c -> Bool
any Element (NonEmpty c) -> Bool
p = forall c. Collection c => (Element c -> Bool) -> c -> Bool
any Element (NonEmpty c) -> Bool
p forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. NonEmpty a -> a
getNonEmpty

-- | Return True if all the elements in the collection are True
and :: (Collection col, Element col ~ Bool) => col -> Bool
and :: forall col. (Collection col, Element col ~ Bool) => col -> Bool
and = forall c. Collection c => (Element c -> Bool) -> c -> Bool
all (forall a. Eq a => a -> a -> Bool
== Bool
True)

-- | Return True if at least one element in the collection is True
or :: (Collection col, Element col ~ Bool) => col -> Bool
or :: forall col. (Collection col, Element col ~ Bool) => col -> Bool
or = forall c. Collection c => (Element c -> Bool) -> c -> Bool
any (forall a. Eq a => a -> a -> Bool
== Bool
True)