diff --git a/Data/Patch.hs b/Data/Patch.hs new file mode 100644 --- /dev/null +++ b/Data/Patch.hs @@ -0,0 +1,189 @@ +-- | Patch combinators: A library for patching functions and data structures +-- +-- A patch can be, for example +-- +-- * a type constraint (an identity function with a specific type) +-- +-- * a surjective function extending the domain of a function (e.g. turning a +-- function on natural numbers into a function defined for any integer) +-- +-- A typical use-case is to constrain the types of a QuickCheck property. Let's +-- say we have a property to check associativity of addition: +-- +-- > prop_addAssoc :: (Num a, Ord a) => a -> a -> a -> Bool +-- > prop_addAssoc a b c = (a + b) + c == a + (b + c) +-- +-- In order to check that this property holds for 'Int8', we just say: +-- +-- > *Data.Patch> quickCheck (prop_addAssoc -:: tI8 >-> id) +-- +-- Note that we only had to give a /partial/ type annotation since all arguments +-- are required to have the same type. +-- +-- Sometimes properties are only defined for a sub-set of the possible +-- arguments. Consider the following property of 'enumFromTo': +-- +-- > prop_enum m n = enumFromTo 0 m !! n == n +-- +-- This property is only valid when @m@ and @n@ are natural numbers and @n<=m@. +-- Instead of rewriting the property to account for arbitrary integers, we can +-- simply apply a patch: +-- +-- > quickCheck (prop_enum -:: name (\m -> abs >-> (min (abs m) . abs) >-> id)) +-- +-- Here 'name' allows us to bind the first argument generated by QuickCheck. +-- The patch uses 'abs' to make sure that the values passed to the property are +-- natural numbers, and @`min` (`abs` m)@ to ensure that the second argument +-- does not exceed the first. +-- +-- The library has some similarities with Semantic editor combinators: +-- +-- +-- +-- The main difference is that semantic editors are about locating and changing +-- a small part of a data structure, while patches are about changing all parts +-- of the structure. (For partial updates, use the 'id' patch to leave +-- sub-structures untouched.) + + + +module Data.Patch where + + + +import Control.Arrow ((***)) -- For Haddock +import Data.Complex +import Data.Int +import Data.Word + + + +-------------------------------------------------------------------------------- +-- * Patch combinators +-------------------------------------------------------------------------------- + +type Patch a b = a -> b + +-- | Patch application +(-::) :: a -> Patch a b -> b +(-::) = flip id + +infixl 1 -:: + +-- | Function patch +-- +-- The first patch is applied to the argument and the second patch to the +-- result. +(>->) :: Patch c a -> Patch b d -> Patch (a -> b) (c -> d) +p1 >-> p2 = \f -> p2 . f . p1 + +infixr 2 >-> + +-- | A patch that depends on the first argument of the resuting function +name :: (c -> Patch (a -> b) (c -> d)) -> Patch (a -> b) (c -> d) +name p f a = p a f a + +-- | Pair patch (a specialized version of 'Control.Arrow.***') +tup2 + :: Patch a1 b1 + -> Patch a2 b2 + -> Patch (a1,a2) (b1,b2) +tup2 pa pb (a,b) = (pa a, pb b) + +-- | Analogous to 'tup2' +tup3 + :: Patch a1 b1 + -> Patch a2 b2 + -> Patch a3 b3 + -> Patch (a1,a2,a3) (b1,b2,b3) +tup3 pa pb pc (a,b,c) = (pa a, pb b, pc c) + +-- | Analogous to 'tup2' +tup4 + :: Patch a1 b1 + -> Patch a2 b2 + -> Patch a3 b3 + -> Patch a4 b4 + -> Patch (a1,a2,a3,a4) (b1,b2,b3,b4) +tup4 pa pb pc pd (a,b,c,d) = (pa a, pb b, pc c, pd d) + +-- | Analogous to 'tup2' +tup5 + :: Patch a1 b1 + -> Patch a2 b2 + -> Patch a3 b3 + -> Patch a4 b4 + -> Patch a5 b5 + -> Patch (a1,a2,a3,a4,a5) (b1,b2,b3,b4,b5) +tup5 pa pb pc pd pe (a,b,c,d,e) = (pa a, pb b, pc c, pd d, pe e) + +-- | Analogous to 'tup2' +tup6 + :: Patch a1 b1 + -> Patch a2 b2 + -> Patch a3 b3 + -> Patch a4 b4 + -> Patch a5 b5 + -> Patch a6 b6 + -> Patch (a1,a2,a3,a4,a5,a6) (b1,b2,b3,b4,b5,b6) +tup6 pa pb pc pd pe pp (a,b,c,d,e,p) = (pa a, pb b, pc c, pd d, pe e, pp p) + +-- | Analogous to 'tup2' +tup7 + :: Patch a1 b1 + -> Patch a2 b2 + -> Patch a3 b3 + -> Patch a4 b4 + -> Patch a5 b5 + -> Patch a6 b6 + -> Patch a7 b7 + -> Patch (a1,a2,a3,a4,a5,a6,a7) (b1,b2,b3,b4,b5,b6,b7) +tup7 pa pb pc pd pe pp pg (a,b,c,d,e,p,g) = + (pa a, pb b, pc c, pd d, pe e, pp p, pg g) + + + +-------------------------------------------------------------------------------- +-- * Type constraints +-------------------------------------------------------------------------------- + +tBool :: Patch Bool Bool +tBool = id + +tWord :: Patch Word Word +tWord = id + +tInt :: Patch Int Int +tInt = id + +tW8 :: Patch Word8 Word8 +tW8 = id + +tI8 :: Patch Int8 Int8 +tI8 = id + +tW16 :: Patch Word16 Word16 +tW16 = id + +tI16 :: Patch Int16 Int16 +tI16 = id + +tW32 :: Patch Word32 Word32 +tW32 = id + +tI32 :: Patch Int32 Int32 +tI32 = id + +tInteger :: Patch Integer Integer +tInteger = id + +tFloat :: Patch Float Float +tFloat = id + +tComplex :: Patch a a -> Patch (Complex a) (Complex a) +tComplex _ = id + +-- | Type constructor +tCon :: Patch a a -> Patch (c a) (c a) +tCon _ = id + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Koen Claessen, Emil Axelsson + +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 Koen Claessen, Emil Axelsson 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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/patch-combinators.cabal b/patch-combinators.cabal new file mode 100644 --- /dev/null +++ b/patch-combinators.cabal @@ -0,0 +1,26 @@ +Name: patch-combinators +Version: 0.1 +Synopsis: A library for patching functions and data structures +Description: A library for patching functions and data structures +-- Homepage: +License: BSD3 +License-file: LICENSE +Author: Koen Claessen, Emil Axelsson +Maintainer: Emil Axelsson +Copyright: Copyright (c) 2012, Emil Axelsson +Category: Data +Stability: experimental +Build-type: Simple +Cabal-version: >=1.6 + +Source-repository head + type: darcs + location: http://community.haskell.org/~emax/darcs/patch-combinators + +Library + Exposed-modules: + Data.Patch + + Build-depends: + base >= 4 && < 5 +