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