{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}

module HaskellWorks.Data.Null
    ( Null(..)
    ) where

import Data.Int
import Data.Word
import HaskellWorks.Data.Container

import qualified Data.ByteString      as BS
import qualified Data.List            as L
import qualified Data.Vector          as DV
import qualified Data.Vector.Storable as DVS

class Container a => Null a where
  null :: a -> Bool

instance Null [a] where
  null :: [a] -> Bool
null = forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null
  {-# INLINE null #-}

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

instance Null (DV.Vector Word8) where
  null :: Vector Word8 -> Bool
null = forall a. Vector a -> Bool
DV.null
  {-# INLINE null #-}

instance Null (DV.Vector Word16) where
  null :: Vector Word16 -> Bool
null = forall a. Vector a -> Bool
DV.null
  {-# INLINE null #-}

instance Null (DV.Vector Word32) where
  null :: Vector Word32 -> Bool
null = forall a. Vector a -> Bool
DV.null
  {-# INLINE null #-}

instance Null (DV.Vector Word64) where
  null :: Vector Word64 -> Bool
null = forall a. Vector a -> Bool
DV.null
  {-# INLINE null #-}

instance Null (DVS.Vector Word8) where
  null :: Vector Word8 -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}

instance Null (DVS.Vector Word16) where
  null :: Vector Word16 -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}

instance Null (DVS.Vector Word32) where
  null :: Vector Word32 -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}

instance Null (DVS.Vector Word64) where
  null :: Vector Word64 -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}

instance Null (DV.Vector Int8) where
  null :: Vector Int8 -> Bool
null = forall a. Vector a -> Bool
DV.null
  {-# INLINE null #-}

instance Null (DV.Vector Int16) where
  null :: Vector Int16 -> Bool
null = forall a. Vector a -> Bool
DV.null
  {-# INLINE null #-}

instance Null (DV.Vector Int32) where
  null :: Vector Int32 -> Bool
null = forall a. Vector a -> Bool
DV.null
  {-# INLINE null #-}

instance Null (DV.Vector Int64) where
  null :: Vector Int64 -> Bool
null = forall a. Vector a -> Bool
DV.null
  {-# INLINE null #-}

instance Null (DVS.Vector Int8) where
  null :: Vector Int8 -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}

instance Null (DVS.Vector Int16) where
  null :: Vector Int16 -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}

instance Null (DVS.Vector Int32) where
  null :: Vector Int32 -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}

instance Null (DVS.Vector Int64) where
  null :: Vector Int64 -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}

instance Null (DVS.Vector Int) where
  null :: Vector Int -> Bool
null = forall a. Storable a => Vector a -> Bool
DVS.null
  {-# INLINE null #-}