{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Strict.Vector.Internal where

import Data.Vector                as L
import Data.Strict.Vector.Autogen as S

import Data.Binary
import Data.Foldable.WithIndex
import Data.Functor.WithIndex
import Data.Traversable.WithIndex
import Data.Semigroup (Semigroup (..)) -- helps with compatibility
import Data.Strict.Classes
import Data.Vector.Binary

instance Strict (L.Vector k) (S.Vector k) where
  toStrict :: Vector k -> Vector k
toStrict = [k] -> Vector k
forall a. [a] -> Vector a
S.fromList ([k] -> Vector k) -> (Vector k -> [k]) -> Vector k -> Vector k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector k -> [k]
forall a. Vector a -> [a]
L.toList
  toLazy :: Vector k -> Vector k
toLazy = [k] -> Vector k
forall a. [a] -> Vector a
L.fromList ([k] -> Vector k) -> (Vector k -> [k]) -> Vector k -> Vector k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector k -> [k]
forall a. Vector a -> [a]
S.toList
  {-# INLINE toStrict #-}
  {-# INLINE toLazy #-}

-- code copied from indexed-traversable-instances

instance FunctorWithIndex Int S.Vector where
  imap :: (Int -> a -> b) -> Vector a -> Vector b
imap = (Int -> a -> b) -> Vector a -> Vector b
forall a b. (Int -> a -> b) -> Vector a -> Vector b
S.imap
  {-# INLINE imap #-}

instance FoldableWithIndex Int S.Vector where
  ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b
ifoldr = (Int -> a -> b -> b) -> b -> Vector a -> b
forall a b. (Int -> a -> b -> b) -> b -> Vector a -> b
S.ifoldr
  {-# INLINE ifoldr #-}
  ifoldl :: (Int -> b -> a -> b) -> b -> Vector a -> b
ifoldl = (b -> Int -> a -> b) -> b -> Vector a -> b
forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
S.ifoldl ((b -> Int -> a -> b) -> b -> Vector a -> b)
-> ((Int -> b -> a -> b) -> b -> Int -> a -> b)
-> (Int -> b -> a -> b)
-> b
-> Vector a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> b -> a -> b) -> b -> Int -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
  {-# INLINE ifoldl #-}
  ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b
ifoldr' = (Int -> a -> b -> b) -> b -> Vector a -> b
forall a b. (Int -> a -> b -> b) -> b -> Vector a -> b
S.ifoldr'
  {-# INLINE ifoldr' #-}
  ifoldl' :: (Int -> b -> a -> b) -> b -> Vector a -> b
ifoldl' = (b -> Int -> a -> b) -> b -> Vector a -> b
forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
S.ifoldl' ((b -> Int -> a -> b) -> b -> Vector a -> b)
-> ((Int -> b -> a -> b) -> b -> Int -> a -> b)
-> (Int -> b -> a -> b)
-> b
-> Vector a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> b -> a -> b) -> b -> Int -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
  {-# INLINE ifoldl' #-}

instance TraversableWithIndex Int S.Vector where
  itraverse :: (Int -> a -> f b) -> Vector a -> f (Vector b)
itraverse Int -> a -> f b
f Vector a
v =
    let !n :: Int
n = Vector a -> Int
forall a. Vector a -> Int
S.length Vector a
v in Int -> [b] -> Vector b
forall a. Int -> [a] -> Vector a
S.fromListN Int
n ([b] -> Vector b) -> f [b] -> f (Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f b) -> [a] -> f [b]
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse Int -> a -> f b
f (Vector a -> [a]
forall a. Vector a -> [a]
S.toList Vector a
v)
  {-# INLINE itraverse #-}

-- code copied from vector-binary-instances

instance Binary a => Binary (S.Vector a) where
    put :: Vector a -> Put
put = Vector a -> Put
forall (v :: * -> *) a. (Vector v a, Binary a) => v a -> Put
genericPutVector
    get :: Get (Vector a)
get = Get (Vector a)
forall (v :: * -> *) a. (Vector v a, Binary a) => Get (v a)
genericGetVector
    {-# INLINE get #-}