{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} module HaskellWorks.Data.Cons ( Cons(..) ) 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 v => Cons v where cons :: Elem v -> v -> v instance Cons [a] where cons :: Elem [a] -> [a] -> [a] cons = (:) {-# INLINE cons #-} instance Cons BS.ByteString where cons :: Elem ByteString -> ByteString -> ByteString cons = Word8 -> ByteString -> ByteString Elem ByteString -> ByteString -> ByteString BS.cons {-# INLINE cons #-} instance Cons (DV.Vector Word8) where cons :: Elem (Vector Word8) -> Vector Word8 -> Vector Word8 cons = Elem (Vector Word8) -> Vector Word8 -> Vector Word8 forall a. a -> Vector a -> Vector a DV.cons {-# INLINE cons #-} instance Cons (DV.Vector Word16) where cons :: Elem (Vector Word16) -> Vector Word16 -> Vector Word16 cons = Elem (Vector Word16) -> Vector Word16 -> Vector Word16 forall a. a -> Vector a -> Vector a DV.cons {-# INLINE cons #-} instance Cons (DV.Vector Word32) where cons :: Elem (Vector Word32) -> Vector Word32 -> Vector Word32 cons = Elem (Vector Word32) -> Vector Word32 -> Vector Word32 forall a. a -> Vector a -> Vector a DV.cons {-# INLINE cons #-} instance Cons (DV.Vector Word64) where cons :: Elem (Vector Word64) -> Vector Word64 -> Vector Word64 cons = Elem (Vector Word64) -> Vector Word64 -> Vector Word64 forall a. a -> Vector a -> Vector a DV.cons {-# INLINE cons #-} instance Cons (DVS.Vector Word8) where cons :: Elem (Vector Word8) -> Vector Word8 -> Vector Word8 cons = Elem (Vector Word8) -> Vector Word8 -> Vector Word8 forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-} instance Cons (DVS.Vector Word16) where cons :: Elem (Vector Word16) -> Vector Word16 -> Vector Word16 cons = Elem (Vector Word16) -> Vector Word16 -> Vector Word16 forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-} instance Cons (DVS.Vector Word32) where cons :: Elem (Vector Word32) -> Vector Word32 -> Vector Word32 cons = Elem (Vector Word32) -> Vector Word32 -> Vector Word32 forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-} instance Cons (DVS.Vector Word64) where cons :: Elem (Vector Word64) -> Vector Word64 -> Vector Word64 cons = Elem (Vector Word64) -> Vector Word64 -> Vector Word64 forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-} instance Cons (DV.Vector Int8) where cons :: Elem (Vector Int8) -> Vector Int8 -> Vector Int8 cons = Elem (Vector Int8) -> Vector Int8 -> Vector Int8 forall a. a -> Vector a -> Vector a DV.cons {-# INLINE cons #-} instance Cons (DV.Vector Int16) where cons :: Elem (Vector Int16) -> Vector Int16 -> Vector Int16 cons = Elem (Vector Int16) -> Vector Int16 -> Vector Int16 forall a. a -> Vector a -> Vector a DV.cons {-# INLINE cons #-} instance Cons (DV.Vector Int32) where cons :: Elem (Vector Int32) -> Vector Int32 -> Vector Int32 cons = Elem (Vector Int32) -> Vector Int32 -> Vector Int32 forall a. a -> Vector a -> Vector a DV.cons {-# INLINE cons #-} instance Cons (DV.Vector Int64) where cons :: Elem (Vector Int64) -> Vector Int64 -> Vector Int64 cons = Elem (Vector Int64) -> Vector Int64 -> Vector Int64 forall a. a -> Vector a -> Vector a DV.cons {-# INLINE cons #-} instance Cons (DVS.Vector Int8) where cons :: Elem (Vector Int8) -> Vector Int8 -> Vector Int8 cons = Elem (Vector Int8) -> Vector Int8 -> Vector Int8 forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-} instance Cons (DVS.Vector Int16) where cons :: Elem (Vector Int16) -> Vector Int16 -> Vector Int16 cons = Elem (Vector Int16) -> Vector Int16 -> Vector Int16 forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-} instance Cons (DVS.Vector Int32) where cons :: Elem (Vector Int32) -> Vector Int32 -> Vector Int32 cons = Elem (Vector Int32) -> Vector Int32 -> Vector Int32 forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-} instance Cons (DVS.Vector Int64) where cons :: Elem (Vector Int64) -> Vector Int64 -> Vector Int64 cons = Elem (Vector Int64) -> Vector Int64 -> Vector Int64 forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-} instance Cons (DVS.Vector Int) where cons :: Elem (Vector Int) -> Vector Int -> Vector Int cons = Elem (Vector Int) -> Vector Int -> Vector Int forall a. Storable a => a -> Vector a -> Vector a DVS.cons {-# INLINE cons #-}