{-# LANGUAGE BangPatterns           #-}
{-# LANGUAGE CPP                    #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy            #-}
#endif

#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds              #-}
#endif
-- | Extra instances for 'FunctorWithIndex', 'FoldableWithIndex',
-- and 'TraversableWithIndex' type classes.
module Data.Functor.WithIndex.Instances () where

import Prelude (Int, flip, (.))

import Control.Applicative ((<$>))
import Data.HashMap.Lazy   (HashMap)
import Data.Tagged         (Tagged (..))
import Data.Vector         (Vector)

import qualified Data.HashMap.Lazy as HM
import qualified Data.Vector       as V

import Data.Foldable.WithIndex
import Data.Functor.WithIndex
import Data.Traversable.WithIndex

-------------------------------------------------------------------------------
-- tagged
-------------------------------------------------------------------------------

instance FunctorWithIndex () (Tagged a) where
  imap :: (() -> a -> b) -> Tagged a a -> Tagged a b
imap () -> a -> b
f (Tagged a
a) = b -> Tagged a b
forall k (s :: k) b. b -> Tagged s b
Tagged (() -> a -> b
f () a
a)
  {-# INLINE imap #-}

instance FoldableWithIndex () (Tagged a) where
  ifoldMap :: (() -> a -> m) -> Tagged a a -> m
ifoldMap () -> a -> m
f (Tagged a
a) = () -> a -> m
f () a
a
  {-# INLINE ifoldMap #-}

instance TraversableWithIndex () (Tagged a) where
  itraverse :: (() -> a -> f b) -> Tagged a a -> f (Tagged a b)
itraverse () -> a -> f b
f (Tagged a
a) = b -> Tagged a b
forall k (s :: k) b. b -> Tagged s b
Tagged (b -> Tagged a b) -> f b -> f (Tagged a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> a -> f b
f () a
a
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- vector
-------------------------------------------------------------------------------

instance FunctorWithIndex Int 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
V.imap
  {-# INLINE imap #-}
instance FoldableWithIndex Int 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
V.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
V.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
V.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
V.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 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
V.length Vector a
v in Int -> [b] -> Vector b
forall a. Int -> [a] -> Vector a
V.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]
V.toList Vector a
v)
  {-# INLINE itraverse #-}

-------------------------------------------------------------------------------
-- unordered-containers
-------------------------------------------------------------------------------

instance FunctorWithIndex k (HashMap k) where
  imap :: (k -> a -> b) -> HashMap k a -> HashMap k b
imap = (k -> a -> b) -> HashMap k a -> HashMap k b
forall k a b. (k -> a -> b) -> HashMap k a -> HashMap k b
HM.mapWithKey
  {-# INLINE imap #-}
instance FoldableWithIndex k (HashMap k) where
  ifoldr :: (k -> a -> b -> b) -> b -> HashMap k a -> b
ifoldr  = (k -> a -> b -> b) -> b -> HashMap k a -> b
forall k a b. (k -> a -> b -> b) -> b -> HashMap k a -> b
HM.foldrWithKey
  ifoldl' :: (k -> b -> a -> b) -> b -> HashMap k a -> b
ifoldl' = (b -> k -> a -> b) -> b -> HashMap k a -> b
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' ((b -> k -> a -> b) -> b -> HashMap k a -> b)
-> ((k -> b -> a -> b) -> b -> k -> a -> b)
-> (k -> b -> a -> b)
-> b
-> HashMap k a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> b -> a -> b) -> b -> k -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
  {-# INLINE ifoldr #-}
  {-# INLINE ifoldl' #-}
instance TraversableWithIndex k (HashMap k) where
  itraverse :: (k -> a -> f b) -> HashMap k a -> f (HashMap k b)
itraverse = (k -> a -> f b) -> HashMap k a -> f (HashMap k b)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HM.traverseWithKey
  {-# INLINE itraverse #-}