diff --git a/CHANGELOG.md b/CHANGELOG.md index 66af655..577e445 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,7 @@ Breaking changes: New features: - Add `ifolded` and `imapped` (#146 by @twhitehead) +- Add `at`/`index` instances for `purescript-unordered-collections` (HashSet & HashMap) Bugfixes: diff --git a/packages.dhall b/packages.dhall index 188382b..508f7dc 100644 --- a/packages.dhall +++ b/packages.dhall @@ -1,4 +1,5 @@ let upstream = https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.15-20240829/src/packages.dhall + sha256:5bab5469c75bd8c7bac517385e6dd66cca0b2651676b4a99b357753c80bbe673 in upstream diff --git a/spago.dhall b/spago.dhall index 4f60f2a..a96d64c 100644 --- a/spago.dhall +++ b/spago.dhall @@ -24,6 +24,7 @@ , "safe-coerce" , "transformers" , "tuples" + , "unordered-collections" ] , packages = ./packages.dhall , sources = [ "src/**/*.purs", "test/**/*.purs" ] diff --git a/src/Data/Lens/At.purs b/src/Data/Lens/At.purs index 9149367..cc26593 100644 --- a/src/Data/Lens/At.purs +++ b/src/Data/Lens/At.purs @@ -6,13 +6,16 @@ module Data.Lens.At import Prelude +import Data.Hashable (class Hashable) import Data.Identity (Identity(..)) import Data.Lens (Lens', lens, set) import Data.Lens.Index (class Index) import Data.Map as M +import Data.HashMap as HM import Data.Maybe (Maybe(..), maybe, maybe') import Data.Newtype (unwrap) import Data.Set as S +import Data.HashSet as HS import Foreign.Object as FO -- | `At` is a type class whose instances let you add @@ -50,11 +53,25 @@ instance atSet :: Ord v => At (S.Set v) v Unit where update Nothing = S.delete x update (Just _) = S.insert x +instance atHashSet :: Hashable v => At (HS.HashSet v) v Unit where + at x = lens get (flip update) + where + get xs = + if HS.member x xs then Just unit + else Nothing + update Nothing = HS.delete x + update (Just _) = HS.insert x + instance atMap :: Ord k => At (M.Map k v) k v where at k = lens (M.lookup k) \m -> maybe' (\_ -> M.delete k m) \v -> M.insert k v m +instance atHashMap :: Hashable k => At (HM.HashMap k v) k v where + at k = + lens (HM.lookup k) \m -> + maybe' (\_ -> HM.delete k m) \v -> HM.insert k v m + instance atForeignObject :: At (FO.Object v) String v where at k = lens (FO.lookup k) \m -> diff --git a/src/Data/Lens/Index.purs b/src/Data/Lens/Index.purs index 2d9d7ef..b98353c 100644 --- a/src/Data/Lens/Index.purs +++ b/src/Data/Lens/Index.purs @@ -5,6 +5,7 @@ module Data.Lens.Index import Prelude +import Data.Hashable (class Hashable) import Data.Array as A import Data.Array.NonEmpty as NEA import Data.Either (Either(..)) @@ -14,8 +15,10 @@ import Data.Lens.AffineTraversal (AffineTraversal', affineTraversal) import Data.Lens.Iso.Newtype (_Newtype) import Data.List as L import Data.Map as M +import Data.HashMap as HM import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Set as S +import Data.HashSet as HS import Foreign.Object as FO -- | `Index` is a type class whose instances are optics used when: @@ -95,6 +98,15 @@ instance indexSet :: Ord a => Index (S.Set a) a Unit where pre :: S.Set a -> Either (S.Set a) Unit pre xs = if S.member x xs then Right unit else Left xs +instance indexHashSet :: Hashable a => Index (HS.HashSet a) a Unit where + ix x = affineTraversal set pre + where + set :: HS.HashSet a -> Unit -> HS.HashSet a + set xs _ = xs + + pre :: HS.HashSet a -> Either (HS.HashSet a) Unit + pre xs = if HS.member x xs then Right unit else Left xs + instance indexMap :: Ord k => Index (M.Map k v) k v where ix k = affineTraversal set pre where @@ -104,6 +116,15 @@ instance indexMap :: Ord k => Index (M.Map k v) k v where pre :: M.Map k v -> Either (M.Map k v) v pre s = maybe (Left s) Right $ M.lookup k s +instance indexHashMap :: Hashable k => Index (HM.HashMap k v) k v where + ix k = affineTraversal set pre + where + set :: HM.HashMap k v -> v -> HM.HashMap k v + set s b = HM.update (\_ -> Just b) k s + + pre :: HM.HashMap k v -> Either (HM.HashMap k v) v + pre s = maybe (Left s) Right $ HM.lookup k s + instance indexForeignObject :: Index (FO.Object v) String v where ix k = affineTraversal set pre where