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