packages feed

semialign-extras (empty) → 0.1.0.0

raw patch · 8 files changed

+468/−0 lines, 8 filesdep +QuickCheckdep +basedep +doctestsetup-changed

Dependencies added: QuickCheck, base, doctest, lens, semialign, semialign-indexed, these, witherable

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for semialign-extras++## 0.1.0.0 -- 2019-11-15++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2019, Commonwealth Scientific and Industrial Research Organisation+(CSIRO) ABN 41 687 119 230.++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 Jack Kelly 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.
+ README.md view
@@ -0,0 +1,35 @@+# semialign-extras++![Data61 Logo](https://raw.githubusercontent.com/qfpl/assets/master/data61-transparent-bg.png)++[![Build Status](https://travis-ci.org/qfpl/semialign-extras.svg?branch=master)](https://travis-ci.org/qfpl/semialign-extras)++The `Semialign` typeclass (from+[`semialign`](https://hackage.haskell.org/package/semialign)) lets us+line up two structures of the same type. By combining this with the+`Filterable` and `Witherable` typeclasses from the+[`witherable`](https://hackage.haskell.org/package/witherable)+package, we can derive a number of useful diff/patch/merge-style+operations.++## Scope of the Library++`semialign-extras` aims to be a collection of interesting+abstractions/operations that:++1. Build on top of (at least) the `Semialign` typeclass, or related+   classes from the `semialign` universe; and++2. Do not belong inside other packages in the `semialign` universe.++PRs that serve these goals are most welcome.++### Rationale++`semialign` has a very lean dependency footprint, and its authors+intend to keep it that way. If your PR can work within the small+dependency footprint of `semialign`, it probably should be offered up+there first.++`semialign-extras` already depends on `lens`, so the marginal cost of+additional dependencies is likely to be small.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ doctests/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest ["-isrc", "src/Data/Semialign/Diff.hs"]
+ semialign-extras.cabal view
@@ -0,0 +1,52 @@+cabal-version:       >=1.10++name:                semialign-extras+version:             0.1.0.0+synopsis:            Extra functions for working with Semialigns+description:+    The 'Semialign' typeclass lets us line up two structures of the+    same type. By combining this with the classes from the+    "witherable" package, we can derive a number of useful+    diff \/ patch \/ merge-style operations.+bug-reports:         https://github.com/qfpl/semialign-extras+license:             BSD3+license-file:        LICENSE+author:              Jack Kelly+maintainer:          jack.kelly@data61.csiro.au+copyright:           Copyright (c) 2019, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.+category:            Data+build-type:          Simple+extra-source-files:  CHANGELOG.md README.md+tested-with:         GHC == 8.0.2+                      || == 8.2.2+                      || == 8.4.4+                      || == 8.6.5+                      || == 8.8.1++source-repository head+  type: git+  location: https://github.com/qfpl/semialign-extras++library+  hs-source-dirs:      src+  exposed-modules:     Data.Semialign.Diff+                     , Data.Semialign.Merge+  ghc-options:         -Wall+  build-depends:       base >= 4.8 && < 4.14+                     , lens >= 2.5 && < 4.19+                     , semialign >= 1 && < 1.1+                     , semialign-indexed >= 1 && < 1.2+                     , these >= 1 && < 1.1+                     , witherable >= 0.2 && < 0.4+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite doctests+  type:                exitcode-stdio-1.0+  main-is:             Main.hs+  ghc-options:         -Wall -threaded+  build-depends:       base >= 4.8 && < 4.14+                     , QuickCheck >= 2.12.6.1 && < 2.14+                     , doctest >= 0.16.0.1 && < 0.17+  hs-source-dirs:      doctests+  default-language:    Haskell2010
+ src/Data/Semialign/Diff.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs            #-}+{-# LANGUAGE LambdaCase       #-}+{-# LANGUAGE PatternSynonyms  #-}+{-# LANGUAGE RankNTypes       #-}++{-|++Module      : Data.Semialign.Diff+Copyright   : (c) 2019, Commonwealth Scientific and Industrial Research Organisation+License     : BSD3+Maintainer  : jack.kelly@data61.csiro.au+Stability   : experimental+Portability : Portable++The 'Semialign' typeclass lets us line up two structures of the same+type. It's then possible to take a simple diff by comparing the points+of overlap.++=== A note on type variables++The return type of the diffing functions is very general, because we+might want to (say) diff two @[a]@ into an @'Data.IntMap.IntMap' a@,+@'Data.Map.Map' Int a@ or some other structure. This generality can+hurt type inference.++The type signatures for all functions have the patch type as their+first type variable. For 'diff' \/ 'diffNoEq' \/ 'diffWith', this allows+setting the return type with a single type application.++-}++module Data.Semialign.Diff+  ( -- * Diffing+    diff+  , diffNoEq+  , diffWith+    -- * Patching+  , patch+  , patchWith+  ) where++import Control.Lens+  ( AsEmpty(..)+  , At(..)+  , pattern Empty+  , FoldableWithIndex(..)+  , Index+  , IxValue+  , set+  )+import Control.Lens.Operators+import Data.Semialign (Semialign(..))+import Data.These (These(..))++-- $setup+-- >>> :set -XTypeApplications+-- >>> import Data.Map (Map, (!), fromList)++-- | Diff two structures.+--+-- >>> :{+--   let+--     old = fromList [("Alice", 1), ("Bob", 2)]+--     new = fromList [("Alice", 3), ("Carol", 4)]+--   in+--     diff old new :: Map String (Maybe Int)+-- :}+-- fromList [("Alice",Just 3),("Bob",Nothing),("Carol",Just 4)]+--+-- @since 0.1.0.0+diff+  :: forall p f i a .+     ( FoldableWithIndex i f+     , Semialign f+     , Eq a+     , AsEmpty p+     , At p+     , Index p ~ i+     , IxValue p ~ (Maybe a)+     )+  => f a+  -> f a+  -> p+diff = diffWith $ \case+  This _ -> Just Nothing+  That new -> Just $ Just new+  These old new+    | old == new -> Nothing+    | otherwise -> Just $ Just new++-- | Diff two structures without requiring an 'Eq' instance. Instead,+-- always assume a new value wherever the structures align:+--+-- >>> :{+--   let+--     old = fromList [("Alice", (+ 1))]+--     new = fromList [("Alice", (* 2))]+--   in+--     ($ 3) <$> diffNoEq old new ! "Alice"+-- :}+-- Just 6+--+-- @since 0.1.0.0+diffNoEq+  :: forall p f i a .+     ( FoldableWithIndex i f+     , Semialign f+     , AsEmpty p+     , At p+     , Index p ~ i+     , IxValue p ~ Maybe a+     )+  => f a+  -> f a+  -> p+diffNoEq = diffWith $ Just . \case+  This _ -> Nothing+  That new -> Just new+  These _ new -> Just new++-- | Diff two structures with a custom function.+--+-- This function should return 'Nothing' if there is no meaningful+-- change and @'Just' new@ to indicate a changed value.+--+-- Often, @c@ is itself a @'Maybe'@, to indicate deletion/replacement+-- of a value.+--+-- @since 0.1.0.0+diffWith+  :: forall p f i a b c .+     ( FoldableWithIndex i f+     , Semialign f+     , AsEmpty p+     , At p+     , Index p ~ i+     , IxValue p ~ c+     )+  => (These a b -> Maybe c)+  -> f a+  -> f b+  -> p+diffWith f = (ifoldr step Empty .) . align+  where+    step k = set (at k) . f++-- | Apply a patch to a structure.+--+-- >>> patch (fromList [(0, Just 0), (1, Just 3), (2, Nothing)]) (fromList [(0, 1), (2, 3)])+-- fromList [(0,0),(1,3)]+--+-- When the types are compatible, 'patch' undoes 'diff' / 'diffNoEq':+--+-- prop> \old new -> let p = diff @(Map Int (Maybe Int)) old (new :: Map Int Int) in (patch p old) == new+-- prop> \old new -> let p = diffNoEq @(Map Int (Maybe Int)) old (new :: Map Int Int) in (patch p old) == new+--+-- @since 0.1.0.0+patch+  :: forall p m i a .+     ( FoldableWithIndex i p+     , At m+     , Index m ~ i+     , IxValue m ~ a+     )+  => p (Maybe a)+  -> m+  -> m+patch = patchWith $ const id++-- | Apply changes to a structure with a custom function, folding over+-- the patch.+--+-- The provided function receives two arguments: the old value if+-- present and the new value from the patch. It should return @'Just'+-- new@ to store @new@ into the result, or 'Nothing' to delete it.+--+-- @since 0.1.0.0+patchWith+  :: forall p m i a b .+     ( FoldableWithIndex i p+     , At m+     , Index m ~ i+     , IxValue m ~ a+     )+  => (Maybe a -> b -> Maybe a)+  -> p b+  -> m+  -> m+patchWith f p m = ifoldr step m p+  where+    step k v = at k %~ flip f v
+ src/Data/Semialign/Merge.hs view
@@ -0,0 +1,145 @@+{-|++Module      : Data.Semialign.Merge+Copyright   : (c) 2019, Commonwealth Scientific and Industrial Research Organisation+License     : BSD3+Maintainer  : jack.kelly@data61.csiro.au+Stability   : experimental+Portability : Portable++The 'Semialign' typeclass lets us line up two structures of the same+type. We can use this to merge two structures, or add additional+typeclasses to do filtering, 'Applicative' effects, or tracking+indices.++'merge' is the simplest function. It takes five arguments: functions+to handle values present in the left \/ right \/ both structures and+two structures to merge.++@+merge :: Semialign t+  => (a -> c) -> (b -> c) -> (a -> b -> c)+  -> t a -> t b+  -> t c+@++Every other function in this module is a variant with modified+functionality based on its name:++* Prefix @i@ means an "indexed" variant: each function argument takes+  an additional index (@i@) parameter.++* Suffix @Maybe@ means "filter results": each function argument+  returns @Maybe c@, and @Nothing@s are filtered out.++* Suffix @A@ means "applicative": each function argument returns+  actions in some 'Applicative' @f@, and the whole operation collects+  these actions to produce the a merged structure in @f@.++-}++module Data.Semialign.Merge+  ( merge+  , mergeMaybe+  , mergeA+  , mergeMaybeA++  -- * Indexed Variants+  , imerge+  , imergeMaybe+  , imergeA+  , imergeMaybeA+  ) where++import Data.Semialign (Semialign(..))+import Data.Semialign.Indexed (SemialignWithIndex(..))+import Data.These (these)+import Data.Witherable (Filterable(..), Witherable(..))++-- | @since 0.1.0.0+merge+  :: Semialign t+  => (a -> c)+  -> (b -> c)+  -> (a -> b -> c)+  -> t a+  -> t b+  -> t c+merge f g h = alignWith (these f g h)++-- | @since 0.1.0.0+mergeMaybe+  :: (Filterable t, Semialign t)+  => (a -> Maybe c)+  -> (b -> Maybe c)+  -> (a -> b -> Maybe c)+  -> t a+  -> t b+  -> t c+mergeMaybe f g h = (catMaybes .) . alignWith (these f g h)++-- | @since 0.1.0.0+mergeA+  :: (Applicative f, Semialign t, Traversable t)+  => (a -> f c)+  -> (b -> f c)+  -> (a -> b -> f c)+  -> t a+  -> t b+  -> f (t c)+mergeA f g h = (sequenceA .) . alignWith (these f g h)++-- | @since 0.1.0.0+mergeMaybeA+  :: (Applicative f, Semialign t, Witherable t)+  => (a -> f (Maybe c))+  -> (b -> f (Maybe c))+  -> (a -> b -> f (Maybe c))+  -> t a+  -> t b+  -> f (t c)+mergeMaybeA f g h = (wither id .) . alignWith (these f g h)++-- | @since 0.1.0.0+imerge+  :: (SemialignWithIndex i t)+  => (i -> a -> c)+  -> (i -> b -> c)+  -> (i -> a -> b -> c)+  -> t a+  -> t b+  -> t c+imerge f g h = ialignWith (these <$> f <*> g <*> h)++-- | @since 0.1.0.0+imergeMaybe+  :: (Filterable t, SemialignWithIndex i t)+  => (i -> a -> Maybe c)+  -> (i -> b -> Maybe c)+  -> (i -> a -> b -> Maybe c)+  -> t a+  -> t b+  -> t c+imergeMaybe f g h = (catMaybes .) . ialignWith (these <$> f <*> g <*> h)++-- | @since 0.1.0.0+imergeA+  :: (Applicative f, SemialignWithIndex i t, Traversable t)+  => (i -> a -> f c)+  -> (i -> b -> f c)+  -> (i -> a -> b -> f c)+  -> t a+  -> t b+  -> f (t c)+imergeA f g h = (sequenceA .) . ialignWith (these <$> f <*> g <*> h)++-- | @since 0.1.0.0+imergeMaybeA+  :: (Applicative f, SemialignWithIndex i t, Witherable t)+  => (i -> a -> f (Maybe c))+  -> (i -> b -> f (Maybe c))+  -> (i -> a -> b -> f (Maybe c))+  -> t a+  -> t b+  -> f (t c)+imergeMaybeA f g h = (wither id .) . ialignWith (these <$> f <*> g <*> h)