{-# LANGUAGE RankNTypes #-}
module Fresnel.At
( -- * Updateable collections
  At(..)
, Index
, IxValue
  -- * Construction
, atSet
, atMap
, ixAt
  -- * Elimination
, sans
) where

import           Control.Monad (guard)
import qualified Data.HashMap.Internal.Strict as HashMap
import qualified Data.HashSet as HashSet
import           Data.Hashable
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Fresnel.Ixed
import           Fresnel.Lens (Lens', lens)
import           Fresnel.Maybe (_Just)
import           Fresnel.Optional (Optional')
import           Fresnel.Setter

-- Updateable collections

class Ixed c => At c where
  at :: Index c -> Lens' c (Maybe (IxValue c))

instance At IntSet.IntSet where
  at :: Index IntSet -> Lens' IntSet (Maybe (IxValue IntSet))
at = (Index IntSet -> IntSet -> Bool)
-> (Index IntSet -> IntSet -> IntSet)
-> (Index IntSet -> IntSet -> IntSet)
-> Index IntSet
-> Lens' IntSet (Maybe ())
forall c.
(Index c -> c -> Bool)
-> (Index c -> c -> c)
-> (Index c -> c -> c)
-> Index c
-> Lens' c (Maybe ())
atSet Key -> IntSet -> Bool
Index IntSet -> IntSet -> Bool
IntSet.member Key -> IntSet -> IntSet
Index IntSet -> IntSet -> IntSet
IntSet.insert Key -> IntSet -> IntSet
Index IntSet -> IntSet -> IntSet
IntSet.delete

instance At (IntMap.IntMap v) where
  at :: Index (IntMap v) -> Lens' (IntMap v) (Maybe (IxValue (IntMap v)))
at = (Index (IntMap v) -> IntMap v -> Maybe (IxValue (IntMap v)))
-> (Index (IntMap v) -> IxValue (IntMap v) -> IntMap v -> IntMap v)
-> (Index (IntMap v) -> IntMap v -> IntMap v)
-> Index (IntMap v)
-> Lens' (IntMap v) (Maybe (IxValue (IntMap v)))
forall c.
(Index c -> c -> Maybe (IxValue c))
-> (Index c -> IxValue c -> c -> c)
-> (Index c -> c -> c)
-> Index c
-> Lens' c (Maybe (IxValue c))
atMap Key -> IntMap v -> Maybe v
Index (IntMap v) -> IntMap v -> Maybe (IxValue (IntMap v))
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key -> v -> IntMap v -> IntMap v
Index (IntMap v) -> IxValue (IntMap v) -> IntMap v -> IntMap v
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert Key -> IntMap v -> IntMap v
Index (IntMap v) -> IntMap v -> IntMap v
forall a. Key -> IntMap a -> IntMap a
IntMap.delete

instance Ord k => At (Set.Set k) where
  at :: Index (Set k) -> Lens' (Set k) (Maybe (IxValue (Set k)))
at = (Index (Set k) -> Set k -> Bool)
-> (Index (Set k) -> Set k -> Set k)
-> (Index (Set k) -> Set k -> Set k)
-> Index (Set k)
-> Lens' (Set k) (Maybe ())
forall c.
(Index c -> c -> Bool)
-> (Index c -> c -> c)
-> (Index c -> c -> c)
-> Index c
-> Lens' c (Maybe ())
atSet k -> Set k -> Bool
Index (Set k) -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k -> Set k -> Set k
Index (Set k) -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k -> Set k -> Set k
Index (Set k) -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.delete

instance Ord k => At (Map.Map k v) where
  at :: Index (Map k v) -> Lens' (Map k v) (Maybe (IxValue (Map k v)))
at = (Index (Map k v) -> Map k v -> Maybe (IxValue (Map k v)))
-> (Index (Map k v) -> IxValue (Map k v) -> Map k v -> Map k v)
-> (Index (Map k v) -> Map k v -> Map k v)
-> Index (Map k v)
-> Lens' (Map k v) (Maybe (IxValue (Map k v)))
forall c.
(Index c -> c -> Maybe (IxValue c))
-> (Index c -> IxValue c -> c -> c)
-> (Index c -> c -> c)
-> Index c
-> Lens' c (Maybe (IxValue c))
atMap k -> Map k v -> Maybe v
Index (Map k v) -> Map k v -> Maybe (IxValue (Map k v))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k -> v -> Map k v -> Map k v
Index (Map k v) -> IxValue (Map k v) -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k -> Map k v -> Map k v
Index (Map k v) -> Map k v -> Map k v
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete

instance (Eq k, Hashable k) => At (HashSet.HashSet k) where
  at :: Index (HashSet k)
-> Lens' (HashSet k) (Maybe (IxValue (HashSet k)))
at = (Index (HashSet k) -> HashSet k -> Bool)
-> (Index (HashSet k) -> HashSet k -> HashSet k)
-> (Index (HashSet k) -> HashSet k -> HashSet k)
-> Index (HashSet k)
-> Lens' (HashSet k) (Maybe ())
forall c.
(Index c -> c -> Bool)
-> (Index c -> c -> c)
-> (Index c -> c -> c)
-> Index c
-> Lens' c (Maybe ())
atSet k -> HashSet k -> Bool
Index (HashSet k) -> HashSet k -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member k -> HashSet k -> HashSet k
Index (HashSet k) -> HashSet k -> HashSet k
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert k -> HashSet k -> HashSet k
Index (HashSet k) -> HashSet k -> HashSet k
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.delete

instance (Eq k, Hashable k) => At (HashMap.HashMap k v) where
  at :: Index (HashMap k v)
-> Lens' (HashMap k v) (Maybe (IxValue (HashMap k v)))
at = (Index (HashMap k v)
 -> HashMap k v -> Maybe (IxValue (HashMap k v)))
-> (Index (HashMap k v)
    -> IxValue (HashMap k v) -> HashMap k v -> HashMap k v)
-> (Index (HashMap k v) -> HashMap k v -> HashMap k v)
-> Index (HashMap k v)
-> Lens' (HashMap k v) (Maybe (IxValue (HashMap k v)))
forall c.
(Index c -> c -> Maybe (IxValue c))
-> (Index c -> IxValue c -> c -> c)
-> (Index c -> c -> c)
-> Index c
-> Lens' c (Maybe (IxValue c))
atMap k -> HashMap k v -> Maybe v
Index (HashMap k v) -> HashMap k v -> Maybe (IxValue (HashMap k v))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k -> v -> HashMap k v -> HashMap k v
Index (HashMap k v)
-> IxValue (HashMap k v) -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k -> HashMap k v -> HashMap k v
Index (HashMap k v) -> HashMap k v -> HashMap k v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete

instance At (Maybe a) where
  at :: Index (Maybe a) -> Lens' (Maybe a) (Maybe (IxValue (Maybe a)))
at Index (Maybe a)
_ = (Maybe a -> Maybe a)
-> (Maybe a -> Maybe a -> Maybe a)
-> Lens (Maybe a) (Maybe a) (Maybe a) (Maybe a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Maybe a -> Maybe a
forall a. a -> a
id ((Maybe a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a
forall a b. a -> b -> a
const Maybe a -> Maybe a
forall a. a -> a
id)


-- Construction

atSet :: (Index c -> c -> Bool) -> (Index c -> c -> c) -> (Index c -> c -> c) -> Index c -> Lens' c (Maybe ())
atSet :: forall c.
(Index c -> c -> Bool)
-> (Index c -> c -> c)
-> (Index c -> c -> c)
-> Index c
-> Lens' c (Maybe ())
atSet Index c -> c -> Bool
member Index c -> c -> c
insert Index c -> c -> c
delete Index c
k = (c -> Maybe ())
-> (c -> Maybe () -> c) -> Lens c c (Maybe ()) (Maybe ())
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (c -> Bool) -> c -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index c -> c -> Bool
member Index c
k) (\ c
s -> c -> (() -> c) -> Maybe () -> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Index c -> c -> c
delete Index c
k c
s) (c -> () -> c
forall a b. a -> b -> a
const (Index c -> c -> c
insert Index c
k c
s)))

atMap :: (Index c -> c -> Maybe (IxValue c)) -> (Index c -> IxValue c -> c -> c) -> (Index c -> c -> c) -> Index c -> Lens' c (Maybe (IxValue c))
atMap :: forall c.
(Index c -> c -> Maybe (IxValue c))
-> (Index c -> IxValue c -> c -> c)
-> (Index c -> c -> c)
-> Index c
-> Lens' c (Maybe (IxValue c))
atMap Index c -> c -> Maybe (IxValue c)
lookup Index c -> IxValue c -> c -> c
insert Index c -> c -> c
delete Index c
k = (c -> Maybe (IxValue c))
-> (c -> Maybe (IxValue c) -> c)
-> Lens c c (Maybe (IxValue c)) (Maybe (IxValue c))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Index c -> c -> Maybe (IxValue c)
lookup Index c
k) (\ c
m -> c -> (IxValue c -> c) -> Maybe (IxValue c) -> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Index c -> c -> c
delete Index c
k c
m) ((IxValue c -> c -> c) -> c -> IxValue c -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Index c -> IxValue c -> c -> c
insert Index c
k) c
m))

ixAt :: At a => Index a -> Optional' a (IxValue a)
ixAt :: forall a. At a => Index a -> Optional' a (IxValue a)
ixAt Index a
i = Index a -> Lens' a (Maybe (IxValue a))
forall c. At c => Index c -> Lens' c (Maybe (IxValue c))
at Index a
i Optic p a a (Maybe (IxValue a)) (Maybe (IxValue a))
-> (p (IxValue a) (IxValue a)
    -> p (Maybe (IxValue a)) (Maybe (IxValue a)))
-> p (IxValue a) (IxValue a)
-> p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (IxValue a) (IxValue a)
-> p (Maybe (IxValue a)) (Maybe (IxValue a))
forall a a' (p :: * -> * -> *).
IsPrism p =>
Optic p (Maybe a) (Maybe a') a a'
_Just


-- Elimination

sans :: At c => Index c -> c -> c
sans :: forall c. At c => Index c -> c -> c
sans Index c
k = Index c -> Lens' c (Maybe (IxValue c))
forall c. At c => Index c -> Lens' c (Maybe (IxValue c))
at Index c
k (forall {p :: * -> * -> *}.
 IsSetter p =>
 Optic p c c (Maybe (IxValue c)) (Maybe (IxValue c)))
-> Maybe (IxValue c) -> c -> c
forall s t a b. Setter s t a b -> b -> s -> t
.~ Maybe (IxValue c)
forall a. Maybe a
Nothing