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