1-- |
2-- Module      : Foundation.Collection.Collection
3-- License     : BSD-style
4-- Maintainer  : Foundation
5-- Stability   : experimental
6-- Portability : portable
7--
8-- Provide basic collection information. It's difficult to provide a
9-- unified interface to all sorts of collection, but when creating this
10-- API we had the following types in mind:
11--
12-- * List (e.g [a])
13-- * Array
14-- * Collection of collection (e.g. deque)
15-- * Hashtables, Trees
16--
17-- an API to rules them all, and in the darkness bind them.
18--
19{-# LANGUAGE FlexibleContexts #-}
20{-# LANGUAGE ExistentialQuantification #-}
21{-# LANGUAGE StandaloneDeriving #-}
22{-# LANGUAGE GeneralizedNewtypeDeriving #-}
23module Foundation.Collection.Collection
24    ( Collection(..)
25    -- * NonEmpty Property
26    , NonEmpty
27    , getNonEmpty
28    , nonEmpty
29    , nonEmpty_
30    , nonEmptyFmap
31    , and
32    , or
33    ) where
34
35import           Basement.Compat.Base hiding (and)
36import           Basement.Types.OffsetSize
37import           Basement.Types.AsciiString
38import           Basement.Exception (NonEmptyCollectionIsEmpty(..))
39import           Foundation.Collection.Element
40import           Basement.NonEmpty
41import qualified Data.List
42import qualified Basement.Block as BLK
43import qualified Basement.UArray as UV
44import qualified Basement.BoxedArray as BA
45import qualified Basement.String as S
46
47-- | Smart constructor to create a NonEmpty collection
48--
49-- If the collection is empty, then Nothing is returned
50-- Otherwise, the collection is wrapped in the NonEmpty property
51nonEmpty :: Collection c => c -> Maybe (NonEmpty c)
52nonEmpty c
53    | null c    = Nothing
54    | otherwise = Just (NonEmpty c)
55
56-- | same as 'nonEmpty', but assume that the collection is non empty,
57-- and return an asynchronous error if it is.
58nonEmpty_ :: Collection c => c -> NonEmpty c
59nonEmpty_ c
60    | null c    = throw NonEmptyCollectionIsEmpty
61    | otherwise = NonEmpty c
62
63nonEmptyFmap :: Functor f => (a -> b) -> NonEmpty (f a) -> NonEmpty (f b)
64nonEmptyFmap f (NonEmpty l) = NonEmpty (fmap f l)
65
66-- | A set of methods for ordered colection
67class (IsList c, Item c ~ Element c) => Collection c where
68    {-# MINIMAL null, length, (elem | notElem), minimum, maximum, all, any #-}
69    -- | Check if a collection is empty
70    null :: c -> Bool
71
72    -- | Length of a collection (number of Element c)
73    length :: c -> CountOf (Element c)
74
75    -- | Check if a collection contains a specific element
76    --
77    -- This is the inverse of `notElem`.
78    elem :: forall a . (Eq a, a ~ Element c) => Element c -> c -> Bool
79    elem e col = not $ e `notElem` col
80    -- | Check if a collection does *not* contain a specific element
81    --
82    -- This is the inverse of `elem`.
83    notElem :: forall a . (Eq a, a ~ Element c) => Element c -> c -> Bool
84    notElem e col = not $ e `elem` col
85
86    -- | Get the maximum element of a collection
87    maximum :: forall a . (Ord a, a ~ Element c) => NonEmpty c -> Element c
88    -- | Get the minimum element of a collection
89    minimum :: forall a . (Ord a, a ~ Element c) => NonEmpty c -> Element c
90
91    -- | Determine is any elements of the collection satisfy the predicate
92    any :: (Element c -> Bool) -> c -> Bool
93
94    -- | Determine is all elements of the collection satisfy the predicate
95    all :: (Element c -> Bool) -> c -> Bool
96
97instance Collection [a] where
98    null = Data.List.null
99    length = CountOf . Data.List.length
100
101    elem = Data.List.elem
102    notElem = Data.List.notElem
103
104    minimum = Data.List.minimum . getNonEmpty
105    maximum = Data.List.maximum . getNonEmpty
106
107    any = Data.List.any
108    all = Data.List.all
109
110instance UV.PrimType ty => Collection (BLK.Block ty) where
111    null = (==) 0 . BLK.length
112    length = BLK.length
113    elem = BLK.elem
114    minimum = BLK.foldl1' min
115    maximum = BLK.foldl1' max
116    all = BLK.all
117    any = BLK.any
118
119instance UV.PrimType ty => Collection (UV.UArray ty) where
120    null    = UV.null
121    length  = UV.length
122    elem    = UV.elem
123    minimum = UV.foldl1' min
124    maximum = UV.foldl1' max
125    all     = UV.all
126    any     = UV.any
127
128
129instance Collection (BA.Array ty) where
130    null    = BA.null
131    length  = BA.length
132    elem    = BA.elem
133    minimum = BA.foldl1' min
134    maximum = BA.foldl1' max
135    all     = BA.all
136    any     = BA.any
137
138deriving instance Collection AsciiString
139
140instance Collection S.String where
141    null = S.null
142    length = S.length
143    elem = S.elem
144    minimum = Data.List.minimum . toList . getNonEmpty -- TODO faster implementation
145    maximum = Data.List.maximum . toList . getNonEmpty -- TODO faster implementation
146    all = S.all
147    any = S.any
148
149instance Collection c => Collection (NonEmpty c) where
150    null _ = False
151    length = length . getNonEmpty
152    elem e = elem e . getNonEmpty
153    maximum = maximum . getNonEmpty
154    minimum = minimum . getNonEmpty
155    all p = all p . getNonEmpty
156    any p = any p . getNonEmpty
157
158-- | Return True if all the elements in the collection are True
159and :: (Collection col, Element col ~ Bool) => col -> Bool
160and = all (== True)
161
162-- | Return True if at least one element in the collection is True
163or :: (Collection col, Element col ~ Bool) => col -> Bool
164or = any (== True)
165