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