patience 0.2.0.0 → 0.2.1.0
raw patch · 5 files changed
+313/−22 lines, 5 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +4/−0
- LICENSE +1/−0
- patience.cabal +9/−1
- src/Patience.hs +15/−21
- src/Patience/Map.hs +284/−0
CHANGELOG.md view
@@ -1,3 +1,7 @@+# Changes in version TBA+ * Deprecate `Patience.itemChar`.+ * Add module `Patience.Map`.+ # Changes in version 0.2.0.0 * Move `Data.Algorithm.Patience` to `Patience` * Remove use of deprecated `Data.Map.insertWith'`
LICENSE view
@@ -1,4 +1,5 @@ Copyright (c) Keegan McAllister 2011+Copyright (c) chessai 2018 All rights reserved.
patience.cabal view
@@ -2,7 +2,7 @@ name: patience version:- 0.2.0.0+ 0.2.1.0 license: BSD-3-Clause license-file:@@ -22,8 +22,11 @@ Algorithms, Text author: Keegan McAllister <mcallister.keegan@gmail.com>+ chessai <chessai1996@gmail.com> maintainer: chessai <chessai1996@gmail.com> +homepage:+ https://github.com/chessai/patience build-type: Simple extra-source-files:@@ -35,6 +38,7 @@ src exposed-modules: Patience+ Patience.Map ghc-options: -Wall default-language:@@ -42,3 +46,7 @@ build-depends: base >= 4.3 && < 5 , containers >= 0.5.9 && < 0.7++source-repository head+ type: git+ location: https://github.com/chessai/patience.git
src/Patience.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ViewPatterns #-} -- | Implements \"patience diff\" and the patience algorithm for the longest@@ -67,13 +68,13 @@ walk (Card x a c) = (x,a) : maybe [] walk c -- Elements whose second component appears exactly once.-unique :: (Ord t) => S.Seq (a,t) -> M.Map t a+unique :: (Ord k) => S.Seq (a,k) -> M.Map k a unique = M.mapMaybe id . F.foldr ins M.empty where ins (a,x) = MS.insertWith (\_ _ -> Nothing) x (Just a) -- Given two sequences of numbered "lines", returns a list of points -- where unique lines match up.-solveLCS :: (Ord t) => S.Seq (Int,t) -> S.Seq (Int,t) -> [(Int,Int)]+solveLCS :: (Ord a) => S.Seq (Int,a) -> S.Seq (Int,a) -> [(Int,Int)] solveLCS ma mb = let xs = M.elems $ M.intersectionWith (,) (unique ma) (unique mb) in longestIncreasing $ sortBy (comparing snd) xs@@ -86,7 +87,7 @@ deriving (Show) -- Subdivides a diff problem according to the indices of matching lines.-chop :: S.Seq t -> S.Seq t -> [(Int,Int)] -> [Piece t]+chop :: S.Seq a -> S.Seq a -> [(Int,Int)] -> [Piece a] chop xs ys [] | S.null xs && S.null ys = [] | otherwise = [Diff xs ys]@@ -97,32 +98,23 @@ -- Zip a list with a Seq. zipLS :: [a] -> S.Seq b -> S.Seq (a, b)-#if MIN_VERSION_containers(0,3,0) zipLS = S.zip . S.fromList-#else-zipLS xs = S.fromList . zip xs . F.toList-#endif -- Number the elements of a Seq.-number :: S.Seq t -> S.Seq (Int,t)+number :: S.Seq a -> S.Seq (Int,a) number xs = zipLS [0..S.length xs - 1] xs -- | An element of a computed difference.-data Item t- = Old t -- ^ Value taken from the \"old\" list, i.e. left argument to 'diff'- | New t -- ^ Value taken from the \"new\" list, i.e. right argument to 'diff'- | Both t t -- ^ Value taken from both lists. Both values are provided, in case+data Item a+ = Old a -- ^ Value taken from the \"old\" list, i.e. left argument to 'diff'+ | New a -- ^ Value taken from the \"new\" list, i.e. right argument to 'diff'+ | Both a a -- ^ Value taken from both lists. Both values are provided, in case -- your type has a non-structural definition of equality.- deriving (Eq, Ord, Show, Read, Typeable, Data)--instance Functor Item where- fmap f (Old x ) = Old (f x)- fmap f (New x ) = New (f x)- fmap f (Both x y) = Both (f x) (f y)+ deriving (Eq, Ord, Show, Read, Typeable, Data, Functor) -- | The difference between two lists, according to the -- \"patience diff\" algorithm.-diff :: (Ord t) => [t] -> [t] -> [Item t]+diff :: (Ord a) => [a] -> [a] -> [Item a] diff xsl ysl = F.toList $ go (S.fromList xsl) (S.fromList ysl) where -- Handle common elements at the beginning / end. go (S.viewl -> (x :< xs)) (S.viewl -> (y :< ys))@@ -143,13 +135,15 @@ recur (Diff xs ys : ps) = recur ps >< go xs ys -- | The character @\'-\'@ or @\'+\'@ or @\' \'@ for 'Old' or 'New' or 'Both' respectively.-itemChar :: Item t -> Char+{-# DEPRECATED itemChar "Don't use this. It will be removed in a later version." #-}+itemChar :: Item a -> Char itemChar (Old _ ) = '-' itemChar (New _ ) = '+' itemChar (Both _ _) = ' ' -- | The value from an 'Item'. For 'Both', returns the \"old\" value.-itemValue :: Item t -> t+{-# DEPRECATED itemValue "Don't use this. It will be removed in a later version." #-}+itemValue :: Item a -> a itemValue (Old x ) = x itemValue (New x ) = x itemValue (Both x _) = x
+ src/Patience/Map.hs view
@@ -0,0 +1,284 @@+{-# language BangPatterns #-}+{-# language DeriveGeneric #-}+{-# language DeriveFoldable #-}+{-# language DeriveFunctor #-}+{-# language DeriveTraversable #-}+{-# language NoImplicitPrelude #-}+{-# language ScopedTypeVariables #-}++-- | This module provides a lossless way to do+-- diffing between two 'Map's, and ways to+-- manipulate the diffs.+module Patience.Map+ ( -- * Types + Delta(..)+ , M(..)++ -- * Diffing + , diff++ -- * Case analysis on 'Delta'+ , getSame+ , getOld+ , getNew+ , getDelta+ , getOriginal+ , getOriginals++ , isSame+ , isOld+ , isNew+ , isDelta++ -- * Construction of special maps from a diff+ , toSame + , toOld+ , toNew+ , toDelta+ , toOriginal+ , toOriginals ++ -- * Mapping+ , mapSame+ , mapOld+ , mapNew++ , mapSame'+ , mapOld'+ , mapNew'+ ) where++import Data.Bool (Bool(True, False))+import Data.Eq (Eq((==)))+import Data.Foldable (Foldable)+import Data.Function ((.))+import Data.Functor (Functor(fmap))+import Data.Maybe (Maybe(Just,Nothing))+import Data.Ord (Ord)+import Data.Traversable (Traversable)+import GHC.Generics (Generic, Generic1)+import GHC.Show (Show)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as DMS+import qualified Data.Map.Merge.Strict as Merge++-- | The result of a diff of an entry within two 'Map's.+--+-- In two 'Map's m1 and m2, when performing a diff, this type encodes the following situations:+--+-- Same key, different values: Stores the two values in the Delta constructor.+--+-- Same key, same values: Stores the value in the Same constructor.+--+-- Key exists in m1 but not m2: Stores the value in the Old constructor.+--+-- Key exists in m2 but not m1: Stores the value in the New constructor.+--+-- This behaviour ensures that we don't lose any information, meaning+-- we can reconstruct either of the original 'Map' 'k' 'a' from a 'Map' 'k' ('Delta' 'a').+-- (Note that this slightly differs from `Patience.diff`, which does not+-- care about the possibility of reconstruction).+data Delta a+ = Delta !a !a+ | Same !a+ | Old !a+ | New !a+ deriving (Eq, Foldable, Functor, Generic, Generic1, Ord, Show, Traversable)++-- | M1 = First 'Map', M2 = Second 'Map'.+-- Used as an argument for functions that care about which 'Map' to reconstruct.+data M = M1 | M2++-- | Takes two 'Map's and returns a 'Map' from the same key type to 'Delta' 'a',+-- where 'Delta' 'a' encodes differences between entries.+diff :: (Eq a, Ord k)+ => Map k a -- ^ first, /old/ 'Map'+ -> Map k a -- ^ second, /new/ 'Map'+ -> Map k (Delta a) -- ^ 'Map' encoding the diff+diff !m1 !m2 =+ Merge.merge+ (Merge.mapMissing (\_ x -> Old x)) -- preserve keys found in m1 but not m2+ (Merge.mapMissing (\_ x -> New x)) -- preserve keys found in m2 but not m1+ (Merge.zipWithMatched (\_ v1 v2 -> if v1 == v2 then Same v1 else Delta v1 v2))+ m1+ m2+{-# INLINABLE diff #-}++-- | Is the 'Delta' an encoding of same values?+isSame :: Eq a => Delta a -> Bool+isSame (Same _) = True+isSame (Delta x y) =+ if x == y+ then True+ else False+isSame _ = False+{-# INLINABLE isSame #-}++-- | Is the 'Delta' an encoding of old values?+isOld :: Delta a -> Bool+isOld (Old _) = True+isOld (Delta _ _) = True+isOld _ = False+{-# INLINE isOld #-}++-- | Is the 'Delta' an encoding of new values?+isNew :: Delta a -> Bool+isNew (New _) = True+isNew (Delta _ _) = True+isNew _ = False+{-# INLINE isNew #-}++-- | Is the 'Delta' an encoding of changed values?+isDelta :: Delta a -> Bool+isDelta (Delta _ _) = True+isDelta _ = False+{-# INLINE isDelta #-}++-- | Potentially get the 'Same' value out of a 'Delta'.+getSame :: Eq a => Delta a -> Maybe a+getSame (Same a) = Just a+getSame (Delta x y) =+ if x == y+ then Just x+ else Nothing+getSame _ = Nothing+{-# INLINABLE getSame #-}++-- | Potentially get the 'Old' value out of a 'Delta'.+getOld :: Delta a -> Maybe a+getOld (Delta a _) = Just a+getOld (Old a) = Just a+getOld _ = Nothing+{-# INLINE getOld #-}++-- | Potentially get the 'New' value out of a 'Delta'.+getNew :: Delta a -> Maybe a+getNew (Delta _ a) = Just a+getNew (New a) = Just a+getNew _ = Nothing+{-# INLINE getNew #-}++-- | Potentially get the 'Changed' value out of a 'Delta'.+getDelta :: Delta a -> Maybe (a,a)+getDelta (Delta d1 d2) = Just (d1,d2)+getDelta _ = Nothing+{-# INLINE getDelta #-} ++-- | Potentially get the original value out of the 'Delta'.+getOriginal :: M -> Delta a -> Maybe a+getOriginal M1 (Delta x _) = Just x+getOriginal M2 (Delta _ y) = Just y+getOriginal _ (Same x ) = Just x+getOriginal M1 (Old x ) = Just x+getOriginal _ (Old _ ) = Nothing+getOriginal M2 (New x ) = Just x+getOriginal _ (New _ ) = Nothing+{-# INLINE getOriginal #-}++-- | Get the original values out of the 'Delta'.+getOriginals :: Delta a -> (Maybe a, Maybe a)+getOriginals (Delta x y) = (Just x, Just y)+getOriginals (Same x ) = (Just x, Just x)+getOriginals (Old x ) = (Just x, Nothing)+getOriginals (New x ) = (Nothing, Just x)+{-# INLINE getOriginals #-}++-- | Retrieve the 'Same' values out of the diff map.+toSame :: Eq a => Map k (Delta a)+ -> Map k a+toSame = DMS.mapMaybe getSame+{-# INLINABLE toSame #-}++-- | Retrieve only the 'Old' values out of the diff map.+toOld :: Map k (Delta a)+ -> Map k a+toOld = DMS.mapMaybe getOld+{-# INLINE toOld #-}++-- | Retrieve only the 'New' values out of the diff map.+toNew :: Map k (Delta a)+ -> Map k a+toNew = DMS.mapMaybe getNew+{-# INLINE toNew #-}++-- | Retrieve only the 'DeltaUnit' values out of the diff map.+toDelta :: Map k (Delta a)+ -> Map k (a,a)+toDelta = DMS.mapMaybe getDelta+{-# INLINE toDelta #-}++-- | Construct either the old 'Map' or new 'Map' from a diff+toOriginal :: M+ -> Map k (Delta a)+ -> Map k a+toOriginal m = DMS.mapMaybe (getOriginal m)+{-# INLINE toOriginal #-}++-- | Reconstruct both original 'Map's.+toOriginals :: Map k (Delta a)+ -> (Map k a, Map k a)+toOriginals m = (DMS.mapMaybe (getOriginal M1) m, DMS.mapMaybe (getOriginal M2) m)++-- | Map over all 'Same' values, returning a map of just+-- the transformed values.+-- This can be more efficient than calling 'toSame' and+-- then Data.Map's 'DMS.map'.+mapSame :: Eq a+ => (a -> b)+ -> Map k (Delta a)+ -> Map k b+mapSame f = DMS.mapMaybe (fmap f . getSame)+{-# INLINABLE mapSame #-}++-- | Map over all 'Old' values, returning a map of just+-- the transformed values.+-- This can be more efficient than calling 'toOld' and+-- then Data.Map's 'DMS.map'.+mapOld :: (a -> b)+ -> Map k (Delta a)+ -> Map k b+mapOld f = DMS.mapMaybe (fmap f . getOld)+{-# INLINE mapOld #-}++-- | Map over all 'New' values, returning a map of just+-- the transformed values.+-- This can be more efficient than calling 'toNew' and+-- then Data.Map's 'DMS.map'.+mapNew :: (a -> b)+ -> Map k (Delta a)+ -> Map k b+mapNew f = DMS.mapMaybe (fmap f . getNew)+{-# INLINE mapNew #-}++-- | Map over all the 'Same' values, preserving the+-- remaining values in the map.+mapSame' :: Eq a+ => (a -> a)+ -> Map k (Delta a)+ -> Map k (Delta a)+mapSame' f = DMS.map (\x -> if isSame x then fmap f x else x)+{-# INLINABLE mapSame' #-}++-- | Map over all the 'Old' values, preserving the+-- remaining values in the map.+mapOld' :: (a -> a)+ -> Map k (Delta a)+ -> Map k (Delta a)+mapOld' f = DMS.map go+ where+ go (Old x) = Old (f x)+ go (Delta x y) = Delta (f x) y+ go x = x+{-# INLINE mapOld' #-}++-- | Map over all the 'New' values, preserving the+-- remaining values in the map.+mapNew' :: (a -> a)+ -> Map k (Delta a)+ -> Map k (Delta a)+mapNew' f = DMS.map go+ where+ go (New x) = New (f x)+ go (Delta x y) = Delta x (f y)+ go x = x+{-# INLINE mapNew' #-}