merge 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+114/−19 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• merge.cabal +1/−1
• src/Data/Merge.hs +103/−12
• test/Test.hs +10/−6

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               merge-version:            0.1.0.0+version:            0.2.0.0 synopsis:           A functor for consistent merging of information description:        A functor for consistent merging of information. author:             Samuel Schlesinger

@@ -1,3 +1,10 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-} {- | Name: Data.Merge Description: To describe merging of data types.@@ -5,11 +12,42 @@ Copyright: Samuel Schlesinger 2021 (c) -} {-# LANGUAGE BlockArguments #-}-module Data.Merge where+module Data.Merge+  ( Merge (Merge, runMerge)+  , merge+    -- * Construction+  , optional+  , required+  , combine+  , combineWith+  , combineGen+  , combineGenWith+  , Alternative(..)+  , Applicative(..)+    -- * Modification+  , flattenMaybe+  , Profunctor(..)+    -- * Useful Semigroups+  , Optional(..)+  , Required(..)+  , requiredToOptional+  , optionalToRequired+  , Last (..)+  , First (..)+  , Product (..)+  , Sum (..)+  , Dual (..)+  , Max (..)+  , Min (..)+  ) where +import GHC.Generics (Generic)+import Data.Typeable (Typeable) import Control.Monad (join)+import Data.Coerce (Coercible, coerce) import Control.Applicative (Alternative (..)) import Data.Profunctor (Profunctor (..))+import Data.Semigroup (Last (..), First (..), Product (..), Sum (..), Dual (..), Max (..), Min (..))  -- | Describes the merging of two values of the same type -- into some other type. Represented as a 'Maybe' valued@@ -21,6 +59,10 @@ -- > mergeExamples = Example <$> required a <*> optional b newtype Merge x a = Merge { runMerge :: x -> x -> Maybe a } +-- | Flattens a 'Maybe' layer inside of a 'Merge'+flattenMaybe :: Merge x (Maybe a) -> Merge x a+flattenMaybe (Merge f) = Merge \x x' -> join (f x x')+ -- | The most general combinator for constructing 'Merge's. merge :: (x -> x -> Maybe a) -> Merge x a merge = Merge@@ -50,17 +92,66 @@  -- | Meant to be used to merge optional fields in a record. optional :: Eq a => (x -> Maybe a) -> Merge x (Maybe a)-optional f = Merge (\x x' -> go (f x) (f x'))  where-  go (Just x) (Just x')-    | x == x' = Just (Just x)-    | otherwise = Nothing-  go Nothing (Just x) = Just (Just x)-  go (Just x) Nothing = Just (Just x)-  go Nothing Nothing = Just Nothing+optional = combineGen (maybe (Optional (Just Nothing)) (Optional . Just . Just)) unOptional  -- | Meant to be used to merge required fields in a record. required :: Eq a => (x -> a) -> Merge x a-required f = Merge (\x x' -> go (f x) (f x'))  where-  go x x'-    | x == x' = Just x-    | otherwise = Nothing+required = combineGen (Required . Just) unRequired++-- | Associatively combine original fields of the record.+combine :: Semigroup a => (x -> a) -> Merge x a+combine = combineWith (<>)++-- | Combine original fields of the record with the given function.+combineWith :: (a -> a -> a) -> (x -> a) -> Merge x a+combineWith c f = Merge (\x x' -> go (f x) (f x')) where+  go x x' = Just (x `c` x')++-- | Sometimes, one can describe a merge strategy via a binary operator. 'Optional'+-- and 'Required' describe 'optional' and 'required', respectively, in this way.+combineGenWith :: forall s a x. (s -> s -> s) -> (a -> s) -> (s -> Maybe a) -> (x -> a) -> Merge x a+combineGenWith c g l f = flattenMaybe $ fmap l $ combineWith c (g . f)++-- | 'combineGen' specialized to 'Semigroup' operations.+combineGen :: Semigroup s => (a -> s) -> (s -> Maybe a) -> (x -> a) -> Merge x a+combineGen = combineGenWith (<>)++-- | This type's 'Semigroup' instance encodes the simple,+-- discrete lattice generated by any given set, excluding the+-- bottom.+newtype Required a = Required { unRequired :: Maybe a }+  deriving (Eq, Show, Read, Ord, Generic, Typeable)++-- | We can convert any 'Required' to an 'Optional'+-- without losing any information.+requiredToOptional :: Required a -> Optional a+requiredToOptional (Required ma) = Optional (fmap Just ma)++instance Eq a => Semigroup (Required a) where+  Required (Just a) <> Required (Just a')+    | a == a' = Required (Just a)+    | otherwise = Required Nothing+  Required _ <> Required _ = Required Nothing++-- | This type's 'Semigroup' instance encodes the simple,+-- deiscrete lattice generated by any given set.+newtype Optional a = Optional { unOptional :: Maybe (Maybe a) }+  deriving (Eq, Show, Read, Ord, Generic, Typeable)++-- | We can convert any 'Optional' to a 'Required',+-- entering the 'Required's inconsistent state if+-- the value is absent from the optional.+optionalToRequired :: Optional a -> Required a+optionalToRequired = Required . join . unOptional++instance Eq a => Semigroup (Optional a) where+  Optional (Just (Just a)) <> Optional (Just (Just a'))+    | a == a' = Optional (Just (Just a))+    | otherwise = Optional Nothing+  Optional (Just Nothing) <> x = x+  x <> Optional (Just Nothing) = x+  Optional Nothing <> x = Optional Nothing+  x <> Optional Nothing = Optional Nothing++instance Eq a => Monoid (Optional a) where+  mempty = Optional (Just Nothing)

@@ -12,11 +12,15 @@  main :: IO () main = do-  let merge = (,) <$> optional fst <*> required snd+  let merge = (,,) <$> optional (\(x,_,_) -> x) <*> required (\(_,x,_) -> x) <*> combine (\(_,_,x) -> x)+  let merge' = combine Max+  let merge'' = combine Last   requires "merge"-    [ runMerge merge (Just 10, 1) (Nothing, 1) == Just (Just 10, 1) -    , runMerge merge (Nothing, 1) (Nothing, 1) == Just (Nothing, 1)-    , runMerge merge (Nothing, 1) (Nothing, 2) == Nothing-    , runMerge merge (Just 10, 1) (Just 11, 1) == Nothing-    , runMerge merge (Just 10, 1) (Just 11, 2) == Nothing+    [ runMerge merge (Just 10, 1, []) (Nothing, 1, [1]) == Just (Just 10, 1, [1]) +    , runMerge merge (Nothing, 1, [2]) (Nothing, 1, [3]) == Just (Nothing, 1, [2, 3])+    , runMerge merge (Nothing, 1, [1, 2]) (Nothing, 2, [3, 4]) == Nothing+    , runMerge merge (Just 10, 1, [7]) (Just 11, 1, []) == Nothing+    , runMerge merge (Just 10, 1, []) (Just 11, 2, []) == Nothing+    , runMerge merge' 5 10 == Just (Max 10)+    , runMerge merge'' True False == Just (Last False)     ]