{- |
This module allows to access elements of arrays, sets and finite maps
like elements of records.
This is especially useful for working with nested structures
consisting of arrays, sets, maps and records.

Maybe we should move it to a separate package,
then we would not need to import @array@ and @containers@ package.
-}
module Data.Accessor.Container
   (array, set,
    mapDefault, mapMaybe,
    intMapDefault, intMapMaybe,
   ) where

import qualified Data.Accessor.Basic as Accessor

import Data.Ix (Ix, )
import qualified Data.Array  as Array
import qualified Data.Set    as Set
import qualified Data.Map    as Map
import qualified Data.IntMap as IntMap

import Prelude hiding (map)


array :: Ix i => i -> Accessor.T (Array.Array i e) e
array :: forall i e. Ix i => i -> T (Array i e) e
array i
i = forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\e
e Array i e
a -> Array i e
a forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
Array.// [(i
i,e
e)]) (forall i e. Ix i => Array i e -> i -> e
Array.! i
i)

{- |
Treat a Set like a boolean array.
-}
set :: Ord a => a -> Accessor.T (Set.Set a) Bool
set :: forall a. Ord a => a -> T (Set a) Bool
set a
a =
   forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet
      (\Bool
b -> if Bool
b then forall a. Ord a => a -> Set a -> Set a
Set.insert a
a else forall a. Ord a => a -> Set a -> Set a
Set.delete a
a)
      (forall a. Ord a => a -> Set a -> Bool
Set.member a
a)

{- |
Treats a finite map like an infinite map,
where all undefined elements are replaced by a default value.
-}
mapDefault :: Ord key => elem -> key -> Accessor.T (Map.Map key elem) elem
mapDefault :: forall key elem. Ord key => elem -> key -> T (Map key elem) elem
mapDefault elem
deflt key
key =
   forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key) (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault elem
deflt key
key)

{- |
Treats a finite map like an infinite map,
where all undefined elements are 'Nothing'
and defined elements are 'Just'.
-}
mapMaybe :: Ord key => key -> Accessor.T (Map.Map key elem) (Maybe elem)
mapMaybe :: forall key elem. Ord key => key -> T (Map key elem) (Maybe elem)
mapMaybe key
key =
   forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet
      (\Maybe elem
e Map key elem
m -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete key
key Map key elem
m) (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key) Map key elem
m) Maybe elem
e)
      (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key)

intMapDefault :: elem -> Int -> Accessor.T (IntMap.IntMap elem) elem
intMapDefault :: forall elem. elem -> Int -> T (IntMap elem) elem
intMapDefault elem
deflt Int
key =
   forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
key) (forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault elem
deflt Int
key)

intMapMaybe :: Int -> Accessor.T (IntMap.IntMap elem) (Maybe elem)
intMapMaybe :: forall elem. Int -> T (IntMap elem) (Maybe elem)
intMapMaybe Int
key =
   forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet
      (\Maybe elem
e IntMap elem
m -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
key IntMap elem
m) (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
key) IntMap elem
m) Maybe elem
e)
      (forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
key)