{-# LANGUAGE CPP #-}
-- |
-- Module: Data.Map.Optics
-- Description: Optics for working with 'Data.Map.Map's.
--
-- This module exists to provide documentation for lenses for working with
-- 'Map', which might otherwise be obscured by their genericity.
--
-- 'Map' is an instance of 'Optics.At.Core.At' and provides 'Optics.At.Core.at'
-- as a lens on values at keys:
--
-- >>> Map.fromList [(1, "world")] ^. at 1
-- Just "world"
--
-- >>> Map.empty & at 1 .~ Just "world"
-- fromList [(1,"world")]
--
-- >>> Map.empty & at 0 .~ Just "hello"
-- fromList [(0,"hello")]
--
-- We can traverse, fold over, and map over key-value pairs in a 'Map',
-- thanks to indexed traversals, folds and setters.
--
-- >>> iover imapped const $ Map.fromList [(1, "Venus")]
-- fromList [(1,1)]
--
-- >>> ifoldMapOf ifolded (\i _ -> Sum i) $ Map.fromList [(2, "Earth"), (3, "Mars")]
-- Sum {getSum = 5}
--
-- >>> itraverseOf_ ifolded (curry print) $ Map.fromList [(4, "Jupiter")]
-- (4,"Jupiter")
--
-- >>> itoListOf ifolded $ Map.fromList [(5, "Saturn")]
-- [(5,"Saturn")]
--
-- A related class, 'Optics.At.Core.Ixed', allows us to use 'Optics.At.Core.ix' to
-- traverse a value at a particular key.
--
-- >>> Map.fromList [(2, "Earth")] & ix 2 %~ ("New " ++)
-- fromList [(2,"New Earth")]
--
-- >>> preview (ix 8) Map.empty
-- Nothing
--
module Data.Map.Optics
  ( toMapOf
  , lt
  , gt
  , le
  , ge
  ) where

import Data.Map (Map)
import qualified Data.Map as Map

import Optics.IxAffineTraversal
import Optics.IxFold
import Optics.Optic

-- | Construct a map from an 'IxFold'.
--
-- The construction is left-biased (see 'Map.union'), i.e. the first
-- occurrences of keys in the fold or traversal order are preferred.
--
-- >>> toMapOf ifolded ["hello", "world"]
-- fromList [(0,"hello"),(1,"world")]
--
-- >>> toMapOf (folded % ifolded) [('a',"alpha"),('b', "beta")]
-- fromList [('a',"alpha"),('b',"beta")]
--
-- >>> toMapOf (ifolded <%> ifolded) ["foo", "bar"]
-- fromList [((0,0),'f'),((0,1),'o'),((0,2),'o'),((1,0),'b'),((1,1),'a'),((1,2),'r')]
--
-- >>> toMapOf (folded % ifolded) [('a', "hello"), ('b', "world"), ('a', "dummy")]
-- fromList [('a',"hello"),('b',"world")]
--
toMapOf
  :: (Is k A_Fold, is `HasSingleIndex` i, Ord i)
  => Optic' k is s a -> s -> Map i a
toMapOf :: Optic' k is s a -> s -> Map i a
toMapOf Optic' k is s a
o = Optic' k is s a -> (i -> a -> Map i a) -> s -> Map i a
forall (k :: OpticKind) (m :: OpticKind) (is :: IxList)
       (i :: OpticKind) (s :: OpticKind) (a :: OpticKind).
(Is k A_Fold, Monoid m, HasSingleIndex is i) =>
Optic' k is s a -> (i -> a -> m) -> s -> m
ifoldMapOf Optic' k is s a
o i -> a -> Map i a
forall (k :: OpticKind) (a :: OpticKind). k -> a -> Map k a
Map.singleton
{-# INLINE toMapOf #-}

-- | Focus on the largest key smaller than the given one and its corresponding
-- value.
--
-- >>> Map.fromList [('a', "hi"), ('b', "there")] & over (lt 'b') (++ "!")
-- fromList [('a',"hi!"),('b',"there")]
--
-- >>> ipreview (lt 'a') $ Map.fromList [('a', 'x'), ('b', 'y')]
-- Nothing
lt :: Ord k => k -> IxAffineTraversal' k (Map k v) v
lt :: k -> IxAffineTraversal' k (Map k v) v
lt k
k = IxAffineTraversalVL k (Map k v) (Map k v) v v
-> IxAffineTraversal' k (Map k v) v
forall (i :: OpticKind) (s :: OpticKind) (t :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
IxAffineTraversalVL i s t a b -> IxAffineTraversal i s t a b
iatraversalVL (IxAffineTraversalVL k (Map k v) (Map k v) v v
 -> IxAffineTraversal' k (Map k v) v)
-> IxAffineTraversalVL k (Map k v) (Map k v) v v
-> IxAffineTraversal' k (Map k v) v
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \forall (r :: OpticKind). r -> f r
point k -> v -> f v
f Map k v
s ->
  case k -> Map k v -> Maybe (k, v)
forall (k :: OpticKind) (v :: OpticKind).
Ord k =>
k -> Map k v -> Maybe (k, v)
Map.lookupLT k
k Map k v
s of
    Maybe (k, v)
Nothing      -> Map k v -> f (Map k v)
forall (r :: OpticKind). r -> f r
point Map k v
s
    Just (k
k', v
v) -> k -> v -> f v
f k
k' v
v f v -> (v -> Map k v) -> f (Map k v)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
f a -> (a -> b) -> f b
<&> \v
v' -> k -> v -> Map k v -> Map k v
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> a -> Map k a -> Map k a
Map.insert k
k' v
v' Map k v
s
{-# INLINE lt #-}

-- | Focus on the smallest key greater than the given one and its corresponding
-- value.
--
-- >>> Map.fromList [('a', "hi"), ('b', "there")] & over (gt 'b') (++ "!")
-- fromList [('a',"hi"),('b',"there")]
--
-- >>> ipreview (gt 'a') $ Map.fromList [('a', 'x'), ('b', 'y')]
-- Just ('b','y')
gt :: Ord k => k -> IxAffineTraversal' k (Map k v) v
gt :: k -> IxAffineTraversal' k (Map k v) v
gt k
k = IxAffineTraversalVL k (Map k v) (Map k v) v v
-> IxAffineTraversal' k (Map k v) v
forall (i :: OpticKind) (s :: OpticKind) (t :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
IxAffineTraversalVL i s t a b -> IxAffineTraversal i s t a b
iatraversalVL (IxAffineTraversalVL k (Map k v) (Map k v) v v
 -> IxAffineTraversal' k (Map k v) v)
-> IxAffineTraversalVL k (Map k v) (Map k v) v v
-> IxAffineTraversal' k (Map k v) v
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \forall (r :: OpticKind). r -> f r
point k -> v -> f v
f Map k v
s ->
  case k -> Map k v -> Maybe (k, v)
forall (k :: OpticKind) (v :: OpticKind).
Ord k =>
k -> Map k v -> Maybe (k, v)
Map.lookupGT k
k Map k v
s of
    Maybe (k, v)
Nothing      -> Map k v -> f (Map k v)
forall (r :: OpticKind). r -> f r
point Map k v
s
    Just (k
k', v
v) -> k -> v -> f v
f k
k' v
v f v -> (v -> Map k v) -> f (Map k v)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
f a -> (a -> b) -> f b
<&> \v
v' -> k -> v -> Map k v -> Map k v
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> a -> Map k a -> Map k a
Map.insert k
k' v
v' Map k v
s
{-# INLINE gt #-}

-- | Focus on the largest key smaller or equal than the given one and its
-- corresponding value.
--
-- >>> Map.fromList [('a', "hi"), ('b', "there")] & over (le 'b') (++ "!")
-- fromList [('a',"hi"),('b',"there!")]
--
-- >>> ipreview (le 'a') $ Map.fromList [('a', 'x'), ('b', 'y')]
-- Just ('a','x')
le :: Ord k => k -> IxAffineTraversal' k (Map k v) v
le :: k -> IxAffineTraversal' k (Map k v) v
le k
k = IxAffineTraversalVL k (Map k v) (Map k v) v v
-> IxAffineTraversal' k (Map k v) v
forall (i :: OpticKind) (s :: OpticKind) (t :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
IxAffineTraversalVL i s t a b -> IxAffineTraversal i s t a b
iatraversalVL (IxAffineTraversalVL k (Map k v) (Map k v) v v
 -> IxAffineTraversal' k (Map k v) v)
-> IxAffineTraversalVL k (Map k v) (Map k v) v v
-> IxAffineTraversal' k (Map k v) v
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \forall (r :: OpticKind). r -> f r
point k -> v -> f v
f Map k v
s ->
  case k -> Map k v -> Maybe (k, v)
forall (k :: OpticKind) (v :: OpticKind).
Ord k =>
k -> Map k v -> Maybe (k, v)
Map.lookupLE k
k Map k v
s of
    Maybe (k, v)
Nothing      -> Map k v -> f (Map k v)
forall (r :: OpticKind). r -> f r
point Map k v
s
    Just (k
k', v
v) -> k -> v -> f v
f k
k' v
v f v -> (v -> Map k v) -> f (Map k v)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
f a -> (a -> b) -> f b
<&> \v
v' -> k -> v -> Map k v -> Map k v
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> a -> Map k a -> Map k a
Map.insert k
k' v
v' Map k v
s
{-# INLINE le #-}

-- | Focus on the smallest key greater or equal than the given one and its
-- corresponding value.
--
-- >>> Map.fromList [('a', "hi"), ('c', "there")] & over (ge 'b') (++ "!")
-- fromList [('a',"hi"),('c',"there!")]
--
-- >>> ipreview (ge 'b') $ Map.fromList [('a', 'x'), ('c', 'y')]
-- Just ('c','y')
ge :: Ord k => k -> IxAffineTraversal' k (Map k v) v
ge :: k -> IxAffineTraversal' k (Map k v) v
ge k
k = IxAffineTraversalVL k (Map k v) (Map k v) v v
-> IxAffineTraversal' k (Map k v) v
forall (i :: OpticKind) (s :: OpticKind) (t :: OpticKind)
       (a :: OpticKind) (b :: OpticKind).
IxAffineTraversalVL i s t a b -> IxAffineTraversal i s t a b
iatraversalVL (IxAffineTraversalVL k (Map k v) (Map k v) v v
 -> IxAffineTraversal' k (Map k v) v)
-> IxAffineTraversalVL k (Map k v) (Map k v) v v
-> IxAffineTraversal' k (Map k v) v
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \forall (r :: OpticKind). r -> f r
point k -> v -> f v
f Map k v
s ->
  case k -> Map k v -> Maybe (k, v)
forall (k :: OpticKind) (v :: OpticKind).
Ord k =>
k -> Map k v -> Maybe (k, v)
Map.lookupGE k
k Map k v
s of
    Maybe (k, v)
Nothing      -> Map k v -> f (Map k v)
forall (r :: OpticKind). r -> f r
point Map k v
s
    Just (k
k', v
v) -> k -> v -> f v
f k
k' v
v f v -> (v -> Map k v) -> f (Map k v)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
f a -> (a -> b) -> f b
<&> \v
v' -> k -> v -> Map k v -> Map k v
forall (k :: OpticKind) (a :: OpticKind).
Ord k =>
k -> a -> Map k a -> Map k a
Map.insert k
k' v
v' Map k v
s
{-# INLINE ge #-}

-- $setup
-- >>> import Data.Monoid
-- >>> import Optics.Core