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

module HaskellWorks.Data.Empty
    ( Empty(..)
    ) where

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

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

class Container a => Empty a where
  empty :: a

instance Empty [a] where
  empty :: [a]
empty = []
  {-# INLINE empty #-}

instance Empty BS.ByteString where
  empty :: ByteString
empty = ByteString
BS.empty
  {-# INLINE empty #-}

instance Empty (DV.Vector Word8) where
  empty :: Vector Word8
empty = forall a. Vector a
DV.empty
  {-# INLINE empty #-}

instance Empty (DV.Vector Word16) where
  empty :: Vector Word16
empty = forall a. Vector a
DV.empty
  {-# INLINE empty #-}

instance Empty (DV.Vector Word32) where
  empty :: Vector Word32
empty = forall a. Vector a
DV.empty
  {-# INLINE empty #-}

instance Empty (DV.Vector Word64) where
  empty :: Vector Word64
empty = forall a. Vector a
DV.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Word8) where
  empty :: Vector Word8
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Word16) where
  empty :: Vector Word16
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Word32) where
  empty :: Vector Word32
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Word64) where
  empty :: Vector Word64
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}

instance Empty (DV.Vector Int8) where
  empty :: Vector Int8
empty = forall a. Vector a
DV.empty
  {-# INLINE empty #-}

instance Empty (DV.Vector Int16) where
  empty :: Vector Int16
empty = forall a. Vector a
DV.empty
  {-# INLINE empty #-}

instance Empty (DV.Vector Int32) where
  empty :: Vector Int32
empty = forall a. Vector a
DV.empty
  {-# INLINE empty #-}

instance Empty (DV.Vector Int64) where
  empty :: Vector Int64
empty = forall a. Vector a
DV.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Int8) where
  empty :: Vector Int8
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Int16) where
  empty :: Vector Int16
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Int32) where
  empty :: Vector Int32
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Int64) where
  empty :: Vector Int64
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}

instance Empty (DVS.Vector Int) where
  empty :: Vector Int
empty = forall a. Storable a => Vector a
DVS.empty
  {-# INLINE empty #-}