1{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-} 2 3{- | 4 /DEPRECATED/: Use "Data.Generics.Uniplate.Typeable" instead. 5 6 This module supplies a method for writing 'Biplate' instances more easily. 7 8 To take an example: 9 10 > data Expr = Var Int | Neg Expr | Add Expr Expr 11 > 12 > instance Typeable Expr where ... 13 > 14 > instance (Typeable a, Uniplate a) => PlateAll Expr a where 15 > plateAll (Var x ) = plate Var |- x 16 > plateAll (Neg x ) = plate Neg |+ x 17 > plateAll (Add x y) = plate Add |+ x |+ y 18 > 19 > instance Uniplate Expr where 20 > uniplate = uniplateAll 21-} 22 23module Data.Generics.PlateTypeable 24 {-# DEPRECATED "Use Data.Generics.Uniplate.Typeable instead" #-} 25 ( 26 module Data.Generics.Biplate, 27 module Data.Typeable, 28 -- * The Class 29 PlateAll(..), uniplateAll, 30 -- * The Combinators 31 plate, (|+), (|-) 32 ) where 33 34import Data.Generics.Biplate 35import Data.Generics.Uniplate.Internal.Utils 36import Data.Typeable 37 38 39instance (Typeable a, Typeable b, Uniplate b, PlateAll a b) => Biplate a b where 40 biplate = plateMore 41 42 43-- | This function is used to write a 'Uniplate' instance from a 'PlateAll' one 44uniplateAll :: PlateAll a b => a -> (Str b, Str b -> a) 45uniplateAll = plateAll 46 47 48type Type from to = (Str to, Str to -> from) 49 50 51plateMore :: (Typeable from, Typeable to, PlateAll from to) => from -> Type from to 52plateMore x = res 53 where 54 res = case asTypeOf (cast x) (Just $ strType $ fst res) of 55 Nothing -> plateAll x 56 Just y -> (One y, \(One y) -> unsafeCoerce y) 57 58 59-- | This class represents going from the container type to the target. 60-- 61-- This class should only be constructed with 'plate', '|+' and '|-' 62class PlateAll from to where 63 plateAll :: from -> Type from to 64 65 66-- | The main combinator used to start the chain. 67-- 68-- The following rule can be used for optimisation: 69-- 70-- > plate Ctor |- x == plate (Ctor x) 71plate :: from -> Type from to 72plate x = (Zero, \_ -> x) 73 74 75-- | the field to the right may contain the target. 76(|+) :: (Typeable item, Typeable to, PlateAll item to) => Type (item -> from) to -> item -> Type from to 77(|+) (xs,x_) y = case plateMore y of 78 (ys,y_) -> (Two xs ys,\(Two xs ys) -> x_ xs (y_ ys)) 79 80-- | The field to the right /does not/ contain the target. 81-- This can be used as either an optimisation, or more commonly for excluding 82-- primitives such as Int. 83(|-) :: Type (item -> from) to -> item -> Type from to 84(|-) (xs,x_) y = (xs,\xs -> x_ xs y) 85 86 87-- * Instances 88 89-- ** Primitive Types 90 91instance PlateAll Int to where plateAll x = plate x 92instance Uniplate Int where uniplate = uniplateAll 93 94instance PlateAll Bool to where plateAll x = plate x 95instance Uniplate Bool where uniplate = uniplateAll 96 97instance PlateAll Char to where plateAll x = plate x 98instance Uniplate Char where uniplate = uniplateAll 99 100instance PlateAll Integer to where plateAll x = plate x 101instance Uniplate Integer where uniplate = uniplateAll 102 103instance PlateAll Double to where plateAll x = plate x 104instance Uniplate Double where uniplate = uniplateAll 105 106instance PlateAll Float to where plateAll x = plate x 107instance Uniplate Float where uniplate = uniplateAll 108 109instance PlateAll () to where plateAll x = plate x 110instance Uniplate () where uniplate = uniplateAll 111 112-- ** Container Types 113 114instance (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll [from] to where 115 plateAll [] = plate [] 116 plateAll (x:xs) = plate (:) |+ x |+ xs 117 118instance (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll (Maybe from) to where 119 plateAll Nothing = plate Nothing 120 plateAll (Just x) = plate Just |+ x 121 122instance (PlateAll a to, Typeable a, PlateAll b to, Typeable b, Typeable to, Uniplate to) => 123 PlateAll (Either a b) to where 124 plateAll (Left x) = plate Left |+ x 125 plateAll (Right x) = plate Right |+ x 126 127instance (PlateAll a to, Typeable a 128 ,PlateAll b to, Typeable b 129 ,Typeable to, Uniplate to) => 130 PlateAll (a,b) to where 131 plateAll (a,b) = plate (,) |+ a |+ b 132 133instance (PlateAll a to, Typeable a 134 ,PlateAll b to, Typeable b 135 ,PlateAll c to, Typeable c 136 ,Typeable to, Uniplate to) => 137 PlateAll (a,b,c) to where 138 plateAll (a,b,c) = plate (,,) |+ a |+ b |+ c 139 140instance (PlateAll a to, Typeable a 141 ,PlateAll b to, Typeable b 142 ,PlateAll c to, Typeable c 143 ,PlateAll d to, Typeable d 144 ,Typeable to, Uniplate to) => 145 PlateAll (a,b,c,d) to where 146 plateAll (a,b,c,d) = plate (,,,) |+ a |+ b |+ c |+ d 147 148instance (PlateAll a to, Typeable a 149 ,PlateAll b to, Typeable b 150 ,PlateAll c to, Typeable c 151 ,PlateAll d to, Typeable d 152 ,PlateAll e to, Typeable e 153 ,Typeable to, Uniplate to) => 154 PlateAll (a,b,c,d,e) to where 155 plateAll (a,b,c,d,e) = plate (,,,,) |+ a |+ b |+ c |+ d |+ e 156 157