{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeOperators #-}

#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif

#include "lens-common.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.At
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
----------------------------------------------------------------------------
module Control.Lens.At
  (
  -- * At
    At(at)
    , sans
    , iat
  -- * Ixed
  , Index
  , IxValue
  , Ixed(ix)
  , ixAt
  , iix
  -- * Contains
  , Contains(contains)
  , icontains
  ) where

import Prelude ()

import Control.Lens.Each
import Control.Lens.Internal.Prelude
import Control.Lens.Traversal
import Control.Lens.Lens
import Control.Lens.Setter
import Control.Lens.Indexed
import Control.Monad (guard)
import Data.Array.IArray as Array
import Data.Array.Unboxed
import qualified Data.ByteString as StrictB
import qualified Data.ByteString.Lazy as LazyB
import Data.Complex
import Data.Functor (($>))
import Data.Hashable
import qualified Data.HashMap.Lazy as HashMap
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashSet as HashSet
import Data.HashSet (HashSet)
import Data.Int
import qualified Data.IntMap as IntMap
import Data.IntMap (IntMap)
import qualified Data.IntSet as IntSet
import Data.IntSet (IntSet)
import Data.Kind
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe (isJust)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Text as StrictT
import qualified Data.Text.Lazy as LazyT
import Data.Tree
import qualified Data.Vector as Vector
import qualified Data.Vector.Primitive as Prim
import Data.Vector.Primitive (Prim)
import qualified Data.Vector.Storable as Storable
import qualified Data.Vector.Unboxed as Unboxed
import Data.Vector.Unboxed (Unbox)
import Data.Word
import Foreign.Storable (Storable)

type family Index (s :: Type) :: Type
type instance Index (e -> a) = e
type instance Index IntSet = Int
type instance Index (Set a) = a
type instance Index (HashSet a) = a
type instance Index [a] = Int
type instance Index (NonEmpty a) = Int
type instance Index (Seq a) = Int
type instance Index (a,b) = Int
type instance Index (a,b,c) = Int
type instance Index (a,b,c,d) = Int
type instance Index (a,b,c,d,e) = Int
type instance Index (a,b,c,d,e,f) = Int
type instance Index (a,b,c,d,e,f,g) = Int
type instance Index (a,b,c,d,e,f,g,h) = Int
type instance Index (a,b,c,d,e,f,g,h,i) = Int
type instance Index (IntMap a) = Int
type instance Index (Map k a) = k
type instance Index (HashMap k a) = k
type instance Index (Array.Array i e) = i
type instance Index (UArray i e) = i
type instance Index (Vector.Vector a) = Int
type instance Index (Prim.Vector a) = Int
type instance Index (Storable.Vector a) = Int
type instance Index (Unboxed.Vector a) = Int
type instance Index (Complex a) = Int
type instance Index (Identity a) = ()
type instance Index (Maybe a) = ()
type instance Index (Tree a) = [Int]
type instance Index StrictT.Text = Int
type instance Index LazyT.Text = Int64
type instance Index StrictB.ByteString = Int
type instance Index LazyB.ByteString = Int64

-- $setup
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
-- >>> import qualified Data.IntSet as IntSet
-- >>> import qualified Data.Sequence as Seq
-- >>> import qualified Data.Map as Map
-- >>> import Debug.SimpleReflect.Expr
-- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g)
-- >>> let f  :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f
-- >>> let g  :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g
-- >>> let f' :: Int -> Expr -> Expr; f' = Debug.SimpleReflect.Vars.f'
-- >>> let h  :: Int -> Expr; h = Debug.SimpleReflect.Vars.h

-- |
-- This class provides a simple 'Lens' that lets you view (and modify)
-- information about whether or not a container contains a given 'Index'.
class Contains m where
  -- |
  -- >>> IntSet.fromList [1,2,3,4] ^. contains 3
  -- True
  --
  -- >>> IntSet.fromList [1,2,3,4] ^. contains 5
  -- False
  --
  -- >>> IntSet.fromList [1,2,3,4] & contains 3 .~ False
  -- fromList [1,2,4]
  contains :: Index m -> Lens' m Bool

-- | An indexed version of 'contains'.
--
-- >>> IntSet.fromList [1,2,3,4] ^@. icontains 3
-- (3,True)
--
-- >>> IntSet.fromList [1,2,3,4] ^@. icontains 5
-- (5,False)
--
-- >>> IntSet.fromList [1,2,3,4] & icontains 3 %@~ \i x -> if odd i then not x else x
-- fromList [1,2,4]
--
-- >>> IntSet.fromList [1,2,3,4] & icontains 3 %@~ \i x -> if even i then not x else x
-- fromList [1,2,3,4]
icontains :: Contains m => Index m -> IndexedLens' (Index m) m Bool
icontains :: forall m. Contains m => Index m -> IndexedLens' (Index m) m Bool
icontains Index m
i p Bool (f Bool)
f = Index m -> Lens' m Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Index m
i (p Bool (f Bool) -> Index m -> Bool -> f Bool
forall a b. p a b -> Index m -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p Bool (f Bool)
f Index m
i)
{-# INLINE icontains #-}

instance Contains IntSet where
#if MIN_VERSION_containers(0,6,3)
  contains :: Index IntSet -> Lens' IntSet Bool
contains Index IntSet
k Bool -> f Bool
f = (Bool -> f Bool) -> Key -> IntSet -> f IntSet
forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Key -> IntSet -> f IntSet
IntSet.alterF Bool -> f Bool
f Key
Index IntSet
k
#else
  -- This is a flipped copy of the implementation of `IntSet.alterF`.  Unlike a
  -- `Set`, we don't have to worry about expensive comparisons from descending
  -- multiple times into an `IntSet`. We are careful to share the results of
  -- insertion or deletion across multiple positions in the `Functor`.
  contains k f s = fmap choose (f member_)
    where
      member_ = IntSet.member k s

      (inserted, deleted)
        | member_   = (s, IntSet.delete k s)
        | otherwise = (IntSet.insert k s, s)

      choose True  = inserted
      choose False = deleted
#endif
  {-# INLINE contains #-}

instance Ord a => Contains (Set a) where
#if MIN_VERSION_containers(0,6,3)
  contains :: Index (Set a) -> Lens' (Set a) Bool
contains Index (Set a)
k Bool -> f Bool
f = (Bool -> f Bool) -> a -> Set a -> f (Set a)
forall a (f :: * -> *).
(Ord a, Functor f) =>
(Bool -> f Bool) -> a -> Set a -> f (Set a)
Set.alterF Bool -> f Bool
f a
Index (Set a)
k
#else
  contains k f s = f (Set.member k s) <&> \b ->
    if b then Set.insert k s else Set.delete k s
#endif
  {-# INLINE contains #-}

instance (Eq a, Hashable a) => Contains (HashSet a) where
  contains :: Index (HashSet a) -> Lens' (HashSet a) Bool
contains Index (HashSet a)
k Bool -> f Bool
f HashSet a
s = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet.fromMap (HashMap a () -> HashSet a) -> f (HashMap a ()) -> f (HashSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Maybe () -> f (Maybe ())) -> a -> HashMap a () -> f (HashMap a ())
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF ((Bool -> Maybe ()) -> f Bool -> f (Maybe ())
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (f Bool -> f (Maybe ()))
-> (Maybe () -> f Bool) -> Maybe () -> f (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> f Bool
f (Bool -> f Bool) -> (Maybe () -> Bool) -> Maybe () -> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe () -> Bool
forall a. Maybe a -> Bool
isJust) a
Index (HashSet a)
k (HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet a
s)
  {-# INLINE contains #-}

-- | This provides a common notion of a value at an index that is shared by both 'Ixed' and 'At'.
type family IxValue (m :: Type) :: Type

-- | Provides a simple 'Traversal' lets you 'traverse' the value at a given
-- key in a 'Map' or element at an ordinal position in a list or 'Seq'.
class Ixed m where
  -- |
  -- /NB:/ Setting the value of this 'Traversal' will only set the value in
  -- 'at' if it is already present.
  --
  -- If you want to be able to insert /missing/ values, you want 'at'.
  --
  -- >>> Seq.fromList [a,b,c,d] & ix 2 %~ f
  -- fromList [a,b,f c,d]
  --
  -- >>> Seq.fromList [a,b,c,d] & ix 2 .~ e
  -- fromList [a,b,e,d]
  --
  -- >>> Seq.fromList [a,b,c,d] ^? ix 2
  -- Just c
  --
  -- >>> Seq.fromList [] ^? ix 2
  -- Nothing
  ix :: Index m -> Traversal' m (IxValue m)
  default ix :: At m => Index m -> Traversal' m (IxValue m)
  ix = Index m -> (IxValue m -> f (IxValue m)) -> m -> f m
Index m -> Traversal' m (IxValue m)
forall m. At m => Index m -> Traversal' m (IxValue m)
ixAt
  {-# INLINE ix #-}

-- | An indexed version of 'ix'.
--
-- >>> Seq.fromList [a,b,c,d] & iix 2 %@~ f'
-- fromList [a,b,f' 2 c,d]
--
-- >>> Seq.fromList [a,b,c,d] & iix 2 .@~ h
-- fromList [a,b,h 2,d]
--
-- >>> Seq.fromList [a,b,c,d] ^@? iix 2
-- Just (2,c)
--
-- >>> Seq.fromList [] ^@? iix 2
-- Nothing
iix :: Ixed m => Index m -> IndexedTraversal' (Index m) m (IxValue m)
iix :: forall m.
Ixed m =>
Index m -> IndexedTraversal' (Index m) m (IxValue m)
iix Index m
i p (IxValue m) (f (IxValue m))
f = Index m -> Traversal' m (IxValue m)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index m
i (p (IxValue m) (f (IxValue m))
-> Index m -> IxValue m -> f (IxValue m)
forall a b. p a b -> Index m -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p (IxValue m) (f (IxValue m))
f Index m
i)
{-# INLINE iix #-}

-- | A definition of 'ix' for types with an 'At' instance. This is the default
-- if you don't specify a definition for 'ix'.
ixAt :: At m => Index m -> Traversal' m (IxValue m)
ixAt :: forall m. At m => Index m -> Traversal' m (IxValue m)
ixAt Index m
i = Index m -> Lens' m (Maybe (IxValue m))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index m
i ((Maybe (IxValue m) -> f (Maybe (IxValue m))) -> m -> f m)
-> ((IxValue m -> f (IxValue m))
    -> Maybe (IxValue m) -> f (Maybe (IxValue m)))
-> (IxValue m -> f (IxValue m))
-> m
-> f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IxValue m -> f (IxValue m))
-> Maybe (IxValue m) -> f (Maybe (IxValue m))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse
{-# INLINE ixAt #-}

type instance IxValue (e -> a) = a
instance Eq e => Ixed (e -> a) where
  ix :: Index (e -> a) -> Traversal' (e -> a) (IxValue (e -> a))
ix Index (e -> a)
e IxValue (e -> a) -> f (IxValue (e -> a))
p e -> a
f = IxValue (e -> a) -> f (IxValue (e -> a))
p (e -> a
f e
Index (e -> a)
e) f a -> (a -> e -> a) -> f (e -> a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a e
e' -> if e
Index (e -> a)
e e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
e' then a
a else e -> a
f e
e'
  {-# INLINE ix #-}

type instance IxValue (Maybe a) = a
instance Ixed (Maybe a) where
  ix :: Index (Maybe a) -> Traversal' (Maybe a) (IxValue (Maybe a))
ix ~() IxValue (Maybe a) -> f (IxValue (Maybe a))
f (Just a
a) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (Maybe a) -> f (IxValue (Maybe a))
f a
IxValue (Maybe a)
a
  ix ~() IxValue (Maybe a) -> f (IxValue (Maybe a))
_ Maybe a
Nothing  = Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  {-# INLINE ix #-}

type instance IxValue [a] = a
instance Ixed [a] where
  ix :: Index [a] -> Traversal' [a] (IxValue [a])
ix Index [a]
k IxValue [a] -> f (IxValue [a])
f [a]
xs0 | Key
Index [a]
k Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0     = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs0
             | Bool
otherwise = [a] -> Key -> f [a]
go [a]
xs0 Key
Index [a]
k where
    go :: [a] -> Key -> f [a]
go [] Key
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go (a
a:[a]
as) Key
0 = IxValue [a] -> f (IxValue [a])
f a
IxValue [a]
a f a -> (a -> [a]) -> f [a]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as)
    go (a
a:[a]
as) Key
i = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> Key -> f [a]
go [a]
as (Key -> f [a]) -> Key -> f [a]
forall a b. (a -> b) -> a -> b
$! Key
i Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1)
  {-# INLINE ix #-}

type instance IxValue (NonEmpty a) = a
instance Ixed (NonEmpty a) where
  ix :: Index (NonEmpty a)
-> Traversal' (NonEmpty a) (IxValue (NonEmpty a))
ix Index (NonEmpty a)
k IxValue (NonEmpty a) -> f (IxValue (NonEmpty a))
f NonEmpty a
xs0 | Key
Index (NonEmpty a)
k Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0 = NonEmpty a -> f (NonEmpty a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
xs0
             | Bool
otherwise = NonEmpty a -> Key -> f (NonEmpty a)
go NonEmpty a
xs0 Key
Index (NonEmpty a)
k where
    go :: NonEmpty a -> Key -> f (NonEmpty a)
go (a
a:|[a]
as) Key
0 = IxValue (NonEmpty a) -> f (IxValue (NonEmpty a))
f a
IxValue (NonEmpty a)
a f a -> (a -> NonEmpty a) -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[a]
as)
    go (a
a:|[a]
as) Key
i = (a
aa -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|) ([a] -> NonEmpty a) -> f [a] -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index [a] -> Traversal' [a] (IxValue [a])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Key
i Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1) IxValue [a] -> f (IxValue [a])
IxValue (NonEmpty a) -> f (IxValue (NonEmpty a))
f [a]
as
  {-# INLINE ix #-}

type instance IxValue (Identity a) = a
instance Ixed (Identity a) where
  ix :: Index (Identity a)
-> Traversal' (Identity a) (IxValue (Identity a))
ix ~() IxValue (Identity a) -> f (IxValue (Identity a))
f (Identity a
a) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> f a -> f (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (Identity a) -> f (IxValue (Identity a))
f a
IxValue (Identity a)
a
  {-# INLINE ix #-}

type instance IxValue (Tree a) = a
instance Ixed (Tree a) where
  ix :: Index (Tree a) -> Traversal' (Tree a) (IxValue (Tree a))
ix Index (Tree a)
xs0 IxValue (Tree a) -> f (IxValue (Tree a))
f = [Key] -> Tree a -> f (Tree a)
go [Key]
Index (Tree a)
xs0 where
    go :: [Key] -> Tree a -> f (Tree a)
go [] (Node a
a [Tree a]
as) = IxValue (Tree a) -> f (IxValue (Tree a))
f a
IxValue (Tree a)
a f a -> (a -> Tree a) -> f (Tree a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a' -> a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a' [Tree a]
as
    go (Key
i:[Key]
is) t :: Tree a
t@(Node a
a [Tree a]
as)
      | Key
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0     = Tree a -> f (Tree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree a
t
      | Bool
otherwise = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a ([Tree a] -> Tree a) -> f [Tree a] -> f (Tree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index [Tree a] -> Traversal' [Tree a] (IxValue [Tree a])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index [Tree a]
i ([Key] -> Tree a -> f (Tree a)
go [Key]
is) [Tree a]
as
  {-# INLINE ix #-}

type instance IxValue (Seq a) = a
instance Ixed (Seq a) where
  ix :: Index (Seq a) -> Traversal' (Seq a) (IxValue (Seq a))
ix Index (Seq a)
i IxValue (Seq a) -> f (IxValue (Seq a))
f Seq a
m
    | Key
0 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
Index (Seq a)
i Bool -> Bool -> Bool
&& Key
Index (Seq a)
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Seq a -> Key
forall a. Seq a -> Key
Seq.length Seq a
m = IxValue (Seq a) -> f (IxValue (Seq a))
f (Seq a -> Key -> a
forall a. Seq a -> Key -> a
Seq.index Seq a
m Key
Index (Seq a)
i) f a -> (a -> Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Key -> a -> Seq a -> Seq a
forall a. Key -> a -> Seq a -> Seq a
Seq.update Key
Index (Seq a)
i a
a Seq a
m
    | Bool
otherwise                  = Seq a -> f (Seq a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
m
  {-# INLINE ix #-}

type instance IxValue (IntMap a) = a
instance Ixed (IntMap a) where
  ix :: Index (IntMap a) -> Traversal' (IntMap a) (IxValue (IntMap a))
ix Index (IntMap a)
k IxValue (IntMap a) -> f (IxValue (IntMap a))
f IntMap a
m = case Key -> IntMap a -> Maybe a
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
Index (IntMap a)
k IntMap a
m of
     Just a
v -> IxValue (IntMap a) -> f (IxValue (IntMap a))
f a
IxValue (IntMap a)
v f a -> (a -> IntMap a) -> f (IntMap a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> Key -> a -> IntMap a -> IntMap a
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert Key
Index (IntMap a)
k a
v' IntMap a
m
     Maybe a
Nothing -> IntMap a -> f (IntMap a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap a
m
  {-# INLINE ix #-}

type instance IxValue (Map k a) = a
instance Ord k => Ixed (Map k a) where
  ix :: Index (Map k a) -> Traversal' (Map k a) (IxValue (Map k a))
ix Index (Map k a)
k IxValue (Map k a) -> f (IxValue (Map k a))
f Map k a
m = case k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
Index (Map k a)
k Map k a
m of
     Just a
v  -> IxValue (Map k a) -> f (IxValue (Map k a))
f a
IxValue (Map k a)
v f a -> (a -> Map k a) -> f (Map k a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
Index (Map k a)
k a
v' Map k a
m
     Maybe a
Nothing -> Map k a -> f (Map k a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k a
m
  {-# INLINE ix #-}

type instance IxValue (HashMap k a) = a
instance (Eq k, Hashable k) => Ixed (HashMap k a) where
  ix :: Index (HashMap k a)
-> Traversal' (HashMap k a) (IxValue (HashMap k a))
ix Index (HashMap k a)
k IxValue (HashMap k a) -> f (IxValue (HashMap k a))
f HashMap k a
m = case k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
Index (HashMap k a)
k HashMap k a
m of
     Just a
v  -> IxValue (HashMap k a) -> f (IxValue (HashMap k a))
f a
IxValue (HashMap k a)
v f a -> (a -> HashMap k a) -> f (HashMap k a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> k -> a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
Index (HashMap k a)
k a
v' HashMap k a
m
     Maybe a
Nothing -> HashMap k a -> f (HashMap k a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k a
m
  {-# INLINE ix #-}

type instance IxValue (Set k) = ()
instance Ord k => Ixed (Set k) where
  ix :: Index (Set k) -> Traversal' (Set k) (IxValue (Set k))
ix Index (Set k)
k IxValue (Set k) -> f (IxValue (Set k))
f Set k
m = if k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
Index (Set k)
k Set k
m
     then IxValue (Set k) -> f (IxValue (Set k))
f () f () -> Set k -> f (Set k)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Set k
m
     else Set k -> f (Set k)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set k
m
  {-# INLINE ix #-}

type instance IxValue IntSet = ()
instance Ixed IntSet where
  ix :: Index IntSet -> Traversal' IntSet (IxValue IntSet)
ix Index IntSet
k IxValue IntSet -> f (IxValue IntSet)
f IntSet
m = if Key -> IntSet -> Bool
IntSet.member Key
Index IntSet
k IntSet
m
     then IxValue IntSet -> f (IxValue IntSet)
f () f () -> IntSet -> f IntSet
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntSet
m
     else IntSet -> f IntSet
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntSet
m
  {-# INLINE ix #-}

type instance IxValue (HashSet k) = ()
instance (Eq k, Hashable k) => Ixed (HashSet k) where
  ix :: Index (HashSet k) -> Traversal' (HashSet k) (IxValue (HashSet k))
ix Index (HashSet k)
k IxValue (HashSet k) -> f (IxValue (HashSet k))
f HashSet k
m = if k -> HashSet k -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member k
Index (HashSet k)
k HashSet k
m
     then IxValue (HashSet k) -> f (IxValue (HashSet k))
f () f () -> HashSet k -> f (HashSet k)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HashSet k
m
     else HashSet k -> f (HashSet k)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet k
m
  {-# INLINE ix #-}

type instance IxValue (Array.Array i e) = e
-- |
-- @
-- arr '!' i ≡ arr 'Control.Lens.Getter.^.' 'ix' i
-- arr '//' [(i,e)] ≡ 'ix' i 'Control.Lens.Setter..~' e '$' arr
-- @
instance Ix i => Ixed (Array.Array i e) where
  ix :: Index (Array i e) -> Traversal' (Array i e) (IxValue (Array i e))
ix Index (Array i e)
i IxValue (Array i e) -> f (IxValue (Array i e))
f Array i e
arr
    | (i, i) -> i -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array i e -> (i, i)
forall i. Ix i => Array i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array i e
arr) i
Index (Array i e)
i = IxValue (Array i e) -> f (IxValue (Array i e))
f (Array i e
arr Array i e -> i -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
Array.! i
Index (Array i e)
i) f e -> (e -> Array i e) -> f (Array i e)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \e
e -> Array i e
arr Array i e -> [(i, e)] -> Array i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
Array.// [(i
Index (Array i e)
i,e
e)]
    | Bool
otherwise              = Array i e -> f (Array i e)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Array i e
arr
  {-# INLINE ix #-}

type instance IxValue (UArray i e) = e
-- |
-- @
-- arr '!' i ≡ arr 'Control.Lens.Getter.^.' 'ix' i
-- arr '//' [(i,e)] ≡ 'ix' i 'Control.Lens.Setter..~' e '$' arr
-- @
instance (IArray UArray e, Ix i) => Ixed (UArray i e) where
  ix :: Index (UArray i e)
-> Traversal' (UArray i e) (IxValue (UArray i e))
ix Index (UArray i e)
i IxValue (UArray i e) -> f (IxValue (UArray i e))
f UArray i e
arr
    | (i, i) -> i -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (UArray i e -> (i, i)
forall i. Ix i => UArray i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray i e
arr) i
Index (UArray i e)
i = IxValue (UArray i e) -> f (IxValue (UArray i e))
f (UArray i e
arr UArray i e -> i -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
Array.! i
Index (UArray i e)
i) f e -> (e -> UArray i e) -> f (UArray i e)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \e
e -> UArray i e
arr UArray i e -> [(i, e)] -> UArray i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
Array.// [(i
Index (UArray i e)
i,e
e)]
    | Bool
otherwise              = UArray i e -> f (UArray i e)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UArray i e
arr
  {-# INLINE ix #-}

type instance IxValue (Vector.Vector a) = a
instance Ixed (Vector.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
    | Key
0 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
Index (Vector a)
i Bool -> Bool -> Bool
&& Key
Index (Vector a)
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
Index (Vector a)
i) f a -> (a -> Vector a) -> f (Vector a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v Vector a -> [(Key, a)] -> Vector a
forall a. Vector a -> [(Key, a)] -> Vector a
Vector.// [(Key
Index (Vector a)
i, a
a)]
    | Bool
otherwise                     = Vector a -> f (Vector a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
  {-# INLINE ix #-}

type instance IxValue (Prim.Vector a) = a
instance Prim a => Ixed (Prim.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
    | Key
0 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
Index (Vector a)
i Bool -> Bool -> Bool
&& Key
Index (Vector a)
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Key
forall a. Prim a => Vector a -> Key
Prim.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Key -> a
forall a. Prim a => Vector a -> Key -> a
Prim.! Key
Index (Vector a)
i) f a -> (a -> Vector a) -> f (Vector a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v Vector a -> [(Key, a)] -> Vector a
forall a. Prim a => Vector a -> [(Key, a)] -> Vector a
Prim.// [(Key
Index (Vector a)
i, a
a)]
    | Bool
otherwise                   = Vector a -> f (Vector a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
  {-# INLINE ix #-}

type instance IxValue (Storable.Vector a) = a
instance Storable a => Ixed (Storable.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
    | Key
0 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
Index (Vector a)
i Bool -> Bool -> Bool
&& Key
Index (Vector a)
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Key
forall a. Storable a => Vector a -> Key
Storable.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Key -> a
forall a. Storable a => Vector a -> Key -> a
Storable.! Key
Index (Vector a)
i) f a -> (a -> Vector a) -> f (Vector a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v Vector a -> [(Key, a)] -> Vector a
forall a. Storable a => Vector a -> [(Key, a)] -> Vector a
Storable.// [(Key
Index (Vector a)
i, a
a)]
    | Bool
otherwise                       = Vector a -> f (Vector a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
  {-# INLINE ix #-}

type instance IxValue (Unboxed.Vector a) = a
instance Unbox a => Ixed (Unboxed.Vector a) where
  ix :: Index (Vector a) -> Traversal' (Vector a) (IxValue (Vector a))
ix Index (Vector a)
i IxValue (Vector a) -> f (IxValue (Vector a))
f Vector a
v
    | Key
0 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
Index (Vector a)
i Bool -> Bool -> Bool
&& Key
Index (Vector a)
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Key
forall a. Unbox a => Vector a -> Key
Unboxed.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v Vector a -> Key -> a
forall a. Unbox a => Vector a -> Key -> a
Unboxed.! Key
Index (Vector a)
i) f a -> (a -> Vector a) -> f (Vector a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v Vector a -> [(Key, a)] -> Vector a
forall a. Unbox a => Vector a -> [(Key, a)] -> Vector a
Unboxed.// [(Key
Index (Vector a)
i, a
a)]
    | Bool
otherwise                      = Vector a -> f (Vector a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
v
  {-# INLINE ix #-}

type instance IxValue StrictT.Text = Char
instance Ixed StrictT.Text where
  ix :: Index Text -> Traversal' Text (IxValue Text)
ix Index Text
e IxValue Text -> f (IxValue Text)
f Text
s 
      | Key
Index Text
e Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0 = Text -> f Text
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
      | Bool
otherwise = case Key -> Text -> (Text, Text)
StrictT.splitAt Key
Index Text
e Text
s of
            (Text
l, Text
mr) -> case Text -> Maybe (Char, Text)
StrictT.uncons Text
mr of
                Maybe (Char, Text)
Nothing      -> Text -> f Text
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
                Just (Char
c, Text
xs) -> IxValue Text -> f (IxValue Text)
f Char
IxValue Text
c f Char -> (Char -> Text) -> f Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Char
d -> [Text] -> Text
StrictT.concat [Text
l, Char -> Text
StrictT.singleton Char
d, Text
xs]
  {-# INLINE ix #-}

type instance IxValue LazyT.Text = Char
instance Ixed LazyT.Text where
  ix :: Index Text -> Traversal' Text (IxValue Text)
ix Index Text
e IxValue Text -> f (IxValue Text)
f Text
s 
        | Int64
Index Text
e Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 = Text -> f Text
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
        | Bool
otherwise = case Int64 -> Text -> (Text, Text)
LazyT.splitAt Int64
Index Text
e Text
s of
            (Text
l, Text
mr) -> case Text -> Maybe (Char, Text)
LazyT.uncons Text
mr of
              Maybe (Char, Text)
Nothing      -> Text -> f Text
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
              Just (Char
c, Text
xs) -> IxValue Text -> f (IxValue Text)
f Char
IxValue Text
c f Char -> (Char -> Text) -> f Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Char
d -> Text -> Text -> Text
LazyT.append Text
l (Char -> Text -> Text
LazyT.cons Char
d Text
xs)
  {-# INLINE ix #-}

type instance IxValue StrictB.ByteString = Word8
instance Ixed StrictB.ByteString where
  ix :: Index ByteString -> Traversal' ByteString (IxValue ByteString)
ix Index ByteString
e IxValue ByteString -> f (IxValue ByteString)
f ByteString
s 
        | Key
Index ByteString
e Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0 = ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
        | Bool
otherwise = case Key -> ByteString -> (ByteString, ByteString)
StrictB.splitAt Key
Index ByteString
e ByteString
s of
          (ByteString
l, ByteString
mr) -> case ByteString -> Maybe (Word8, ByteString)
StrictB.uncons ByteString
mr of
            Maybe (Word8, ByteString)
Nothing      -> ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
            Just (Word8
c, ByteString
xs) -> IxValue ByteString -> f (IxValue ByteString)
f Word8
IxValue ByteString
c f Word8 -> (Word8 -> ByteString) -> f ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word8
d -> [ByteString] -> ByteString
StrictB.concat [ByteString
l, Word8 -> ByteString
StrictB.singleton Word8
d, ByteString
xs]
  {-# INLINE ix #-}

type instance IxValue LazyB.ByteString = Word8
instance Ixed LazyB.ByteString where
  -- TODO: we could be lazier, returning each chunk as it is passed
  ix :: Index ByteString -> Traversal' ByteString (IxValue ByteString)
ix Index ByteString
e IxValue ByteString -> f (IxValue ByteString)
f ByteString
s 
        | Int64
Index ByteString
e Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 = ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
        | Bool
otherwise =  case Int64 -> ByteString -> (ByteString, ByteString)
LazyB.splitAt Int64
Index ByteString
e ByteString
s of
          (ByteString
l, ByteString
mr) -> case ByteString -> Maybe (Word8, ByteString)
LazyB.uncons ByteString
mr of
            Maybe (Word8, ByteString)
Nothing      -> ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
            Just (Word8
c, ByteString
xs) -> IxValue ByteString -> f (IxValue ByteString)
f Word8
IxValue ByteString
c f Word8 -> (Word8 -> ByteString) -> f ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word8
d -> ByteString -> ByteString -> ByteString
LazyB.append ByteString
l (Word8 -> ByteString -> ByteString
LazyB.cons Word8
d ByteString
xs)
  {-# INLINE ix #-}



-- | 'At' provides a 'Lens' that can be used to read,
-- write or delete the value associated with a key in a 'Map'-like
-- container on an ad hoc basis.
--
-- An instance of 'At' should satisfy:
--
-- @
-- 'ix' k ≡ 'at' k '.' 'traverse'
-- @
class Ixed m => At m where
  -- |
  -- >>> Map.fromList [(1,"world")] ^.at 1
  -- Just "world"
  --
  -- >>> at 1 ?~ "hello" $ Map.empty
  -- fromList [(1,"hello")]
  --
  -- /Note:/ 'Map'-like containers form a reasonable instance, but not 'Array'-like ones, where
  -- you cannot satisfy the 'Lens' laws.
  at :: Index m -> Lens' m (Maybe (IxValue m))

-- | Delete the value associated with a key in a 'Map'-like container
--
-- @
-- 'sans' k = 'at' k .~ Nothing
-- @
sans :: At m => Index m -> m -> m
sans :: forall m. At m => Index m -> m -> m
sans Index m
k m
m = m
m m -> (m -> m) -> m
forall a b. a -> (a -> b) -> b
& Index m -> Lens' m (Maybe (IxValue m))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index m
k ((Maybe (IxValue m) -> Identity (Maybe (IxValue m)))
 -> m -> Identity m)
-> Maybe (IxValue m) -> m -> m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (IxValue m)
forall a. Maybe a
Nothing
{-# INLINE sans #-}

-- | An indexed version of 'at'.
--
-- >>> Map.fromList [(1,"world")] ^@. iat 1
-- (1,Just "world")
--
-- >>> iat 1 %@~ (\i x -> if odd i then Just "hello" else Nothing) $ Map.empty
-- fromList [(1,"hello")]
--
-- >>> iat 2 %@~ (\i x -> if odd i then Just "hello" else Nothing) $ Map.empty
-- fromList []
--
iat :: At m => Index m -> IndexedLens' (Index m) m (Maybe (IxValue m))
iat :: forall m.
At m =>
Index m -> IndexedLens' (Index m) m (Maybe (IxValue m))
iat Index m
i p (Maybe (IxValue m)) (f (Maybe (IxValue m)))
f = Index m -> Lens' m (Maybe (IxValue m))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index m
i (p (Maybe (IxValue m)) (f (Maybe (IxValue m)))
-> Index m -> Maybe (IxValue m) -> f (Maybe (IxValue m))
forall a b. p a b -> Index m -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p (Maybe (IxValue m)) (f (Maybe (IxValue m)))
f Index m
i)
{-# INLINE iat #-}

instance At (Maybe a) where
  at :: Index (Maybe a) -> Lens' (Maybe a) (Maybe (IxValue (Maybe a)))
at ~() Maybe (IxValue (Maybe a)) -> f (Maybe (IxValue (Maybe a)))
f = Maybe a -> f (Maybe a)
Maybe (IxValue (Maybe a)) -> f (Maybe (IxValue (Maybe a)))
f
  {-# INLINE at #-}

instance At (IntMap a) where
#if MIN_VERSION_containers(0,5,8)
  at :: Index (IntMap a) -> Lens' (IntMap a) (Maybe (IxValue (IntMap a)))
at Index (IntMap a)
k Maybe (IxValue (IntMap a)) -> f (Maybe (IxValue (IntMap a)))
f = (Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
IntMap.alterF Maybe a -> f (Maybe a)
Maybe (IxValue (IntMap a)) -> f (Maybe (IxValue (IntMap a)))
f Key
Index (IntMap a)
k
#else
  at k f m = f mv <&> \r -> case r of
    Nothing -> maybe m (const (IntMap.delete k m)) mv
    Just v' -> IntMap.insert k v' m
    where mv = IntMap.lookup k m
#endif
  {-# INLINE at #-}

instance Ord k => At (Map k a) where
#if MIN_VERSION_containers(0,5,8)
  at :: Index (Map k a) -> Lens' (Map k a) (Maybe (IxValue (Map k a)))
at Index (Map k a)
k Maybe (IxValue (Map k a)) -> f (Maybe (IxValue (Map k a)))
f = (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF Maybe a -> f (Maybe a)
Maybe (IxValue (Map k a)) -> f (Maybe (IxValue (Map k a)))
f k
Index (Map k a)
k
#else
  at k f m = f mv <&> \r -> case r of
    Nothing -> maybe m (const (Map.delete k m)) mv
    Just v' -> Map.insert k v' m
    where mv = Map.lookup k m
#endif
  {-# INLINE at #-}

instance (Eq k, Hashable k) => At (HashMap k a) where
  at :: Index (HashMap k a)
-> Lens' (HashMap k a) (Maybe (IxValue (HashMap k a)))
at Index (HashMap k a)
k Maybe (IxValue (HashMap k a)) -> f (Maybe (IxValue (HashMap k a)))
f = (Maybe a -> f (Maybe a)) -> k -> HashMap k a -> f (HashMap k a)
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF Maybe a -> f (Maybe a)
Maybe (IxValue (HashMap k a)) -> f (Maybe (IxValue (HashMap k a)))
f k
Index (HashMap k a)
k
  {-# INLINE at #-}

instance At IntSet where
  -- This is a gently modified copy of the implementation of `IntSet.alterF`.
  -- Unlike a `Set`, we don't have to worry about expensive comparisons from
  -- descending multiple times into an `IntSet`. We are careful to share the
  -- results of insertion or deletion across multiple positions in the
  -- `Functor`.
  at :: Index IntSet -> Lens' IntSet (Maybe (IxValue IntSet))
at Index IntSet
k Maybe (IxValue IntSet) -> f (Maybe (IxValue IntSet))
f IntSet
s = (Maybe () -> IntSet) -> f (Maybe ()) -> f IntSet
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> IntSet
choose (Maybe (IxValue IntSet) -> f (Maybe (IxValue IntSet))
f (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
member_))
    where
      member_ :: Bool
member_ = Key -> IntSet -> Bool
IntSet.member Key
Index IntSet
k IntSet
s

      (IntSet
inserted, IntSet
deleted)
        | Bool
member_   = (IntSet
s, Key -> IntSet -> IntSet
IntSet.delete Key
Index IntSet
k IntSet
s)
        | Bool
otherwise = (Key -> IntSet -> IntSet
IntSet.insert Key
Index IntSet
k IntSet
s, IntSet
s)

      choose :: Maybe () -> IntSet
choose (Just ~()) = IntSet
inserted
      choose Maybe ()
Nothing = IntSet
deleted
  {-# INLINE at #-}

instance Ord k => At (Set k) where
#if MIN_VERSION_containers(0,6,3)
  at :: Index (Set k) -> Lens' (Set k) (Maybe (IxValue (Set k)))
at Index (Set k)
k Maybe (IxValue (Set k)) -> f (Maybe (IxValue (Set k)))
f = (Bool -> f Bool) -> k -> Set k -> f (Set k)
forall a (f :: * -> *).
(Ord a, Functor f) =>
(Bool -> f Bool) -> a -> Set a -> f (Set a)
Set.alterF ((Maybe () -> Bool) -> f (Maybe ()) -> f Bool
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (f (Maybe ()) -> f Bool)
-> (Bool -> f (Maybe ())) -> Bool -> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe () -> f (Maybe ())
Maybe (IxValue (Set k)) -> f (Maybe (IxValue (Set k)))
f (Maybe () -> f (Maybe ()))
-> (Bool -> Maybe ()) -> Bool -> f (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard) k
Index (Set k)
k
#else
  at k f m = f mv <&> \r -> case r of
    Nothing -> maybe m (const (Set.delete k m)) mv
    Just ~() -> maybe (Set.insert k m) (const m) mv
    where mv = if Set.member k m then Just () else Nothing
#endif
  {-# INLINE at #-}

instance (Eq k, Hashable k) => At (HashSet k) where
  at :: Index (HashSet k)
-> Lens' (HashSet k) (Maybe (IxValue (HashSet k)))
at Index (HashSet k)
k Maybe (IxValue (HashSet k)) -> f (Maybe (IxValue (HashSet k)))
f HashSet k
s = HashMap k () -> HashSet k
forall a. HashMap a () -> HashSet a
HashSet.fromMap (HashMap k () -> HashSet k) -> f (HashMap k ()) -> f (HashSet k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe () -> f (Maybe ())) -> k -> HashMap k () -> f (HashMap k ())
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF Maybe () -> f (Maybe ())
Maybe (IxValue (HashSet k)) -> f (Maybe (IxValue (HashSet k)))
f k
Index (HashSet k)
k (HashSet k -> HashMap k ()
forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet k
s)
  {-# INLINE at #-}


-- | @'ix' :: 'Int' -> 'Traversal'' (a,a) a@
type instance IxValue (a,a2) = a
instance (a~a2) => Ixed (a,a2) where
  ix :: Index (a, a2) -> Traversal' (a, a2) (IxValue (a, a2))
ix Index (a, a2)
p = LensLike (Indexing f) (a, a2) (a, a2) a2 a2
-> Key -> IndexedLensLike Key f (a, a2) (a, a2) a2 a2
forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf LensLike (Indexing f) (a, a2) (a, a2) a2 a2
forall s t a b. Each s t a b => Traversal s t a b
Traversal (a, a2) (a, a2) a2 a2
each Key
Index (a, a2)
p

-- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a) a@
type instance IxValue (a,a2,a3) = a
instance (a~a2, a~a3) => Ixed (a,a2,a3) where
  ix :: Index (a, a2, a3) -> Traversal' (a, a2, a3) (IxValue (a, a2, a3))
ix Index (a, a2, a3)
p = LensLike (Indexing f) (a, a2, a3) (a, a2, a3) a3 a3
-> Key -> IndexedLensLike Key f (a, a2, a3) (a, a2, a3) a3 a3
forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf LensLike (Indexing f) (a, a2, a3) (a, a2, a3) a3 a3
forall s t a b. Each s t a b => Traversal s t a b
Traversal (a, a2, a3) (a, a2, a3) a3 a3
each Key
Index (a, a2, a3)
p

-- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a) a@
type instance IxValue (a,a2,a3,a4) = a
instance (a~a2, a~a3, a~a4) => Ixed (a,a2,a3,a4) where
  ix :: Index (a, a2, a3, a4)
-> Traversal' (a, a2, a3, a4) (IxValue (a, a2, a3, a4))
ix Index (a, a2, a3, a4)
p = LensLike (Indexing f) (a, a2, a3, a4) (a, a2, a3, a4) a4 a4
-> Key
-> IndexedLensLike Key f (a, a2, a3, a4) (a, a2, a3, a4) a4 a4
forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf LensLike (Indexing f) (a, a2, a3, a4) (a, a2, a3, a4) a4 a4
forall s t a b. Each s t a b => Traversal s t a b
Traversal (a, a2, a3, a4) (a, a2, a3, a4) a4 a4
each Key
Index (a, a2, a3, a4)
p

-- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a) a@
type instance IxValue (a,a2,a3,a4,a5) = a
instance (a~a2, a~a3, a~a4, a~a5) => Ixed (a,a2,a3,a4,a5) where
  ix :: Index (a, a2, a3, a4, a5)
-> Traversal' (a, a2, a3, a4, a5) (IxValue (a, a2, a3, a4, a5))
ix Index (a, a2, a3, a4, a5)
p = LensLike (Indexing f) (a, a2, a3, a4, a5) (a, a2, a3, a4, a5) a5 a5
-> Key
-> IndexedLensLike
     Key f (a, a2, a3, a4, a5) (a, a2, a3, a4, a5) a5 a5
forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf LensLike (Indexing f) (a, a2, a3, a4, a5) (a, a2, a3, a4, a5) a5 a5
forall s t a b. Each s t a b => Traversal s t a b
Traversal (a, a2, a3, a4, a5) (a, a2, a3, a4, a5) a5 a5
each Key
Index (a, a2, a3, a4, a5)
p

-- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a,a) a@
type instance IxValue (a,a2,a3,a4,a5,a6) = a
instance (a~a2, a~a3, a~a4, a~a5, a~a6) => Ixed (a,a2,a3,a4,a5,a6) where
  ix :: Index (a, a2, a3, a4, a5, a6)
-> Traversal'
     (a, a2, a3, a4, a5, a6) (IxValue (a, a2, a3, a4, a5, a6))
ix Index (a, a2, a3, a4, a5, a6)
p = LensLike
  (Indexing f) (a, a2, a3, a4, a5, a6) (a, a2, a3, a4, a5, a6) a6 a6
-> Key
-> IndexedLensLike
     Key f (a, a2, a3, a4, a5, a6) (a, a2, a3, a4, a5, a6) a6 a6
forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf LensLike
  (Indexing f) (a, a2, a3, a4, a5, a6) (a, a2, a3, a4, a5, a6) a6 a6
forall s t a b. Each s t a b => Traversal s t a b
Traversal (a, a2, a3, a4, a5, a6) (a, a2, a3, a4, a5, a6) a6 a6
each Key
Index (a, a2, a3, a4, a5, a6)
p

-- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a,a,a) a@
type instance IxValue (a,a2,a3,a4,a5,a6,a7) = a
instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7) => Ixed (a,a2,a3,a4,a5,a6,a7) where
  ix :: Index (a, a2, a3, a4, a5, a6, a7)
-> Traversal'
     (a, a2, a3, a4, a5, a6, a7) (IxValue (a, a2, a3, a4, a5, a6, a7))
ix Index (a, a2, a3, a4, a5, a6, a7)
p = LensLike
  (Indexing f)
  (a, a2, a3, a4, a5, a6, a7)
  (a, a2, a3, a4, a5, a6, a7)
  a7
  a7
-> Key
-> IndexedLensLike
     Key f (a, a2, a3, a4, a5, a6, a7) (a, a2, a3, a4, a5, a6, a7) a7 a7
forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf LensLike
  (Indexing f)
  (a, a2, a3, a4, a5, a6, a7)
  (a, a2, a3, a4, a5, a6, a7)
  a7
  a7
forall s t a b. Each s t a b => Traversal s t a b
Traversal
  (a, a2, a3, a4, a5, a6, a7) (a, a2, a3, a4, a5, a6, a7) a7 a7
each Key
Index (a, a2, a3, a4, a5, a6, a7)
p

-- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a,a,a,a) a@
type instance IxValue (a,a2,a3,a4,a5,a6,a7,a8) = a
instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, a~a8) => Ixed (a,a2,a3,a4,a5,a6,a7,a8) where
  ix :: Index (a, a2, a3, a4, a5, a6, a7, a8)
-> Traversal'
     (a, a2, a3, a4, a5, a6, a7, a8)
     (IxValue (a, a2, a3, a4, a5, a6, a7, a8))
ix Index (a, a2, a3, a4, a5, a6, a7, a8)
p = LensLike
  (Indexing f)
  (a, a2, a3, a4, a5, a6, a7, a8)
  (a, a2, a3, a4, a5, a6, a7, a8)
  a8
  a8
-> Key
-> IndexedLensLike
     Key
     f
     (a, a2, a3, a4, a5, a6, a7, a8)
     (a, a2, a3, a4, a5, a6, a7, a8)
     a8
     a8
forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf LensLike
  (Indexing f)
  (a, a2, a3, a4, a5, a6, a7, a8)
  (a, a2, a3, a4, a5, a6, a7, a8)
  a8
  a8
forall s t a b. Each s t a b => Traversal s t a b
Traversal
  (a, a2, a3, a4, a5, a6, a7, a8)
  (a, a2, a3, a4, a5, a6, a7, a8)
  a8
  a8
each Key
Index (a, a2, a3, a4, a5, a6, a7, a8)
p

-- | @'ix' :: 'Int' -> 'Traversal'' (a,a,a,a,a,a,a,a,a) a@
type instance IxValue (a,a2,a3,a4,a5,a6,a7,a8,a9) = a
instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, a~a8, a~a9) => Ixed (a,a2,a3,a4,a5,a6,a7,a8,a9) where
  ix :: Index (a, a2, a3, a4, a5, a6, a7, a8, a9)
-> Traversal'
     (a, a2, a3, a4, a5, a6, a7, a8, a9)
     (IxValue (a, a2, a3, a4, a5, a6, a7, a8, a9))
ix Index (a, a2, a3, a4, a5, a6, a7, a8, a9)
p = LensLike
  (Indexing f)
  (a, a2, a3, a4, a5, a6, a7, a8, a9)
  (a, a2, a3, a4, a5, a6, a7, a8, a9)
  a9
  a9
-> Key
-> IndexedLensLike
     Key
     f
     (a, a2, a3, a4, a5, a6, a7, a8, a9)
     (a, a2, a3, a4, a5, a6, a7, a8, a9)
     a9
     a9
forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf LensLike
  (Indexing f)
  (a, a2, a3, a4, a5, a6, a7, a8, a9)
  (a, a2, a3, a4, a5, a6, a7, a8, a9)
  a9
  a9
forall s t a b. Each s t a b => Traversal s t a b
Traversal
  (a, a2, a3, a4, a5, a6, a7, a8, a9)
  (a, a2, a3, a4, a5, a6, a7, a8, a9)
  a9
  a9
each Key
Index (a, a2, a3, a4, a5, a6, a7, a8, a9)
p