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

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

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

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 => Take v where
  take :: Count -> v -> v

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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