strict-containers-lens (empty) → 0.1

raw patch · 9 files changed

+539/−0 lines, 9 filesdep +basedep +hashabledep +lens

Dependencies added: base, hashable, lens, strict-containers

Files

• CHANGELOG.md +7/−0
• LICENSE +24/−0
• src/Data/Strict/Containers/Lens.hs +10/−0
• src/Data/Strict/HashMap/Lens.hs +63/−0
• src/Data/Strict/IntMap/Lens.hs +75/−0
• src/Data/Strict/Map/Lens.hs +80/−0
• src/Data/Strict/Sequence/Lens.hs +120/−0
• src/Data/Strict/Vector/Lens.hs +119/−0
• strict-containers-lens.cabal +41/−0

@@ -0,0 +1,7 @@+# Revision history for strict-containers-lens++## 0.1 -- 2021-04-20++- Initial release, defining lens instances for `Data.Strict.HashMap`,+  `Data.Strict.IntMap`, `Data.Strict.Map`, `Data.Strict.Sequence`, and+  `Data.Strict.Vector`.

@@ -0,0 +1,24 @@+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

@@ -0,0 +1,10 @@+{- | Convenience module for importing all strict-containers lens instances. -}+module Data.Strict.Containers.Lens+  (+  ) where++import           Data.Strict.HashMap.Lens ()+import           Data.Strict.IntMap.Lens ()+import           Data.Strict.Map.Lens ()+import           Data.Strict.Sequence.Lens ()+import           Data.Strict.Vector.Lens ()

@@ -0,0 +1,63 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Strict.HashMap.Lens+  (+  ) where++import           Control.Lens+import           Data.Hashable (Hashable)++import qualified Data.Strict.HashMap as HM++import           Data.Strict.HashMap (HashMap)+++#if !MIN_VERSION_lens(5,0,0)+instance FunctorWithIndex k (HashMap k) where+  imap = HM.mapWithKey+  {-# INLINE imap #-}++instance FoldableWithIndex k (HashMap k) where+  ifoldr  = HM.foldrWithKey+  {-# INLINE ifoldr #-}+  ifoldl' = HM.foldlWithKey' . flip+  {-# INLINE ifoldl' #-}++instance TraversableWithIndex k (HashMap k) where+  itraverse = HM.traverseWithKey+  {-# INLINE itraverse #-}+#endif++type instance Index (HashMap k v) = k+type instance IxValue (HashMap k v) = v++instance (Eq k, Hashable k) => Ixed (HashMap k a) where+  ix k f m = case HM.lookup k m of+     Just v  -> f v <&> \v' -> HM.insert k v' m+     Nothing -> pure m+  {-# INLINE ix #-}++instance (Eq k, Hashable k) => At (HashMap k v) where+  at k f = HM.alterF f k+  {-# INLINE at #-}++instance AsEmpty (HashMap k a) where+  _Empty = nearly HM.empty HM.null+  {-# INLINE _Empty #-}++instance (c ~ d) => Each (HashMap c a) (HashMap d b) a b where+  each = traversed+  {-# INLINE each #-}++instance (t ~ HashMap k' a', Hashable k, Eq k) => Rewrapped (HashMap k a) t+instance (Hashable k, Eq k) => Wrapped (HashMap k a) where+  type Unwrapped (HashMap k a) = [(k, a)]+  _Wrapped' = iso HM.toList HM.fromList+  {-# INLINE _Wrapped' #-}

@@ -0,0 +1,75 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Strict.IntMap.Lens+  (+  ) where++import           Control.Lens++import qualified Data.Strict.IntMap as IM++import           Data.Strict.IntMap (IntMap)+++#if !MIN_VERSION_lens(5,0,0)+instance FunctorWithIndex Int IntMap where+  imap = IM.mapWithKey+  {-# INLINE imap #-}++instance FoldableWithIndex Int IntMap where+  ifoldMap = IM.foldMapWithKey+  {-# INLINE ifoldMap #-}+  ifoldr   = IM.foldrWithKey+  {-# INLINE ifoldr #-}+  ifoldl'  = IM.foldlWithKey' . flip+  {-# INLINE ifoldl' #-}++instance TraversableWithIndex Int IntMap where+  itraverse = IM.traverseWithKey+  {-# INLINE itraverse #-}+#endif++type instance Index (IntMap a) = Int+type instance IxValue (IntMap a) = a+instance Ixed (IntMap a) where+  ix k f m = case IM.lookup k m of+     Just v -> f v <&> \v' -> IM.insert k v' m+     Nothing -> pure m+  {-# INLINE ix #-}++instance At (IntMap a) where+  at k f = IM.alterF f k+  {-# INLINE at #-}++instance AsEmpty (IntMap a) where+  _Empty = nearly IM.empty IM.null+  {-# INLINE _Empty #-}++instance Each (IntMap a) (IntMap b) a b where+  each = traversed+  {-# INLINE each #-}++instance (t ~ IntMap a') => Rewrapped (IntMap a) t+instance Wrapped (IntMap a) where+  type Unwrapped (IntMap a) = [(Int, a)]+  _Wrapped' = iso IM.toAscList IM.fromList+  {-# INLINE _Wrapped' #-}++instance TraverseMin Int IntMap where+  traverseMin f m = case IM.minViewWithKey m of+    Just ((k,a), _) -> indexed f k a <&> \v -> IM.updateMin (const (Just v)) m+    Nothing     -> pure m+  {-# INLINE traverseMin #-}++instance TraverseMax Int IntMap where+  traverseMax f m = case IM.maxViewWithKey m of+    Just ((k,a), _) -> indexed f k a <&> \v -> IM.updateMax (const (Just v)) m+    Nothing     -> pure m+  {-# INLINE traverseMax #-}

@@ -0,0 +1,80 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Strict.Map.Lens+  ( toMapOf+  ) where++import           Control.Lens++import qualified Data.Strict.Map as M++import           Data.Strict.Map (Map)+++#if !MIN_VERSION_lens(5,0,0)+instance FunctorWithIndex k (Map k) where+  imap = M.mapWithKey+  {-# INLINE imap #-}++instance FoldableWithIndex k (Map k) where+  ifoldMap = M.foldMapWithKey+  {-# INLINE ifoldMap #-}+  ifoldr   = M.foldrWithKey+  {-# INLINE ifoldr #-}+  ifoldl'  = M.foldlWithKey' . flip+  {-# INLINE ifoldl' #-}++instance TraversableWithIndex k (Map k) where+  itraverse = M.traverseWithKey+  {-# INLINE itraverse #-}+#endif++type instance Index (Map k v) = k+type instance IxValue (Map k v) = v++instance Ord k => Ixed (Map k a) where+  ix k f m = case M.lookup k m of+     Just v  -> f v <&> \v' -> M.insert k v' m+     Nothing -> pure m+  {-# INLINE ix #-}++instance Ord k => At (Map k v) where+  at k f = M.alterF f k+  {-# INLINE at #-}++instance AsEmpty (Map k a) where+  _Empty = nearly M.empty M.null+  {-# INLINE _Empty #-}++instance (c ~ d) => Each (Map c a) (Map d b) a b where+  each = traversed+  {-# INLINE each #-}++instance (t ~ Map k' a', Ord k) => Rewrapped (Map k a) t+instance Ord k => Wrapped (Map k a) where+  type Unwrapped (Map k a) = [(k, a)]+  _Wrapped' = iso M.toAscList M.fromList+  {-# INLINE _Wrapped' #-}++instance Ord k => TraverseMin k (Map k) where+  traverseMin f m = case M.minViewWithKey m of+    Just ((k, a), _) -> indexed f k a <&> \v -> M.updateMin (const (Just v)) m+    Nothing          -> pure m+  {-# INLINE traverseMin #-}++instance Ord k => TraverseMax k (Map k) where+  traverseMax f m = case M.maxViewWithKey m of+    Just ((k, a), _) -> indexed f k a <&> \v -> M.updateMax (const (Just v)) m+    Nothing          -> pure m+  {-# INLINE traverseMax #-}++-- | Analogous to 'Data.Map.Lens.toMapOf'.+toMapOf :: IndexedGetting i (Map i a) s a -> s -> Map i a+toMapOf l = iviews l M.singleton

@@ -0,0 +1,120 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Strict.Sequence.Lens+  ( viewL+  , viewR+  , slicedTo+  , slicedFrom+  , sliced+  , seqOf+  ) where++import           Control.Lens++import qualified Data.Foldable as Foldable+import qualified Data.Strict.Sequence as Seq++import           Data.Strict.Sequence (Seq, ViewL(EmptyL), ViewR(EmptyR), (><), viewl, viewr)+++#if !MIN_VERSION_lens(5,0,0)+instance FunctorWithIndex Int Seq where+  imap = Seq.mapWithIndex+  {-# INLINE imap #-}++instance FoldableWithIndex Int Seq where+  ifoldMap = Seq.foldMapWithIndex+  {-# INLINE ifoldMap #-}+  ifoldr = Seq.foldrWithIndex+  {-# INLINE ifoldr #-}+  ifoldl f = Seq.foldlWithIndex (flip f)+  {-# INLINE ifoldl #-}++instance TraversableWithIndex Int Seq where+  itraverse = Seq.traverseWithIndex+  {-# INLINE itraverse #-}+#endif++type instance Index (Seq a) = Int+type instance IxValue (Seq a) = a+instance Ixed (Seq a) where+  -- This is slightly different from lens' definition to make our ixTest work.+  -- It is analogous to how Map.ix is defined.+  ix i f m = case Seq.lookup i m of+    Nothing -> pure m+    Just v -> f v <&> \a -> Seq.update i a m+  {-# INLINE ix #-}++instance AsEmpty (Seq a) where+  _Empty = nearly Seq.empty Seq.null+  {-# INLINE _Empty #-}++instance Each (Seq a) (Seq b) a b where+  each = traversed+  {-# INLINE each #-}++instance (t ~ Seq a') => Rewrapped (Seq a) t+instance Wrapped (Seq a) where+  type Unwrapped (Seq a) = [a]+  _Wrapped' = iso Foldable.toList Seq.fromList+  {-# INLINE _Wrapped' #-}++instance Cons (Seq a) (Seq b) a b where+  _Cons = prism (uncurry (Seq.<|)) $ \aas -> case viewl aas of+    a Seq.:< as -> Right (a, as)+    EmptyL  -> Left mempty+  {-# INLINE _Cons #-}++instance Snoc (Seq a) (Seq b) a b where+  _Snoc = prism (uncurry (Seq.|>)) $ \aas -> case viewr aas of+    as Seq.:> a -> Right (as, a)+    EmptyR  -> Left mempty+  {-# INLINE _Snoc #-}++instance Reversing (Seq a) where+  reversing = Seq.reverse++-- | Analogous to 'Data.Sequence.Lens.viewL'.+viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b)+viewL = iso viewl $ \ xs -> case xs of+  EmptyL ->  mempty+  a Seq.:< as -> a Seq.<| as+{-# INLINE viewL #-}++-- | Analogous to 'Data.Sequence.Lens.viewR'.+viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b)+viewR = iso viewr $ \xs -> case xs of+  EmptyR  -> mempty+  as Seq.:> a -> as Seq.|> a+{-# INLINE viewR #-}++-- | Analogous to 'Data.Sequence.Lens.slicedTo'.+slicedTo :: Int -> IndexedTraversal' Int (Seq a) a+slicedTo n f m = case Seq.splitAt n m of+  (l,r) -> (>< r) <$> itraverse (indexed f) l+{-# INLINE slicedTo #-}++-- | Analogous to 'Data.Sequence.Lens.slicedFrom'.+slicedFrom :: Int -> IndexedTraversal' Int (Seq a) a+slicedFrom n f m = case Seq.splitAt n m of+  (l,r) -> (l ><) <$> itraverse (indexed f . (+n)) r+{-# INLINE slicedFrom #-}++-- | Analogous to 'Data.Sequence.Lens.sliced'.+sliced :: Int -> Int -> IndexedTraversal' Int (Seq a) a+sliced i j f s = case Seq.splitAt i s of+  (l,mr) -> case Seq.splitAt (j-i) mr of+     (m, r) -> itraverse (indexed f . (+i)) m <&> \n -> l >< n >< r+{-# INLINE sliced #-}++-- | Analogous to 'Data.Sequence.Lens.seqOf'.+seqOf :: Getting (Seq a) s a -> s -> Seq a+seqOf l = views l Seq.singleton+{-# INLINE seqOf #-}

@@ -0,0 +1,119 @@+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Strict.Vector.Lens+  ( toVectorOf+  , vector+  , forced+  , sliced+  , ordinals+  ) where++import           Control.Lens+import           Control.Lens.Internal.List (ordinalNub)+import           Data.Vector.Generic.Lens (vectorTraverse)+import           Data.Monoid (Endo)++import qualified Data.Strict.Vector as V++import           Data.Strict.Vector (Vector)+++#if !MIN_VERSION_lens(5,0,0)+instance FunctorWithIndex Int Vector where+  imap = V.imap+  {-# INLINE imap #-}++instance FoldableWithIndex Int Vector where+  ifoldr = V.ifoldr+  {-# INLINE ifoldr #-}+  ifoldl = V.ifoldl . flip+  {-# INLINE ifoldl #-}+  ifoldr' = V.ifoldr'+  {-# INLINE ifoldr' #-}+  ifoldl' = V.ifoldl' . flip+  {-# INLINE ifoldl' #-}++instance TraversableWithIndex Int Vector where+  itraverse f v =+    let !n = V.length v in V.fromListN n <$> itraverse f (V.toList v)+  {-# INLINE itraverse #-}+#endif++type instance Index (Vector a) = Int+type instance IxValue (Vector a) = a+instance Ixed (Vector a) where+  -- This is slightly different from lens' definition to make our ixTest work.+  -- Unlike Sequence, since the element is stored inside a primitive array the+  -- only way to get it is via a primop, so we have to force-apply ($!) the+  -- extraction. Pattern matching on a case-expr (e.g. the result of V.!?) is+  -- ineffective because that still has to call the primop, so we would still+  -- have a thunk after pattern matching.+  ix i f v+    | 0 <= i && i < V.length v = (f $! v V.! i) <&> \a -> v V.// [(i, a)]+    | otherwise                     = pure v+  {-# INLINE ix #-}++instance AsEmpty (Vector a) where+  _Empty = nearly V.empty V.null+  {-# INLINE _Empty #-}++instance Each (Vector a) (Vector b) a b where+  each = vectorTraverse+  {-# INLINE each #-}++instance (t ~ Vector a') => Rewrapped (Vector a) t+instance Wrapped (Vector a) where+  type Unwrapped (Vector a) = [a]+  _Wrapped' = iso V.toList V.fromList+  {-# INLINE _Wrapped' #-}++instance Cons (Vector a) (Vector b) a b where+  _Cons = prism (uncurry V.cons) $ \v ->+    if V.null v+    then Left V.empty+    else Right (V.unsafeHead v, V.unsafeTail v)+  {-# INLINE _Cons #-}++instance Snoc (Vector a) (Vector b) a b where+  _Snoc = prism (uncurry V.snoc) $ \v -> if V.null v+    then Left V.empty+    else Right (V.unsafeInit v, V.unsafeLast v)+  {-# INLINE _Snoc #-}++instance Reversing (Vector a) where+  reversing = V.reverse++-- | Analogous to 'Data.Vector.Lens.sliced'.+sliced :: Int -- ^ @i@ starting index+       -> Int -- ^ @n@ length+       -> Lens' (Vector a) (Vector a)+sliced i n f v = f (V.slice i n v) <&> \ v0 -> v V.// zip [i..i+n-1] (V.toList v0)+{-# INLINE sliced #-}++-- | Analogous to 'Data.Vector.Lens.toVectorOf'.+toVectorOf :: Getting (Endo [a]) s a -> s -> Vector a+toVectorOf l s = V.fromList (toListOf l s)+{-# INLINE toVectorOf #-}++-- | Analogous to 'Data.Vector.Lens.vector'.+vector :: Iso [a] [b] (Vector a) (Vector b)+vector = iso V.fromList V.toList+{-# INLINE vector #-}++-- | Analogous to 'Data.Vector.Lens.forced'.+forced :: Iso (Vector a) (Vector b) (Vector a) (Vector b)+forced = iso V.force V.force+{-# INLINE forced #-}++-- | Analogous to 'Data.Vector.Lens.ordinals'.+ordinals :: [Int] -> IndexedTraversal' Int (Vector a) a+ordinals is f v = fmap (v V.//) $ traverse (\i -> (,) i <$> indexed f i (v V.! i)) $ ordinalNub (length v) is+{-# INLINE ordinals #-}

@@ -0,0 +1,41 @@+Name:           strict-containers-lens+Version:        0.1+Synopsis:       Strict containers - Lens instances+Category:       Data, Data Structures, Lenses+Description:+  This package provides @lens@ utilities and instances for @strict-containers@.+License:        BSD3+License-File:   LICENSE+Maintainer:     Ximin Luo <infinity0@pwned.gg>+Copyright:      (c) 2021 by Ximin Luo+Homepage:       https://github.com/haskellari/strict-containers+Cabal-Version: >= 1.10+Build-type:     Simple+extra-source-files:+    CHANGELOG.md+tested-with:+  GHC ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.3+   || ==8.10.4+   || ==9.0.1++library+  default-language: Haskell2010+  hs-source-dirs:   src+  ghc-options:      -Wall++  build-depends:+      base                  >= 4.5.0.0  && < 5+    , hashable              >= 1.2.7.0  && < 1.4+    , strict-containers     >= 0.1+    , lens                  >= 4.19     && < 6++  exposed-modules:+    Data.Strict.Containers.Lens+    Data.Strict.HashMap.Lens+    Data.Strict.IntMap.Lens+    Data.Strict.Map.Lens+    Data.Strict.Sequence.Lens+    Data.Strict.Vector.Lens