-- | 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:
--
-- <http://conal.net/blog/posts/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

tDouble :: Patch Double Double
tDouble = id

tComplex :: Patch a a -> Patch (Complex a) (Complex a)
tComplex _ = id

-- | Type constructor
--
-- Example use:
--
-- > Data.Patch> let Just a = read "Just 6" -:: tCon tFloat
-- > Data.Patch> a
-- > 6.0
tCon :: Patch a a -> Patch (c a) (c a)
tCon _ = id