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

module HaskellWorks.Data.Drop
    ( Container(..)
    , Drop(..)
    ) where

import Data.Int
import Data.Word
import HaskellWorks.Data.Container
import HaskellWorks.Data.Positioning
import Prelude                       hiding (drop)

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 v => Drop v where
  drop :: Count -> v -> v

instance Drop [a] where
  drop :: Count -> [a] -> [a]
drop = forall a. Int -> [a] -> [a]
L.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop BS.ByteString where
  drop :: Count -> ByteString -> ByteString
drop = Int -> ByteString -> ByteString
BS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DV.Vector Word8) where
  drop :: Count -> Vector Word8 -> Vector Word8
drop = forall a. Int -> Vector a -> Vector a
DV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DV.Vector Word16) where
  drop :: Count -> Vector Word16 -> Vector Word16
drop = forall a. Int -> Vector a -> Vector a
DV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DV.Vector Word32) where
  drop :: Count -> Vector Word32 -> Vector Word32
drop = forall a. Int -> Vector a -> Vector a
DV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DV.Vector Word64) where
  drop :: Count -> Vector Count -> Vector Count
drop = forall a. Int -> Vector a -> Vector a
DV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Word8) where
  drop :: Count -> Vector Word8 -> Vector Word8
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Word16) where
  drop :: Count -> Vector Word16 -> Vector Word16
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Word32) where
  drop :: Count -> Vector Word32 -> Vector Word32
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Word64) where
  drop :: Count -> Vector Count -> Vector Count
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DV.Vector Int8) where
  drop :: Count -> Vector Int8 -> Vector Int8
drop = forall a. Int -> Vector a -> Vector a
DV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DV.Vector Int16) where
  drop :: Count -> Vector Int16 -> Vector Int16
drop = forall a. Int -> Vector a -> Vector a
DV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DV.Vector Int32) where
  drop :: Count -> Vector Int32 -> Vector Int32
drop = forall a. Int -> Vector a -> Vector a
DV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DV.Vector Int64) where
  drop :: Count -> Vector Int64 -> Vector Int64
drop = forall a. Int -> Vector a -> Vector a
DV.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Int8) where
  drop :: Count -> Vector Int8 -> Vector Int8
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Int16) where
  drop :: Count -> Vector Int16 -> Vector Int16
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Int32) where
  drop :: Count -> Vector Int32 -> Vector Int32
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Int64) where
  drop :: Count -> Vector Int64 -> Vector Int64
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}

instance Drop (DVS.Vector Int) where
  drop :: Count -> Vector Int -> Vector Int
drop = forall a. Storable a => Int -> Vector a -> Vector a
DVS.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE drop #-}