diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# 1.1 + +Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, C. McCann, 2015-2019 Oleg Grenrus + +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 C. McCann 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/semialign-optics.cabal b/semialign-optics.cabal new file mode 100644 --- /dev/null +++ b/semialign-optics.cabal @@ -0,0 +1,67 @@ +cabal-version: >=1.10 +name: semialign-optics +version: 1.1 +synopsis: SemialignWithIndex, i.e. izipWith and ialignWith +homepage: https://github.com/isomorphism/these +license: BSD3 +license-file: LICENSE +author: C. McCann, Oleg Grenrus +maintainer: Oleg Grenrus +category: Data, These +build-type: Simple +extra-source-files: CHANGELOG.md +description: + This package provides @SemialignWithIndex@ with two members + . + @ + class (FunctorWithIndex i f, Semialign f) => SemialignWithIndex i f | f -> i where + \ ialignWith :: (i -> These a b -> c) -> f a -> f b -> f c + @ + . + @ + class (SemialignWithIndex i f, Zip f) => ZipWithIndex i f | f -> i where + \ izipWith :: (i -> a -> b -> c) -> f a -> f b -> f c + @ + . + Superclass @FunctorWithIndex@ is from @optics-extra@ package. + See https://hackage.haskell.org/package/semialign-indexed for @lens@ variant. + +tested-with: + GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 + , GHCJS ==8.4 + +source-repository head + type: git + location: https://github.com/isomorphism/these.git + +library + default-language: Haskell2010 + ghc-options: -Wall + + if impl(ghc >=8.0) + ghc-options: -Wno-trustworthy-safe + + hs-source-dirs: src + exposed-modules: Data.Semialign.Indexed + + -- ghc boot libs + build-depends: + base >=4.5.1.0 && <4.14 + , containers >=0.4.2.1 && <0.7 + + build-depends: + semialign >=1.1 && <1.2 + , these >=1 && <1.1 + + -- other dependencies + build-depends: + hashable >=1.2.7.0 && <1.4 + , optics-extra >=0.2 && <0.3 + , unordered-containers >=0.2.8.0 && <0.3 + , vector >=0.12.0.2 && <0.13 + + -- base shims + if !impl(ghc >=8.0) + build-depends: + transformers >=0.3.0.0 && <0.6 + , transformers-compat >=0.6.5 && <0.7 diff --git a/src/Data/Semialign/Indexed.hs b/src/Data/Semialign/Indexed.hs new file mode 100644 --- /dev/null +++ b/src/Data/Semialign/Indexed.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE UndecidableInstances #-} +-- | Zipping and aligning of indexed functors. +module Data.Semialign.Indexed ( + SemialignWithIndex (..), + ZipWithIndex (..), + ) where + +import Prelude hiding (repeat, zip, zipWith) + +import Optics.Indexed (FunctorWithIndex (imap)) + +import Data.Align +import Data.These +import Data.Zip + +-- Instances +import Control.Applicative (ZipList) +import Data.Functor.Compose (Compose (..)) +import Data.Functor.Identity (Identity) +import Data.Functor.Product (Product (..)) +import Data.Hashable (Hashable) +import Data.HashMap.Strict (HashMap) +import Data.IntMap (IntMap) +import Data.Map (Map) +import Data.Sequence (Seq) +import Data.Vector (Vector) + +import qualified Data.HashMap.Lazy as HM +import qualified Data.IntMap as IntMap +import qualified Data.Map as Map +import qualified Data.Vector as V + +-- | Indexed version of 'Semialign'. +class (FunctorWithIndex i f, Semialign f) => SemialignWithIndex i f | f -> i where + -- | Analogous to 'alignWith', but also provides an index. + ialignWith :: (i -> These a b -> c) -> f a -> f b -> f c + ialignWith f a b = imap f (align a b) + +-- | Indexed version of 'Zip' +class (SemialignWithIndex i f, Zip f) => ZipWithIndex i f | f -> i where + -- | Analogous to 'zipWith', but also provides an index. + izipWith :: (i -> a -> b -> c) -> f a -> f b -> f c + izipWith f a b = imap (uncurry . f) (zip a b) + +------------------------------------------------------------------------------- +-- base +------------------------------------------------------------------------------- + +instance SemialignWithIndex () Maybe +instance ZipWithIndex () Maybe +instance SemialignWithIndex Int [] +instance ZipWithIndex Int [] +instance SemialignWithIndex Int ZipList +instance ZipWithIndex Int ZipList + +------------------------------------------------------------------------------- +-- transformers +------------------------------------------------------------------------------- + +instance SemialignWithIndex () Identity +instance ZipWithIndex () Identity + +instance (SemialignWithIndex i f, SemialignWithIndex j g) => SemialignWithIndex (Either i j) (Product f g) where + ialignWith f (Pair fa ga) (Pair fb gb) = Pair fc gc where + fc = ialignWith (f . Left) fa fb + gc = ialignWith (f . Right) ga gb + +instance (ZipWithIndex i f, ZipWithIndex j g) => ZipWithIndex (Either i j) (Product f g) where + izipWith f (Pair fa ga) (Pair fb gb) = Pair fc gc where + fc = izipWith (f . Left) fa fb + gc = izipWith (f . Right) ga gb + +instance (SemialignWithIndex i f, SemialignWithIndex j g) => SemialignWithIndex (i, j) (Compose f g) where + ialignWith f (Compose fga) (Compose fgb) = Compose $ ialignWith g fga fgb where + g i (This ga) = imap (\j -> f (i, j) . This) ga + g i (That gb) = imap (\j -> f (i, j) . That) gb + g i (These ga gb) = ialignWith (\j -> f (i, j)) ga gb + +instance (ZipWithIndex i f, ZipWithIndex j g) => ZipWithIndex (i, j) (Compose f g) where + izipWith f (Compose fga) (Compose fgb) = Compose fgc where + fgc = izipWith (\i -> izipWith (\j -> f (i, j))) fga fgb + +------------------------------------------------------------------------------- +-- containers +------------------------------------------------------------------------------- + +instance SemialignWithIndex Int Seq +instance ZipWithIndex Int Seq +instance SemialignWithIndex Int IntMap +instance ZipWithIndex Int IntMap where + izipWith = IntMap.intersectionWithKey +instance Ord k => SemialignWithIndex k (Map k) where +instance Ord k => ZipWithIndex k (Map k) where + izipWith = Map.intersectionWithKey + +------------------------------------------------------------------------------- +-- unordered-containers +------------------------------------------------------------------------------- + +instance (Eq k, Hashable k) => SemialignWithIndex k (HashMap k) where +instance (Eq k, Hashable k) => ZipWithIndex k (HashMap k) where + izipWith = HM.intersectionWithKey + +------------------------------------------------------------------------------- +-- vector +------------------------------------------------------------------------------- + +instance SemialignWithIndex Int Vector where +instance ZipWithIndex Int Vector where + izipWith = V.izipWith