1{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
2{-# OPTIONS_GHC -Wno-orphans #-}
3
4{- |
5    This module supplies a method for writing 'Uniplate' and 'Biplate' instances.
6    This moulde gives the highest performance, but requires many instance definitions. The
7    instances can be generated using Derive: <http://community.haskell.org/~ndm/derive/>.
8
9    To take an example:
10
11    > data Expr = Var Int | Pos Expr String | Neg Expr | Add Expr Expr
12    > data Stmt = Seq [Stmt] | Sel [Expr] | Let String Expr
13    >
14    > instance Uniplate Expr where
15    >     uniplate (Var x  ) = plate Var |- x
16    >     uniplate (Pos x y) = plate Pos |* x |- y
17    >     uniplate (Neg x  ) = plate Neg |* x
18    >     uniplate (Add x y) = plate Add |* x |* y
19    >
20    > instance Biplate Expr Expr where
21    >     biplate = plateSelf
22    >
23    > instance Uniplate Stmt where
24    >     uniplate (Seq x  ) = plate Seq ||* x
25    >     uniplate (Sel x  ) = plate Sel ||+ x
26    >     uniplate (Let x y) = plate Let |-  x |- y
27    >
28    > instance Biplate Stmt Stmt where
29    >     biplate = plateSelf
30    >
31    > instance Biplate Stmt Expr where
32    >     biplate (Seq x  ) = plate Seq ||+ x
33    >     biplate (Sel x  ) = plate Sel ||* x
34    >     biplate (Let x y) = plate Let |-  x |* y
35
36    To define instances for abstract data types, such as @Map@ or @Set@ from the @containers@ package,
37    use 'plateProject'.
38
39    This module provides a few monomorphic instances of 'Uniplate' / 'Biplate'
40    for common types available in the base library, but does not provide any polymorphic
41    instances. Given only monomorphic instances it is trivial to ensure that all instances
42    are disjoint, making it easier to add your own instances.
43
44    When defining polymorphic instances, be carefully to mention all potential children.
45    Consider @Biplate Int (Int, a)@ - this instance cannot be correct because it will fail
46    to return both @Int@ values on @(Int,Int)@. There are some legitimate polymorphic instances,
47    such as @Biplate a [a]@ and @Biplate a a@, but take care to avoid overlapping instances.
48-}
49module Data.Generics.Uniplate.Direct(
50    module Data.Generics.Uniplate.Operations,
51    -- * The Combinators
52    plate, plateSelf,
53    (|+), (|-), (|*), (||+), (||*),
54    plateProject
55    ) where
56
57import Control.Arrow
58import Data.Generics.Uniplate.Operations
59import Data.Generics.Str
60import Data.Ratio
61
62
63type Type from to = (Str to, Str to -> from)
64
65-- | The main combinator used to start the chain.
66--
67-- The following rule can be used for optimisation:
68--
69-- > plate Ctor |- x == plate (Ctor x)
70{-# INLINE[1] plate #-}
71plate :: from -> Type from to
72plate f = (Zero, \_ -> f)
73
74
75{-# RULES
76"plate/-"    forall f x. plate f |- x = plate (f x)
77"plate/+"    forall f x. plate f |+ x = platePlus f x
78"plate/*"    forall f x. plate f |* x = plateStar f x #-}
79
80
81{-# INLINE plateStar #-}
82plateStar :: (to -> from) -> to -> Type from to
83plateStar f x = (One x, \(One x) -> f x)
84
85{-# INLINE platePlus #-}
86platePlus :: Biplate item to => (item -> from) -> item -> Type from to
87platePlus f x = case biplate x of
88                        (ys,y_) -> (ys, \ys -> f $ y_ ys)
89
90
91-- | The field to the right is the target.
92{-# INLINE[1] (|*) #-}
93(|*) :: Type (to -> from) to -> to -> Type from to
94(|*) (xs,x_) y = (Two xs (One y),\(Two xs (One y)) -> x_ xs y)
95
96
97
98-- | The field to the right may contain the target.
99{-# INLINE[1] (|+) #-}
100(|+) :: Biplate item to => Type (item -> from) to -> item -> Type from to
101(|+) (xs,x_) y = case biplate y of
102                      (ys,y_) -> (Two xs ys, \(Two xs ys) -> x_ xs (y_ ys))
103
104
105-- | The field to the right /does not/ contain the target.
106{-# INLINE[1] (|-) #-}
107(|-) :: Type (item -> from) to -> item -> Type from to
108(|-) (xs,x_) y = (xs,\xs -> x_ xs y)
109
110
111-- | The field to the right is a list of the type of the target
112{-# INLINE (||*) #-}
113(||*) :: Type ([to] -> from) to -> [to] -> Type from to
114(||*) (xs,x_) y = (Two xs (listStr y), \(Two xs ys) -> x_ xs (strList ys))
115
116
117-- | The field to the right is a list of types which may contain the target
118(||+) :: Biplate item to => Type ([item] -> from) to -> [item] -> Type from to
119(||+) (xs,x_) [] = (xs, \xs -> x_ xs []) -- can eliminate a Two _ Zero in the base case
120(||+) (xs,x_) (y:ys) = case plate (:) |+ y ||+ ys of
121                       (ys,y_) -> (Two xs ys, \(Two xs ys) -> x_ xs (y_ ys))
122
123
124-- | Used for 'Biplate' definitions where both types are the same.
125plateSelf :: to -> Type to to
126plateSelf x = (One x, \(One x) -> x)
127
128
129-- | Write an instance in terms of a projection/injection pair. Usually used to define instances
130--   for abstract containers such as Map:
131--
132-- > instance Biplate (Map.Map [Char] Int) Char where
133-- >     biplate = plateProject Map.toList Map.fromList
134--
135--   If the types ensure that no operations will not change the keys
136--   we can use the 'fromDistictAscList' function to reconstruct the Map:
137--
138-- > instance Biplate (Map.Map [Char] Int) Int where
139-- >     biplate = plateProject Map.toAscList Map.fromDistinctAscList
140plateProject :: Biplate item to => (from -> item) -> (item -> from) -> from -> Type from to
141plateProject into outof = second (outof . ) . biplate . into
142
143
144instance Uniplate Int where uniplate x = plate x
145instance Uniplate Bool where uniplate x = plate x
146instance Uniplate Char where uniplate x = plate x
147instance Uniplate Integer where uniplate x = plate x
148instance Uniplate Double where uniplate x = plate x
149instance Uniplate Float where uniplate x = plate x
150instance Uniplate () where uniplate x = plate x
151
152instance Uniplate [Char] where
153    uniplate (x:xs) = plate (x:) |* xs
154    uniplate x = plate x
155
156instance Biplate [Char] Char where
157    biplate (x:xs) = plate (:) |* x ||* xs
158    biplate x = plate x
159
160instance Biplate [Char] [Char] where
161    biplate = plateSelf
162
163instance Uniplate (Ratio Integer) where
164    uniplate = plate
165
166instance Biplate (Ratio Integer) (Ratio Integer) where
167    biplate = plateSelf
168
169instance Biplate (Ratio Integer) Integer where
170    biplate x = (Two (One (numerator x)) (One (denominator x)), \(Two (One n) (One d)) -> n % d)
171