{- 
    Copyright 2013-2015 Mario Blazevic

    License: BSD3 (see BSD3-LICENSE.txt file)
-}

-- | This module defines the MonoidNull class and some of its instances.
-- 

{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}

module Data.Monoid.Null (
   MonoidNull(..), PositiveMonoid
   )
where
   
import Data.Monoid -- (Monoid, First(..), Last(..), Dual(..), Sum(..), Product(..), All(getAll), Any(getAny))
import qualified Data.List as List
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Sequence as Sequence
import qualified Data.Set as Set
import qualified Data.Vector as Vector
import Numeric.Natural (Natural)

import Prelude hiding (null)

-- | Extension of 'Monoid' that allows testing a value for equality with 'mempty'. The following law must hold:
-- 
-- prop> null x == (x == mempty)
-- 
-- Furthermore, the performance of this method should be constant, /i.e./, independent of the length of its argument.
class Monoid m => MonoidNull m where
   null :: m -> Bool

-- | Subclass of 'Monoid' for types whose values have no inverse, with the exception of 'Data.Monoid.mempty'. More
-- formally, the class instances must satisfy the following law:
-- 
-- prop> null (x <> y) == (null x && null y)
class MonoidNull m => PositiveMonoid m

instance MonoidNull () where
   null :: () -> Bool
null () = Bool
True

instance MonoidNull Ordering where
   null :: Ordering -> Bool
null = (Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ)

instance MonoidNull All where
   null :: All -> Bool
null = All -> Bool
getAll

instance MonoidNull Any where
   null :: Any -> Bool
null = Bool -> Bool
not (Bool -> Bool) -> (Any -> Bool) -> Any -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Bool
getAny

instance MonoidNull (First a) where
   null :: First a -> Bool
null (First Maybe a
Nothing) = Bool
True
   null First a
_ = Bool
False

instance MonoidNull (Last a) where
   null :: Last a -> Bool
null (Last Maybe a
Nothing) = Bool
True
   null Last a
_ = Bool
False

instance MonoidNull a => MonoidNull (Dual a) where
   null :: Dual a -> Bool
null (Dual a
a) = a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a

instance (Num a, Eq a) => MonoidNull (Sum a) where
   null :: Sum a -> Bool
null (Sum a
a) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0

instance (Num a, Eq a) => MonoidNull (Product a) where
   null :: Product a -> Bool
null (Product a
a) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1

instance Monoid a => MonoidNull (Maybe a) where
   null :: Maybe a -> Bool
null Maybe a
Nothing = Bool
True
   null Maybe a
_ = Bool
False

instance (MonoidNull a, MonoidNull b) => MonoidNull (a, b) where
   null :: (a, b) -> Bool
null (a
a, b
b) = a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a Bool -> Bool -> Bool
&& b -> Bool
forall m. MonoidNull m => m -> Bool
null b
b

instance (MonoidNull a, MonoidNull b, MonoidNull c) => MonoidNull (a, b, c) where
   null :: (a, b, c) -> Bool
null (a
a, b
b, c
c) = a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a Bool -> Bool -> Bool
&& b -> Bool
forall m. MonoidNull m => m -> Bool
null b
b Bool -> Bool -> Bool
&& c -> Bool
forall m. MonoidNull m => m -> Bool
null c
c

instance (MonoidNull a, MonoidNull b, MonoidNull c, MonoidNull d) => MonoidNull (a, b, c, d) where
   null :: (a, b, c, d) -> Bool
null (a
a, b
b, c
c, d
d) = a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a Bool -> Bool -> Bool
&& b -> Bool
forall m. MonoidNull m => m -> Bool
null b
b Bool -> Bool -> Bool
&& c -> Bool
forall m. MonoidNull m => m -> Bool
null c
c Bool -> Bool -> Bool
&& d -> Bool
forall m. MonoidNull m => m -> Bool
null d
d

instance MonoidNull [x] where
   null :: [x] -> Bool
null = [x] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null

instance MonoidNull ByteString.ByteString where
   null :: ByteString -> Bool
null = ByteString -> Bool
ByteString.null
   {-# INLINE null #-}

instance MonoidNull LazyByteString.ByteString where
   null :: ByteString -> Bool
null = ByteString -> Bool
LazyByteString.null
   {-# INLINE null #-}

instance MonoidNull Text.Text where
   null :: Text -> Bool
null = Text -> Bool
Text.null
   {-# INLINE null #-}

instance MonoidNull LazyText.Text where
   null :: Text -> Bool
null = Text -> Bool
LazyText.null
   {-# INLINE null #-}

instance Ord k => MonoidNull (Map.Map k v) where
   null :: Map k v -> Bool
null = Map k v -> Bool
forall k a. Map k a -> Bool
Map.null

instance MonoidNull (IntMap.IntMap v) where
   null :: IntMap v -> Bool
null = IntMap v -> Bool
forall v. IntMap v -> Bool
IntMap.null

instance MonoidNull IntSet.IntSet where
   null :: IntSet -> Bool
null = IntSet -> Bool
IntSet.null

instance MonoidNull (Sequence.Seq a) where
   null :: Seq a -> Bool
null = Seq a -> Bool
forall a. Seq a -> Bool
Sequence.null

instance Ord a => MonoidNull (Set.Set a) where
   null :: Set a -> Bool
null = Set a -> Bool
forall a. Set a -> Bool
Set.null

instance MonoidNull (Vector.Vector a) where
   null :: Vector a -> Bool
null = Vector a -> Bool
forall a. Vector a -> Bool
Vector.null

instance PositiveMonoid ()
instance PositiveMonoid Ordering
instance PositiveMonoid All
instance PositiveMonoid Any
instance PositiveMonoid ByteString.ByteString
instance PositiveMonoid LazyByteString.ByteString
instance PositiveMonoid Text.Text
instance PositiveMonoid LazyText.Text
instance PositiveMonoid (Product Natural)
instance PositiveMonoid (Sum Natural)
instance Monoid a => PositiveMonoid (Maybe a)
instance PositiveMonoid (First a)
instance PositiveMonoid (Last a)
instance PositiveMonoid a => PositiveMonoid (Dual a)
instance PositiveMonoid [x]
instance Ord k => PositiveMonoid (Map.Map k v)
instance PositiveMonoid (IntMap.IntMap v)
instance PositiveMonoid IntSet.IntSet
instance PositiveMonoid (Sequence.Seq a)
instance Ord a => PositiveMonoid (Set.Set a)
instance PositiveMonoid (Vector.Vector a)

-- The possible tuple instances would be overlapping, so we leave the choice to the user.
--
-- instance (PositiveMonoid a, Monoid b) => PositiveMonoid (a, b)
-- instance (Monoid a, PositiveMonoid b) => PositiveMonoid (a, b)