{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
module Foundation.Collection.Collection
( Collection(..)
, 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
nonEmpty :: Collection c => c -> Maybe (NonEmpty c)
nonEmpty :: c -> Maybe (NonEmpty c)
nonEmpty c
c
| c -> Bool
forall c. Collection c => c -> Bool
null c
c = Maybe (NonEmpty c)
forall a. Maybe a
Nothing
| Bool
otherwise = NonEmpty c -> Maybe (NonEmpty c)
forall a. a -> Maybe a
Just (c -> NonEmpty c
forall a. a -> NonEmpty a
NonEmpty c
c)
nonEmpty_ :: Collection c => c -> NonEmpty c
nonEmpty_ :: c -> NonEmpty c
nonEmpty_ c
c
| c -> Bool
forall c. Collection c => c -> Bool
null c
c = NonEmptyCollectionIsEmpty -> NonEmpty c
forall a e. Exception e => e -> a
throw NonEmptyCollectionIsEmpty
NonEmptyCollectionIsEmpty
| Bool
otherwise = c -> NonEmpty c
forall a. a -> NonEmpty a
NonEmpty c
c
nonEmptyFmap :: Functor f => (a -> b) -> NonEmpty (f a) -> NonEmpty (f b)
nonEmptyFmap :: (a -> b) -> NonEmpty (f a) -> NonEmpty (f b)
nonEmptyFmap a -> b
f (NonEmpty f a
l) = f b -> NonEmpty (f b)
forall a. a -> NonEmpty a
NonEmpty ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
l)
class (IsList c, Item c ~ Element c) => Collection c where
{-# MINIMAL null, length, (elem | notElem), minimum, maximum, all, any #-}
null :: c -> Bool
length :: c -> CountOf (Element c)
elem :: forall a . (Eq a, a ~ Element c) => Element c -> c -> Bool
elem Element c
e c
col = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Element c
e Element c -> c -> Bool
forall c a.
(Collection c, Eq a, a ~ Element c) =>
Element c -> c -> Bool
`notElem` c
col
notElem :: forall a . (Eq a, a ~ Element c) => Element c -> c -> Bool
notElem Element c
e c
col = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Element c
e Element c -> c -> Bool
forall c a.
(Collection c, Eq a, a ~ Element c) =>
Element c -> c -> Bool
`elem` c
col
maximum :: forall a . (Ord a, a ~ Element c) => NonEmpty c -> Element c
minimum :: forall a . (Ord a, a ~ Element c) => NonEmpty c -> Element c
any :: (Element c -> Bool) -> c -> Bool
all :: (Element c -> Bool) -> c -> Bool
instance Collection [a] where
null :: [a] -> Bool
null = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.List.null
length :: [a] -> CountOf (Element [a])
length = Int -> CountOf a
forall ty. Int -> CountOf ty
CountOf (Int -> CountOf a) -> ([a] -> Int) -> [a] -> CountOf a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length
elem :: Element [a] -> [a] -> Bool
elem = Element [a] -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem
notElem :: Element [a] -> [a] -> Bool
notElem = Element [a] -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.notElem
minimum :: NonEmpty [a] -> Element [a]
minimum = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.minimum ([a] -> a) -> (NonEmpty [a] -> [a]) -> NonEmpty [a] -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty [a] -> [a]
forall a. NonEmpty a -> a
getNonEmpty
maximum :: NonEmpty [a] -> Element [a]
maximum = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.maximum ([a] -> a) -> (NonEmpty [a] -> [a]) -> NonEmpty [a] -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty [a] -> [a]
forall a. NonEmpty a -> a
getNonEmpty
any :: (Element [a] -> Bool) -> [a] -> Bool
any = (Element [a] -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.any
all :: (Element [a] -> Bool) -> [a] -> Bool
all = (Element [a] -> Bool) -> [a] -> Bool
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 = CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
(==) CountOf ty
0 (CountOf ty -> Bool)
-> (Block ty -> CountOf ty) -> Block ty -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
BLK.length
length :: Block ty -> CountOf (Element (Block ty))
length = Block ty -> CountOf (Element (Block ty))
forall ty. PrimType ty => Block ty -> CountOf ty
BLK.length
elem :: Element (Block ty) -> Block ty -> Bool
elem = Element (Block ty) -> Block ty -> Bool
forall ty. PrimType ty => ty -> Block ty -> Bool
BLK.elem
minimum :: NonEmpty (Block ty) -> Element (Block ty)
minimum = (ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
BLK.foldl1' ty -> ty -> ty
forall a. Ord a => a -> a -> a
min
maximum :: NonEmpty (Block ty) -> Element (Block ty)
maximum = (ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
BLK.foldl1' ty -> ty -> ty
forall a. Ord a => a -> a -> a
max
all :: (Element (Block ty) -> Bool) -> Block ty -> Bool
all = (Element (Block ty) -> Bool) -> Block ty -> Bool
forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Bool
BLK.all
any :: (Element (Block ty) -> Bool) -> Block ty -> Bool
any = (Element (Block ty) -> Bool) -> Block ty -> Bool
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 = UArray ty -> Bool
forall ty. UArray ty -> Bool
UV.null
length :: UArray ty -> CountOf (Element (UArray ty))
length = UArray ty -> CountOf (Element (UArray ty))
forall ty. UArray ty -> CountOf ty
UV.length
elem :: Element (UArray ty) -> UArray ty -> Bool
elem = Element (UArray ty) -> UArray ty -> Bool
forall ty. PrimType ty => ty -> UArray ty -> Bool
UV.elem
minimum :: NonEmpty (UArray ty) -> Element (UArray ty)
minimum = (ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
UV.foldl1' ty -> ty -> ty
forall a. Ord a => a -> a -> a
min
maximum :: NonEmpty (UArray ty) -> Element (UArray ty)
maximum = (ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
UV.foldl1' ty -> ty -> ty
forall a. Ord a => a -> a -> a
max
all :: (Element (UArray ty) -> Bool) -> UArray ty -> Bool
all = (Element (UArray ty) -> Bool) -> UArray ty -> Bool
forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> Bool
UV.all
any :: (Element (UArray ty) -> Bool) -> UArray ty -> Bool
any = (Element (UArray ty) -> Bool) -> UArray ty -> Bool
forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> Bool
UV.any
instance Collection (BA.Array ty) where
null :: Array ty -> Bool
null = Array ty -> Bool
forall ty. Array ty -> Bool
BA.null
length :: Array ty -> CountOf (Element (Array ty))
length = Array ty -> CountOf (Element (Array ty))
forall a. Array a -> CountOf a
BA.length
elem :: Element (Array ty) -> Array ty -> Bool
elem = Element (Array ty) -> Array ty -> Bool
forall ty. Eq ty => ty -> Array ty -> Bool
BA.elem
minimum :: NonEmpty (Array ty) -> Element (Array ty)
minimum = (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty
forall ty. (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty
BA.foldl1' ty -> ty -> ty
forall a. Ord a => a -> a -> a
min
maximum :: NonEmpty (Array ty) -> Element (Array ty)
maximum = (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty
forall ty. (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty
BA.foldl1' ty -> ty -> ty
forall a. Ord a => a -> a -> a
max
all :: (Element (Array ty) -> Bool) -> Array ty -> Bool
all = (Element (Array ty) -> Bool) -> Array ty -> Bool
forall ty. (ty -> Bool) -> Array ty -> Bool
BA.all
any :: (Element (Array ty) -> Bool) -> Array ty -> Bool
any = (Element (Array ty) -> Bool) -> Array ty -> Bool
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
String -> CountOf (Element String)
S.length
elem :: Element String -> String -> Bool
elem = Char -> String -> Bool
Element String -> String -> Bool
S.elem
minimum :: NonEmpty String -> Element String
minimum = [Char] -> Char
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.minimum ([Char] -> Char)
-> (NonEmpty String -> [Char]) -> NonEmpty String -> Char
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> [Char]
forall l. IsList l => l -> [Item l]
toList (String -> [Char])
-> (NonEmpty String -> String) -> NonEmpty String -> [Char]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty String -> String
forall a. NonEmpty a -> a
getNonEmpty
maximum :: NonEmpty String -> Element String
maximum = [Char] -> Char
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Data.List.maximum ([Char] -> Char)
-> (NonEmpty String -> [Char]) -> NonEmpty String -> Char
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> [Char]
forall l. IsList l => l -> [Item l]
toList (String -> [Char])
-> (NonEmpty String -> String) -> NonEmpty String -> [Char]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty String -> String
forall a. NonEmpty a -> a
getNonEmpty
all :: (Element String -> Bool) -> String -> Bool
all = (Char -> Bool) -> String -> Bool
(Element String -> Bool) -> String -> Bool
S.all
any :: (Element String -> Bool) -> String -> Bool
any = (Char -> Bool) -> String -> Bool
(Element String -> 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 = c -> CountOf (Element c)
forall c. Collection c => c -> CountOf (Element c)
length (c -> CountOf (Element c))
-> (NonEmpty c -> c) -> NonEmpty c -> CountOf (Element c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty
elem :: Element (NonEmpty c) -> NonEmpty c -> Bool
elem Element (NonEmpty c)
e = Element c -> c -> Bool
forall c a.
(Collection c, Eq a, a ~ Element c) =>
Element c -> c -> Bool
elem Element c
Element (NonEmpty c)
e (c -> Bool) -> (NonEmpty c -> c) -> NonEmpty c -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty
maximum :: NonEmpty (NonEmpty c) -> Element (NonEmpty c)
maximum = NonEmpty c -> Element c
forall c a.
(Collection c, Ord a, a ~ Element c) =>
NonEmpty c -> Element c
maximum (NonEmpty c -> Element c)
-> (NonEmpty (NonEmpty c) -> NonEmpty c)
-> NonEmpty (NonEmpty c)
-> Element c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty (NonEmpty c) -> NonEmpty c
forall a. NonEmpty a -> a
getNonEmpty
minimum :: NonEmpty (NonEmpty c) -> Element (NonEmpty c)
minimum = NonEmpty c -> Element c
forall c a.
(Collection c, Ord a, a ~ Element c) =>
NonEmpty c -> Element c
minimum (NonEmpty c -> Element c)
-> (NonEmpty (NonEmpty c) -> NonEmpty c)
-> NonEmpty (NonEmpty c)
-> Element c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty (NonEmpty c) -> NonEmpty c
forall a. NonEmpty a -> a
getNonEmpty
all :: (Element (NonEmpty c) -> Bool) -> NonEmpty c -> Bool
all Element (NonEmpty c) -> Bool
p = (Element c -> Bool) -> c -> Bool
forall c. Collection c => (Element c -> Bool) -> c -> Bool
all Element c -> Bool
Element (NonEmpty c) -> Bool
p (c -> Bool) -> (NonEmpty c -> c) -> NonEmpty c -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty
any :: (Element (NonEmpty c) -> Bool) -> NonEmpty c -> Bool
any Element (NonEmpty c) -> Bool
p = (Element c -> Bool) -> c -> Bool
forall c. Collection c => (Element c -> Bool) -> c -> Bool
any Element c -> Bool
Element (NonEmpty c) -> Bool
p (c -> Bool) -> (NonEmpty c -> c) -> NonEmpty c -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty
and :: (Collection col, Element col ~ Bool) => col -> Bool
and :: col -> Bool
and = (Element col -> Bool) -> col -> Bool
forall c. Collection c => (Element c -> Bool) -> c -> Bool
all (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True)
or :: (Collection col, Element col ~ Bool) => col -> Bool
or :: col -> Bool
or = (Element col -> Bool) -> col -> Bool
forall c. Collection c => (Element c -> Bool) -> c -> Bool
any (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True)