diff --git a/ChangeLog.md b/ChangeLog.md index dcfb65e..1a53ddd 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,17 @@ # Revision history for patch +## Unreleased + +* Consistently provide: + + - `Wrapped` instances + + - `*WithIndex` instances + + - `un*` newtype unwrappers + + for `PatchMap`, `PatchIntMap`, and `PatchMapWithMove`. + ## 0.0.1.0 * Support older GHCs with `split-these` flag. diff --git a/dep/reflex-platform/default.nix b/dep/reflex-platform/default.nix index 7a04778..0cf822e 100644 --- a/dep/reflex-platform/default.nix +++ b/dep/reflex-platform/default.nix @@ -1,7 +1,8 @@ # DO NOT HAND-EDIT THIS FILE -import ((import {}).fetchFromGitHub ( - let json = builtins.fromJSON (builtins.readFile ./github.json); - in { inherit (json) owner repo rev sha256; - private = json.private or false; - } -)) +let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }: + if !fetchSubmodules && !private then builtins.fetchTarball { + url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256; + } else (import {}).fetchFromGitHub { + inherit owner repo rev sha256 fetchSubmodules private; + }; +in import (fetch (builtins.fromJSON (builtins.readFile ./github.json))) diff --git a/dep/reflex-platform/github.json b/dep/reflex-platform/github.json index 1cd7cdc..a89e655 100644 --- a/dep/reflex-platform/github.json +++ b/dep/reflex-platform/github.json @@ -2,6 +2,7 @@ "owner": "reflex-frp", "repo": "reflex-platform", "branch": "master", - "rev": "510b990d0b11f0626afbec5fe8575b5b2395391b", - "sha256": "09cmahsbxr0963wq171c7j139iyzz49hramr4v9nsf684wcwkngv" + "private": false, + "rev": "c9d11db1b98855fe8ab24a3ff6a5dbe0ad902ad9", + "sha256": "0sfzkqdvyah5mwvmli0wq1nl0b8cvk2cmfgfy4rz57wv42x3099y" } diff --git a/patch.cabal b/patch.cabal index 3feafa5..3065a20 100644 --- a/patch.cabal +++ b/patch.cabal @@ -35,6 +35,7 @@ library , containers >= 0.6 && < 0.7 , dependent-map >= 0.3 && < 0.4 , dependent-sum >= 0.6 && < 0.7 + , lens >= 4.7 && < 5 , semigroupoids >= 4.0 && < 6 , transformers >= 0.5.6.0 && < 0.6 , witherable >= 0.3 && < 0.3.2 diff --git a/release.nix b/release.nix index d57f75e..addf765 100644 --- a/release.nix +++ b/release.nix @@ -18,16 +18,26 @@ let "ghcIosAarch64" ]; compilerPkgs = lib.genAttrs compilers (ghc: let - src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ - "release.nix" - ".git" - "dist" - "dist-newstyle" - "cabal.haskell-ci" - "cabal.project" - ".travis.yml" - ])) ./.; - in reflex-platform.${ghc}.callCabal2nix "patch" src {}); + reflex-platform = reflex-platform-fun { + inherit system; + haskellOverlays = [ + # Use this package's source for reflex + (self: super: { + _dep = super._dep // { + patch = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ + "release.nix" + ".git" + "dist" + "dist-newstyle" + "cabal.haskell-ci" + "cabal.project" + ".travis.yml" + ])) ./.; + }; + }) + ]; + }; + in reflex-platform.${ghc}.patch); in compilerPkgs // { cache = reflex-platform.pinBuildInputs "patch-${system}" (builtins.attrValues compilerPkgs); diff --git a/src/Data/Patch/IntMap.hs b/src/Data/Patch/IntMap.hs index 8d70fd3..ebc0815 100644 --- a/src/Data/Patch/IntMap.hs +++ b/src/Data/Patch/IntMap.hs @@ -1,12 +1,15 @@ -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} + -- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for -- insert/update or delete of associations. module Data.Patch.IntMap where +import Control.Lens import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap import Data.Maybe @@ -16,7 +19,20 @@ import Data.Patch.Class -- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping. -- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update -- and @Nothing@ means delete. -newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid) +newtype PatchIntMap a = PatchIntMap { unPatchIntMap :: IntMap (Maybe a) } + deriving ( Show, Read, Eq, Ord + , Functor, Foldable, Traversable, Monoid + ) + +-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@. +-- If the same key is modified by both patches, the one on the left will take +-- precedence. +instance Semigroup (PatchIntMap v) where + PatchIntMap a <> PatchIntMap b = PatchIntMap $ a `mappend` b --TODO: Add a semigroup instance for Map + -- PatchMap is idempotent, so stimes n is id for every n + stimes = stimesIdempotentMonoid + +makeWrapped ''PatchIntMap -- | Apply the insertions or deletions to a given 'IntMap'. instance Patch (PatchIntMap a) where @@ -26,13 +42,10 @@ instance Patch (PatchIntMap a) where adds = IntMap.mapMaybe id p in IntMap.union adds $ v `IntMap.difference` removes --- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@. --- If the same key is modified by both patches, the one on the left will take --- precedence. -instance Semigroup (PatchIntMap v) where - PatchIntMap a <> PatchIntMap b = PatchIntMap $ a `mappend` b --TODO: Add a semigroup instance for Map - -- PatchMap is idempotent, so stimes n is id for every n - stimes = stimesIdempotentMonoid +instance FunctorWithIndex Int PatchIntMap +instance FoldableWithIndex Int PatchIntMap +instance TraversableWithIndex Int PatchIntMap where + itraversed = _Wrapped . itraversed . traversed -- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@ -- (that is, all inserts/updates), producing a @PatchIntMap b@. diff --git a/src/Data/Patch/Map.hs b/src/Data/Patch/Map.hs index 8524031..51129e8 100644 --- a/src/Data/Patch/Map.hs +++ b/src/Data/Patch/Map.hs @@ -1,11 +1,18 @@ +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} + -- | 'Patch'es on 'Map' that consist only of insertions (including overwrites) -- and deletions module Data.Patch.Map where import Data.Patch.Class +import Control.Lens import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe @@ -15,7 +22,23 @@ import Data.Semigroup -- deleted. Insertions are represented as values wrapped in 'Just', while -- deletions are represented as 'Nothing's newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) } - deriving (Show, Read, Eq, Ord) + deriving ( Show, Read, Eq, Ord + , Foldable, Traversable + ) + +-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert. +-- Deletions are unaffected. +deriving instance Functor (PatchMap k) + +-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@. +-- If the same key is modified by both patches, the one on the left will take +-- precedence. +instance Ord k => Semigroup (PatchMap k v) where + PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map + -- PatchMap is idempotent, so stimes n is id for every n + stimes = stimesIdempotentMonoid + +makeWrapped ''PatchMap -- | Apply the insertions or deletions to a given 'Map'. instance Ord k => Patch (PatchMap k v) where @@ -28,24 +51,16 @@ instance Ord k => Patch (PatchMap k v) where Nothing -> Just () Just _ -> Nothing --- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@. --- If the same key is modified by both patches, the one on the left will take --- precedence. -instance Ord k => Semigroup (PatchMap k v) where - PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map - -- PatchMap is idempotent, so stimes n is id for every n - stimes = stimesIdempotentMonoid +instance FunctorWithIndex k (PatchMap k) +instance FoldableWithIndex k (PatchMap k) +instance TraversableWithIndex k (PatchMap k) where + itraverse f (PatchMap x) = PatchMap <$> itraverse (traverse . f) x -- | The empty 'PatchMap' contains no insertions or deletions instance Ord k => Monoid (PatchMap k v) where mempty = PatchMap mempty mappend = (<>) --- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert. --- Deletions are unaffected. -instance Functor (PatchMap k) where - fmap f = PatchMap . fmap (fmap f) . unPatchMap - -- | Returns all the new elements that will be added to the 'Map' patchMapNewElements :: PatchMap k v -> [v] patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p diff --git a/src/Data/Patch/MapWithMove.hs b/src/Data/Patch/MapWithMove.hs index beee42b..b05378b 100644 --- a/src/Data/Patch/MapWithMove.hs +++ b/src/Data/Patch/MapWithMove.hs @@ -1,11 +1,14 @@ -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} + -- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to -- another module Data.Patch.MapWithMove where @@ -13,6 +16,7 @@ module Data.Patch.MapWithMove where import Data.Patch.Class import Control.Arrow +import Control.Lens hiding (from, to) import Control.Monad.Trans.State import Data.Foldable import Data.Function @@ -28,7 +32,13 @@ import Data.Tuple -- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@ -- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@, -- and vice versa. There should never be any unpaired From/To keys. -newtype PatchMapWithMove k v = PatchMapWithMove (Map k (NodeInfo k v)) deriving (Show, Eq, Ord, Functor, Foldable, Traversable) +newtype PatchMapWithMove k v = PatchMapWithMove + { -- | Extract the internal representation of the 'PatchMapWithMove' + unPatchMapWithMove :: Map k (NodeInfo k v) + } + deriving ( Show, Read, Eq, Ord + , Functor, Foldable, Traversable + ) -- | Holds the information about each key: where its new value should come from, -- and where its old value should go to @@ -53,6 +63,13 @@ data From k v -- that means it will be deleted. type To = Maybe +makeWrapped ''PatchMapWithMove + +instance FunctorWithIndex k (PatchMapWithMove k) +instance FoldableWithIndex k (PatchMapWithMove k) +instance TraversableWithIndex k (PatchMapWithMove k) where + itraverse f (PatchMapWithMove x) = PatchMapWithMove <$> itraverse (traverse . f) x + -- | Create a 'PatchMapWithMove', validating it patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v) patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing @@ -70,10 +87,6 @@ patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo , _nodeInfo_to = Nothing } --- | Extract the internal representation of the 'PatchMapWithMove' -unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v) -unPatchMapWithMove (PatchMapWithMove p) = p - -- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'. insertMapKey :: k -> v -> PatchMapWithMove k v insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing