{-# LANGUAGE FlexibleInstances #-}

module HaskellWorks.Data.Vector.AsVector8
  ( AsVector8(..)
  ) where

import Data.Word

import qualified Data.ByteString          as BS
import qualified Data.ByteString.Internal as BSI
import qualified Data.Vector.Storable     as DVS

class AsVector8 a where
  asVector8 :: a -> DVS.Vector Word8

instance AsVector8 (DVS.Vector Word8) where
  asVector8 :: Vector Word8 -> Vector Word8
asVector8 = forall a. a -> a
id
  {-# INLINE asVector8 #-}

instance AsVector8 (DVS.Vector Word16) where
  asVector8 :: Vector Word16 -> Vector Word8
asVector8 = forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast
  {-# INLINE asVector8 #-}

instance AsVector8 (DVS.Vector Word32) where
  asVector8 :: Vector Word32 -> Vector Word8
asVector8 = forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast
  {-# INLINE asVector8 #-}

instance AsVector8 (DVS.Vector Word64) where
  asVector8 :: Vector Word64 -> Vector Word8
asVector8 = forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast
  {-# INLINE asVector8 #-}

instance AsVector8 BS.ByteString where
  asVector8 :: ByteString -> Vector Word8
asVector8 ByteString
bs = case ByteString -> (ForeignPtr Word8, Int, Int)
BSI.toForeignPtr ByteString
bs of
    (ForeignPtr Word8
fptr, Int
start, Int
offset) -> forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
DVS.unsafeFromForeignPtr ForeignPtr Word8
fptr Int
start Int
offset
  {-# INLINE asVector8 #-}