{-# 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
(
At(at)
, sans
, iat
, Index
, IxValue
, Ixed(ix)
, ixAt
, iix
, 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
class Contains m where
contains :: Index m -> Lens' m Bool
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 = forall m. Contains m => Index m -> Lens' m Bool
contains Index m
i (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 = forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Key -> IntSet -> f IntSet
IntSet.alterF Bool -> f Bool
f Index IntSet
k
#else
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 = forall a (f :: * -> *).
(Ord a, Functor f) =>
(Bool -> f Bool) -> a -> Set a -> f (Set a)
Set.alterF Bool -> f Bool
f 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 = forall a. HashMap a () -> HashSet a
HashSet.fromMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> f Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> Bool
isJust) Index (HashSet a)
k (forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet a
s)
{-# INLINE contains #-}
type family IxValue (m :: Type) :: Type
class Ixed m where
ix :: Index m -> Traversal' m (IxValue m)
default ix :: At m => Index m -> Traversal' m (IxValue m)
ix = forall m. At m => Index m -> Traversal' m (IxValue m)
ixAt
{-# INLINE ix #-}
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 = forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index m
i (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 #-}
ixAt :: At m => Index m -> Traversal' m (IxValue m)
ixAt :: forall m. At m => Index m -> Traversal' m (IxValue m)
ixAt Index m
i = forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index m
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 Index (e -> a)
e) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a e
e' -> if Index (e -> a)
e 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) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (Maybe a) -> f (IxValue (Maybe a))
f a
a
ix ~() IxValue (Maybe a) -> f (IxValue (Maybe a))
_ Maybe a
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 | Index [a]
k forall a. Ord a => a -> a -> Bool
< Key
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs0
| Bool
otherwise = [a] -> Key -> f [a]
go [a]
xs0 Index [a]
k where
go :: [a] -> Key -> f [a]
go [] Key
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
go (a
a:[a]
as) Key
0 = IxValue [a] -> f (IxValue [a])
f a
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. a -> [a] -> [a]
:[a]
as)
go (a
a:[a]
as) Key
i = (a
aforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> Key -> f [a]
go [a]
as forall a b. (a -> b) -> a -> b
$! Key
i 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 | Index (NonEmpty a)
k forall a. Ord a => a -> a -> Bool
< Key
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
xs0
| Bool
otherwise = NonEmpty a -> Key -> f (NonEmpty a)
go NonEmpty a
xs0 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
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. a -> [a] -> NonEmpty a
:|[a]
as)
go (a
a:|[a]
as) Key
i = (a
aforall a. a -> [a] -> NonEmpty a
:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Key
i forall a. Num a => a -> a -> a
- Key
1) 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) = forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (Identity a) -> f (IxValue (Identity a))
f 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 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
a forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
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 forall a. Ord a => a -> a -> Bool
< Key
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree a
t
| Bool
otherwise = forall a. a -> [Tree a] -> Tree a
Node a
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
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 forall a. Ord a => a -> a -> Bool
<= Index (Seq a)
i Bool -> Bool -> Bool
&& Index (Seq a)
i forall a. Ord a => a -> a -> Bool
< forall a. Seq a -> Key
Seq.length Seq a
m = IxValue (Seq a) -> f (IxValue (Seq a))
f (forall a. Seq a -> Key -> a
Seq.index Seq a
m Index (Seq a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> forall a. Key -> a -> Seq a -> Seq a
Seq.update Index (Seq a)
i a
a Seq a
m
| Bool
otherwise = 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 forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Index (IntMap a)
k IntMap a
m of
Just a
v -> IxValue (IntMap a) -> f (IxValue (IntMap a))
f a
v forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert Index (IntMap a)
k a
v' IntMap a
m
Maybe a
Nothing -> 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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Index (Map k a)
k Map k a
m of
Just a
v -> IxValue (Map k a) -> f (IxValue (Map k a))
f a
v forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Index (Map k a)
k a
v' Map k a
m
Maybe a
Nothing -> 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 forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Index (HashMap k a)
k HashMap k a
m of
Just a
v -> IxValue (HashMap k a) -> f (IxValue (HashMap k a))
f a
v forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Index (HashMap k a)
k a
v' HashMap k a
m
Maybe a
Nothing -> 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 forall a. Ord a => a -> Set a -> Bool
Set.member Index (Set k)
k Set k
m
then IxValue (Set k) -> f (IxValue (Set k))
f () forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Set k
m
else 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 Index IntSet
k IntSet
m
then IxValue IntSet -> f (IxValue IntSet)
f () forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntSet
m
else 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 forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Index (HashSet k)
k HashSet k
m
then IxValue (HashSet k) -> f (IxValue (HashSet k))
f () forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HashSet k
m
else forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet k
m
{-# INLINE ix #-}
type instance IxValue (Array.Array i e) = e
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
| forall a. Ix a => (a, a) -> a -> Bool
inRange (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array i e
arr) Index (Array i e)
i = IxValue (Array i e) -> f (IxValue (Array i e))
f (Array i e
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
Array.! Index (Array i e)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \e
e -> Array i e
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
Array.// [(Index (Array i e)
i,e
e)]
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure Array i e
arr
{-# INLINE ix #-}
type instance IxValue (UArray i e) = e
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
| forall a. Ix a => (a, a) -> a -> Bool
inRange (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray i e
arr) Index (UArray i e)
i = IxValue (UArray i e) -> f (IxValue (UArray i e))
f (UArray i e
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
Array.! Index (UArray i e)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \e
e -> UArray i e
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
Array.// [(Index (UArray i e)
i,e
e)]
| Bool
otherwise = 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 forall a. Ord a => a -> a -> Bool
<= Index (Vector a)
i Bool -> Bool -> Bool
&& Index (Vector a)
i forall a. Ord a => a -> a -> Bool
< forall a. Vector a -> Key
Vector.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v forall a. Vector a -> Key -> a
Vector.! Index (Vector a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v forall a. Vector a -> [(Key, a)] -> Vector a
Vector.// [(Index (Vector a)
i, a
a)]
| Bool
otherwise = 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 forall a. Ord a => a -> a -> Bool
<= Index (Vector a)
i Bool -> Bool -> Bool
&& Index (Vector a)
i forall a. Ord a => a -> a -> Bool
< forall a. Prim a => Vector a -> Key
Prim.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v forall a. Prim a => Vector a -> Key -> a
Prim.! Index (Vector a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v forall a. Prim a => Vector a -> [(Key, a)] -> Vector a
Prim.// [(Index (Vector a)
i, a
a)]
| Bool
otherwise = 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 forall a. Ord a => a -> a -> Bool
<= Index (Vector a)
i Bool -> Bool -> Bool
&& Index (Vector a)
i forall a. Ord a => a -> a -> Bool
< forall a. Storable a => Vector a -> Key
Storable.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v forall a. Storable a => Vector a -> Key -> a
Storable.! Index (Vector a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v forall a. Storable a => Vector a -> [(Key, a)] -> Vector a
Storable.// [(Index (Vector a)
i, a
a)]
| Bool
otherwise = 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 forall a. Ord a => a -> a -> Bool
<= Index (Vector a)
i Bool -> Bool -> Bool
&& Index (Vector a)
i forall a. Ord a => a -> a -> Bool
< forall a. Unbox a => Vector a -> Key
Unboxed.length Vector a
v = IxValue (Vector a) -> f (IxValue (Vector a))
f (Vector a
v forall a. Unbox a => Vector a -> Key -> a
Unboxed.! Index (Vector a)
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> Vector a
v forall a. Unbox a => Vector a -> [(Key, a)] -> Vector a
Unboxed.// [(Index (Vector a)
i, a
a)]
| Bool
otherwise = 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
| Index Text
e forall a. Ord a => a -> a -> Bool
< Key
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
| Bool
otherwise = case Key -> Text -> (Text, Text)
StrictT.splitAt Index Text
e Text
s of
(Text
l, Text
mr) -> case Text -> Maybe (Char, Text)
StrictT.uncons Text
mr of
Maybe (Char, Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
Just (Char
c, Text
xs) -> IxValue Text -> f (IxValue Text)
f Char
c 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
| Index Text
e forall a. Ord a => a -> a -> Bool
< Int64
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
| Bool
otherwise = case Int64 -> Text -> (Text, Text)
LazyT.splitAt Index Text
e Text
s of
(Text
l, Text
mr) -> case Text -> Maybe (Char, Text)
LazyT.uncons Text
mr of
Maybe (Char, Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
Just (Char
c, Text
xs) -> IxValue Text -> f (IxValue Text)
f Char
c 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
| Index ByteString
e forall a. Ord a => a -> a -> Bool
< Key
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
| Bool
otherwise = case Key -> ByteString -> (ByteString, ByteString)
StrictB.splitAt Index ByteString
e ByteString
s of
(ByteString
l, ByteString
mr) -> case ByteString -> Maybe (Word8, ByteString)
StrictB.uncons ByteString
mr of
Maybe (Word8, ByteString)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
Just (Word8
c, ByteString
xs) -> IxValue ByteString -> f (IxValue ByteString)
f Word8
c 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
ix :: Index ByteString -> Traversal' ByteString (IxValue ByteString)
ix Index ByteString
e IxValue ByteString -> f (IxValue ByteString)
f ByteString
s
| Index ByteString
e forall a. Ord a => a -> a -> Bool
< Int64
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
| Bool
otherwise = case Int64 -> ByteString -> (ByteString, ByteString)
LazyB.splitAt Index ByteString
e ByteString
s of
(ByteString
l, ByteString
mr) -> case ByteString -> Maybe (Word8, ByteString)
LazyB.uncons ByteString
mr of
Maybe (Word8, ByteString)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s
Just (Word8
c, ByteString
xs) -> IxValue ByteString -> f (IxValue ByteString)
f Word8
c 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 #-}
class Ixed m => At m where
at :: Index m -> Lens' m (Maybe (IxValue m))
sans :: At m => Index m -> m -> m
sans :: forall m. At m => Index m -> m -> m
sans Index m
k m
m = m
m forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index m
k forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
{-# INLINE sans #-}
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 = forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index m
i (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 (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 = forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
IntMap.alterF Maybe (IxValue (IntMap a)) -> f (Maybe (IxValue (IntMap a)))
f 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 = forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF Maybe (IxValue (Map k a)) -> f (Maybe (IxValue (Map k a)))
f 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 = 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 (IxValue (HashMap k a)) -> f (Maybe (IxValue (HashMap k a)))
f Index (HashMap k a)
k
{-# INLINE at #-}
instance At IntSet where
at :: Index IntSet -> Lens' IntSet (Maybe (IxValue IntSet))
at Index IntSet
k Maybe (IxValue IntSet) -> f (Maybe (IxValue IntSet))
f IntSet
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> IntSet
choose (Maybe (IxValue IntSet) -> f (Maybe (IxValue IntSet))
f (forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
member_))
where
member_ :: Bool
member_ = Key -> IntSet -> Bool
IntSet.member Index IntSet
k IntSet
s
(IntSet
inserted, IntSet
deleted)
| Bool
member_ = (IntSet
s, Key -> IntSet -> IntSet
IntSet.delete Index IntSet
k IntSet
s)
| Bool
otherwise = (Key -> IntSet -> IntSet
IntSet.insert 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 = forall a (f :: * -> *).
(Ord a, Functor f) =>
(Bool -> f Bool) -> a -> Set a -> f (Set a)
Set.alterF (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (IxValue (Set k)) -> f (Maybe (IxValue (Set k)))
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Alternative f => Bool -> f ()
guard) 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 = forall a. HashMap a () -> HashSet a
HashSet.fromMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (IxValue (HashSet k)) -> f (Maybe (IxValue (HashSet k)))
f Index (HashSet k)
k (forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet k
s)
{-# INLINE at #-}
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 = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf forall s t a b. Each s t a b => Traversal s t a b
each Index (a, a2)
p
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 = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf forall s t a b. Each s t a b => Traversal s t a b
each Index (a, a2, a3)
p
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 = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf forall s t a b. Each s t a b => Traversal s t a b
each Index (a, a2, a3, a4)
p
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 = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf forall s t a b. Each s t a b => Traversal s t a b
each Index (a, a2, a3, a4, a5)
p
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 = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf forall s t a b. Each s t a b => Traversal s t a b
each Index (a, a2, a3, a4, a5, a6)
p
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 = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf forall s t a b. Each s t a b => Traversal s t a b
each Index (a, a2, a3, a4, a5, a6, a7)
p
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 = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf forall s t a b. Each s t a b => Traversal s t a b
each Index (a, a2, a3, a4, a5, a6, a7, a8)
p
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 = forall (f :: * -> *) s t a.
Applicative f =>
LensLike (Indexing f) s t a a
-> Key -> IndexedLensLike Key f s t a a
elementOf forall s t a b. Each s t a b => Traversal s t a b
each Index (a, a2, a3, a4, a5, a6, a7, a8, a9)
p