#ifdef TRUSTWORTHY
#endif
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
module Control.Lens.At
(
At(at)
, sans
, iat
, Index
, IxValue
, Ixed(ix)
, ixAt
, iix
, Contains(contains)
, icontains
) where
import Control.Lens.Each
import Control.Lens.Traversal
import Control.Lens.Lens
import Control.Lens.Setter
import Control.Lens.Indexed
import Data.Array.IArray as Array
import Data.Array.Unboxed
import Data.ByteString as StrictB
import Data.ByteString.Lazy as LazyB
import Data.Complex
import Data.Hashable
import Data.HashMap.Lazy as HashMap
import Data.HashSet as HashSet
import Data.Int
import Data.IntMap as IntMap
import Data.IntSet as IntSet
import Data.List.NonEmpty as NonEmpty
import Data.Map as Map
import Data.Set as Set
import Data.Sequence as Seq
import Data.Text as StrictT
import Data.Text.Lazy as LazyT
import Data.Tree
import Data.Vector as Vector hiding (indexed)
import Data.Vector.Primitive as Prim
import Data.Vector.Storable as Storable
import Data.Vector.Unboxed as Unboxed hiding (indexed)
import Data.Word
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
type family Index (s :: *) :: *
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 i f = contains i (indexed f i)
instance Contains IntSet where
contains k f s = f (IntSet.member k s) <&> \b ->
if b then IntSet.insert k s else IntSet.delete k s
instance Ord a => Contains (Set a) where
contains k f s = f (Set.member k s) <&> \b ->
if b then Set.insert k s else Set.delete k s
instance (Eq a, Hashable a) => Contains (HashSet a) where
contains k f s = f (HashSet.member k s) <&> \b ->
if b then HashSet.insert k s else HashSet.delete k s
type family IxValue (m :: *) :: *
class Ixed m where
ix :: Index m -> Traversal' m (IxValue m)
#ifdef DEFAULT_SIGNATURES
default ix :: (Applicative f, At m) => Index m -> LensLike' f m (IxValue m)
ix = ixAt
#endif
iix :: Ixed m => Index m -> IndexedTraversal' (Index m) m (IxValue m)
iix i f = ix i (indexed f i)
ixAt :: At m => Index m -> Traversal' m (IxValue m)
ixAt i = at i . traverse
type instance IxValue (e -> a) = a
instance Eq e => Ixed (e -> a) where
ix e p f = p (f e) <&> \a e' -> if e == e' then a else f e'
type instance IxValue (Maybe a) = a
instance Ixed (Maybe a) where
ix () f (Just a) = Just <$> f a
ix () _ Nothing = pure Nothing
type instance IxValue [a] = a
instance Ixed [a] where
ix k f xs0 | k < 0 = pure xs0
| otherwise = go xs0 k where
go [] _ = pure []
go (a:as) 0 = f a <&> (:as)
go (a:as) i = (a:) <$> (go as $! i 1)
type instance IxValue (NonEmpty a) = a
instance Ixed (NonEmpty a) where
ix k f xs0 | k < 0 = pure xs0
| otherwise = go xs0 k where
go (a:|as) 0 = f a <&> (:|as)
go (a:|as) i = (a:|) <$> ix (i 1) f as
type instance IxValue (Identity a) = a
instance Ixed (Identity a) where
ix () f (Identity a) = Identity <$> f a
type instance IxValue (Tree a) = a
instance Ixed (Tree a) where
ix xs0 f = go xs0 where
go [] (Node a as) = f a <&> \a' -> Node a' as
go (i:is) t@(Node a as)
| i < 0 = pure t
| otherwise = Node a <$> ix i (go is) as
type instance IxValue (Seq a) = a
instance Ixed (Seq a) where
ix i f m
| 0 <= i && i < Seq.length m = f (Seq.index m i) <&> \a -> Seq.update i a m
| otherwise = pure m
type instance IxValue (IntMap a) = a
instance Ixed (IntMap a) where
ix k f m = case IntMap.lookup k m of
Just v -> f v <&> \v' -> IntMap.insert k v' m
Nothing -> pure m
type instance IxValue (Map k a) = a
instance Ord k => Ixed (Map k a) where
ix k f m = case Map.lookup k m of
Just v -> f v <&> \v' -> Map.insert k v' m
Nothing -> pure m
type instance IxValue (HashMap k a) = a
instance (Eq k, Hashable k) => Ixed (HashMap k a) where
ix k f m = case HashMap.lookup k m of
Just v -> f v <&> \v' -> HashMap.insert k v' m
Nothing -> pure m
type instance IxValue (Set k) = ()
instance Ord k => Ixed (Set k) where
ix k f m = if Set.member k m
then f () <&> \() -> Set.insert k m
else pure m
type instance IxValue IntSet = ()
instance Ixed IntSet where
ix k f m = if IntSet.member k m
then f () <&> \() -> IntSet.insert k m
else pure m
type instance IxValue (HashSet k) = ()
instance (Eq k, Hashable k) => Ixed (HashSet k) where
ix k f m = if HashSet.member k m
then f () <&> \() -> HashSet.insert k m
else pure m
type instance IxValue (Array.Array i e) = e
instance Ix i => Ixed (Array.Array i e) where
ix i f arr
| inRange (bounds arr) i = f (arr Array.! i) <&> \e -> arr Array.// [(i,e)]
| otherwise = pure arr
type instance IxValue (UArray i e) = e
instance (IArray UArray e, Ix i) => Ixed (UArray i e) where
ix i f arr
| inRange (bounds arr) i = f (arr Array.! i) <&> \e -> arr Array.// [(i,e)]
| otherwise = pure arr
type instance IxValue (Vector.Vector a) = a
instance Ixed (Vector.Vector a) where
ix i f v
| 0 <= i && i < Vector.length v = f (v Vector.! i) <&> \a -> v Vector.// [(i, a)]
| otherwise = pure v
type instance IxValue (Prim.Vector a) = a
instance Prim a => Ixed (Prim.Vector a) where
ix i f v
| 0 <= i && i < Prim.length v = f (v Prim.! i) <&> \a -> v Prim.// [(i, a)]
| otherwise = pure v
type instance IxValue (Storable.Vector a) = a
instance Storable a => Ixed (Storable.Vector a) where
ix i f v
| 0 <= i && i < Storable.length v = f (v Storable.! i) <&> \a -> v Storable.// [(i, a)]
| otherwise = pure v
type instance IxValue (Unboxed.Vector a) = a
instance Unbox a => Ixed (Unboxed.Vector a) where
ix i f v
| 0 <= i && i < Unboxed.length v = f (v Unboxed.! i) <&> \a -> v Unboxed.// [(i, a)]
| otherwise = pure v
type instance IxValue StrictT.Text = Char
instance Ixed StrictT.Text where
ix e f s = case StrictT.splitAt e s of
(l, mr) -> case StrictT.uncons mr of
Nothing -> pure s
Just (c, xs) -> f c <&> \d -> StrictT.concat [l, StrictT.singleton d, xs]
type instance IxValue LazyT.Text = Char
instance Ixed LazyT.Text where
ix e f s = case LazyT.splitAt e s of
(l, mr) -> case LazyT.uncons mr of
Nothing -> pure s
Just (c, xs) -> f c <&> \d -> LazyT.append l (LazyT.cons d xs)
type instance IxValue StrictB.ByteString = Word8
instance Ixed StrictB.ByteString where
ix e f s = case StrictB.splitAt e s of
(l, mr) -> case StrictB.uncons mr of
Nothing -> pure s
Just (c, xs) -> f c <&> \d -> StrictB.concat [l, StrictB.singleton d, xs]
type instance IxValue LazyB.ByteString = Word8
instance Ixed LazyB.ByteString where
ix e f s = case LazyB.splitAt e s of
(l, mr) -> case LazyB.uncons mr of
Nothing -> pure s
Just (c, xs) -> f c <&> \d -> LazyB.append l (LazyB.cons d xs)
class Ixed m => At m where
at :: Index m -> Lens' m (Maybe (IxValue m))
sans :: At m => Index m -> m -> m
sans k m = m & at k .~ Nothing
iat :: At m => Index m -> IndexedLens' (Index m) m (Maybe (IxValue m))
iat i f = at i (indexed f i)
instance At (Maybe a) where
at () f = f
instance At (IntMap a) where
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
instance Ord k => At (Map k a) where
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
instance (Eq k, Hashable k) => At (HashMap k a) where
at k f m = f mv <&> \r -> case r of
Nothing -> maybe m (const (HashMap.delete k m)) mv
Just v' -> HashMap.insert k v' m
where mv = HashMap.lookup k m
instance At IntSet where
at k f m = f mv <&> \r -> case r of
Nothing -> maybe m (const (IntSet.delete k m)) mv
Just () -> IntSet.insert k m
where mv = if IntSet.member k m then Just () else Nothing
instance Ord k => At (Set k) where
at k f m = f mv <&> \r -> case r of
Nothing -> maybe m (const (Set.delete k m)) mv
Just () -> Set.insert k m
where mv = if Set.member k m then Just () else Nothing
instance (Eq k, Hashable k) => At (HashSet k) where
at k f m = f mv <&> \r -> case r of
Nothing -> maybe m (const (HashSet.delete k m)) mv
Just () -> HashSet.insert k m
where mv = if HashSet.member k m then Just () else Nothing
type instance IxValue (a,a2) = a
instance (a~a2) => Ixed (a,a2) where
ix = elementOf each
type instance IxValue (a,a2,a3) = a
instance (a~a2, a~a3) => Ixed (a,a2,a3) where
ix = elementOf each
type instance IxValue (a,a2,a3,a4) = a
instance (a~a2, a~a3, a~a4) => Ixed (a,a2,a3,a4) where
ix = elementOf each
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 = elementOf each
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 = elementOf each
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 = elementOf each
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 = elementOf each
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 = elementOf each