{-# LANGUAGE Rank2Types #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  Data.IntSet.Lens

-- Copyright   :  (C) 2012-16 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  provisional

-- Portability :  portable

--

----------------------------------------------------------------------------

module Data.IntSet.Lens
  ( members
  , setmapped
  , setOf
  ) where

import Control.Lens
import qualified Data.IntSet as IntSet
import Data.IntSet (IntSet)

-- $setup

-- >>> :set -XNoOverloadedStrings

-- >>> import Control.Lens

-- >>> import qualified Data.IntSet as IntSet


-- | IntSet isn't Foldable, but this 'Fold' can be used to access the members of an 'IntSet'.

--

-- >>> sumOf members $ setOf folded [1,2,3,4]

-- 10

members :: Fold IntSet Int
members :: Fold IntSet Int
members = forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding IntSet -> [Int]
IntSet.toAscList
{-# INLINE members #-}

-- | This 'Setter' can be used to change the contents of an 'IntSet' by mapping

-- the elements to new values.

--

-- Sadly, you can't create a valid 'Traversal' for a 'Set', because the number of

-- elements might change but you can manipulate it by reading using 'folded' and

-- reindexing it via 'setmapped'.

--

-- >>> over setmapped (+1) (IntSet.fromList [1,2,3,4])

-- fromList [2,3,4,5]

setmapped :: IndexPreservingSetter' IntSet Int
setmapped :: IndexPreservingSetter' IntSet Int
setmapped = forall a b s t.
((a -> b) -> s -> t) -> IndexPreservingSetter s t a b
setting (Int -> Int) -> IntSet -> IntSet
IntSet.map
{-# INLINE setmapped #-}

-- | Construct an 'IntSet' from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'.

--

-- >>> setOf folded [1,2,3,4]

-- fromList [1,2,3,4]

--

-- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)]

-- fromList [1,2,3]

--

-- @

-- 'setOf' :: 'Getter' s 'Int'     -> s -> 'IntSet'

-- 'setOf' :: 'Fold' s 'Int'       -> s -> 'IntSet'

-- 'setOf' :: 'Iso'' s 'Int'       -> s -> 'IntSet'

-- 'setOf' :: 'Lens'' s 'Int'      -> s -> 'IntSet'

-- 'setOf' :: 'Traversal'' s 'Int' -> s -> 'IntSet'

-- @

setOf :: Getting IntSet s Int -> s -> IntSet
setOf :: forall s. Getting IntSet s Int -> s -> IntSet
setOf Getting IntSet s Int
l = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Getting IntSet s Int
l Int -> IntSet
IntSet.singleton
{-# INLINE setOf #-}