{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Optics.Indexed
(
IxOptic(..)
, conjoined
, (<%>)
, (%>)
, (<%)
, reindexed
, icompose
, icompose3
, icompose4
, icompose5
, icomposeN
, module Optics.IxAffineFold
, module Optics.IxAffineTraversal
, module Optics.IxFold
, module Optics.IxGetter
, module Optics.IxLens
, module Optics.IxSetter
, module Optics.IxTraversal
, FunctorWithIndex (..)
, FoldableWithIndex (..)
, itraverse_
, ifor_
, itoList
, TraversableWithIndex (..)
, ifor
) where
import qualified Data.HashMap.Lazy as HM
import qualified Data.Vector as V
import Optics.Indexed.Core
import Optics.IxAffineFold
import Optics.IxAffineTraversal
import Optics.IxFold
import Optics.IxGetter
import Optics.IxLens
import Optics.IxSetter
import Optics.IxTraversal
instance FunctorWithIndex k (HM.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 (HM.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 (HM.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 #-}
instance FunctorWithIndex Int V.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 V.Vector where
ifoldMap :: (Int -> a -> m) -> Vector a -> m
ifoldMap Int -> a -> m
f = (Int -> a -> m -> m) -> m -> Vector a -> m
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
ifoldr (\Int
i -> m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m -> m -> m) -> (a -> m) -> a -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> m
f Int
i) m
forall a. Monoid a => a
mempty
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
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 ifoldMap #-}
{-# INLINE ifoldr #-}
{-# INLINE ifoldl' #-}
instance TraversableWithIndex Int V.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 #-}