diff --git a/Data/Map/Class.hs b/Data/Map/Class.hs new file mode 100644 --- /dev/null +++ b/Data/Map/Class.hs @@ -0,0 +1,42 @@ +module Data.Map.Class where + +import Control.Applicative +import Data.Either.Both +import Data.Filtrable +import Data.IntMap (IntMap) +import qualified Data.IntMap as Int +import qualified Data.Map as M +import qualified Data.Map.Merge.Lazy as M +import Util ((∘∘)) + +class (Filtrable map, Traversable map) => Map map where + type Key map + alterF :: Functor f => (Maybe a -> f (Maybe a)) -> Key map -> map a -> f (map a) + mergeA :: Applicative p => (Key map -> Either' a b -> p (Maybe c)) -> map a -> map b -> p (map c) + mapMaybeWithKeyA :: Applicative p => (Key map -> a -> p (Maybe b)) -> map a -> p (map b) + mapEitherWithKeyA :: Applicative p => (Key map -> a -> p (Either b c)) -> map a -> p (map b, map c) + mapEitherWithKeyA f = liftA2 (,) <$> mapMaybeWithKeyA (fmap (Just `either` pure Nothing) ∘∘ f) + <*> mapMaybeWithKeyA (fmap (pure Nothing `either` Just) ∘∘ f) + +instance Filtrable IntMap where + mapMaybe = Int.mapMaybe + +instance Filtrable (M.Map key) where + mapMaybe = M.mapMaybe + +instance Map IntMap where + type Key IntMap = Int + alterF = Int.alterF + mergeA f = mapMaybeWithKeyA f ∘∘ + Int.mergeWithKey (pure $ Just ∘∘ Both) (fmap JustLeft) (fmap JustRight) + mapMaybeWithKeyA f = fmap catMaybes . Int.traverseWithKey f + mapEitherWithKeyA f = fmap partitionEithers . Int.traverseWithKey f + +instance Ord key => Map (M.Map key) where + type Key (M.Map key) = key + alterF = M.alterF + mergeA f = M.mergeA (M.traverseMaybeMissing $ \ k a -> f k (JustLeft a)) + (M.traverseMaybeMissing $ \ k b -> f k (JustRight b)) + (M.zipWithMaybeAMatched $ \ k a b -> f k (Both a b)) + mapMaybeWithKeyA f = fmap catMaybes . M.traverseWithKey f + mapEitherWithKeyA f = fmap partitionEithers . M.traverseWithKey f diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright M Farkas-Dyck © 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of M Farkas-Dyck nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT +OWNER 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. diff --git a/Map.cabal b/Map.cabal new file mode 100644 --- /dev/null +++ b/Map.cabal @@ -0,0 +1,75 @@ +name: Map +version: 0.0.0.0 +synopsis: Class of key-value maps +-- description: +license: BSD3 +license-file: LICENSE +author: M Farkas-Dyck +maintainer: strake888@gmail.com +copyright: 2018 M Farkas-Dyck +category: Data +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: . + exposed-modules: Data.Map.Class + build-depends: base >= 4.7 && < 5 + , containers >=0.5.9 && <0.6 + , either-both >=0.1 && <0.2 + , filtrable >=0.1.1 && <0.2 + , util >=0.1.10 && <0.2 + default-language: Haskell2010 + default-extensions: UnicodeSyntax + , LambdaCase + , EmptyCase + , InstanceSigs + , PartialTypeSignatures + , PolyKinds + , ConstraintKinds + , TypeFamilies + , FlexibleContexts + , FlexibleInstances + , StandaloneDeriving + , DeriveFunctor, DeriveFoldable, DeriveTraversable + ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing + -Wincomplete-record-updates -Wincomplete-uni-patterns + -Werror=incomplete-patterns + -Werror=incomplete-uni-patterns + -Werror=incomplete-record-updates + -Werror=missing-fields + -Werror=missing-methods + +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: base >=4.11 && <5 + , smallcheck >=1.1.4 + , tasty >=1.0 + , tasty-smallcheck >=0.8 + , map + default-language: Haskell2010 + default-extensions: UnicodeSyntax + , LambdaCase + , EmptyCase + , InstanceSigs + , PartialTypeSignatures + , PolyKinds + , ConstraintKinds + , FlexibleContexts + , FlexibleInstances + , StandaloneDeriving + , DeriveFunctor, DeriveFoldable, DeriveTraversable + ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing + -Wincomplete-record-updates -Wincomplete-uni-patterns + -Werror=incomplete-patterns + -Werror=incomplete-uni-patterns + -Werror=incomplete-record-updates + -Werror=missing-fields + -Werror=missing-methods + +source-repository head + type: git + location: https://github.com/strake/map.hs diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# map diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Test.SmallCheck +import Test.Tasty +import Test.Tasty.SmallCheck + +main :: IO () +main = pure ()