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