1{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, CPP #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Data.Generics.Instances
5-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
6-- License     :  BSD-style (see the LICENSE file)
7--
8-- Maintainer  :  generics@haskell.org
9-- Stability   :  experimental
10-- Portability :  non-portable (uses Data.Data)
11--
12-- \"Scrap your boilerplate\" --- Generic programming in Haskell
13-- See <http://www.cs.uu.nl/wiki/GenericProgramming/SYB>. The present module
14-- contains thirteen 'Data' instances which are considered dubious (either
15-- because the types are abstract or just not meant to be traversed).
16-- Instances in this module might change or disappear in future releases
17-- of this package.
18--
19-- (This module does not export anything. It really just defines instances.)
20--
21-----------------------------------------------------------------------------
22
23{-# OPTIONS_GHC -fno-warn-orphans #-}
24module Data.Generics.Instances () where
25
26------------------------------------------------------------------------------
27
28import Data.Data
29
30#ifdef __GLASGOW_HASKELL__
31#if __GLASGOW_HASKELL__ >= 611
32import GHC.IO.Handle         -- So we can give Data instance for Handle
33#else
34import GHC.IOBase            -- So we can give Data instance for IO, Handle
35#endif
36import GHC.Stable            -- So we can give Data instance for StablePtr
37import GHC.ST                -- So we can give Data instance for ST
38import GHC.Conc              -- So we can give Data instance for TVar
39import Data.IORef            -- So we can give Data instance for IORef
40import Control.Concurrent    -- So we can give Data instance for MVar
41#else
42# ifdef __HUGS__
43import Hugs.Prelude( Ratio(..) )
44# endif
45import System.IO
46import Foreign.Ptr
47import Foreign.ForeignPtr
48import Foreign.StablePtr
49import Control.Monad.ST
50#endif
51
52-- Version compatibility issues caused by #2760
53myMkNoRepType :: String -> DataType
54#if __GLASGOW_HASKELL__ >= 611
55myMkNoRepType = mkNoRepType
56#else
57myMkNoRepType = mkNorepType
58#endif
59
60
61------------------------------------------------------------------------------
62--
63--      Instances of the Data class for Prelude-like types.
64--      We define top-level definitions for representations.
65--
66------------------------------------------------------------------------------
67
68
69------------------------------------------------------------------------------
70-- Instances of abstract datatypes (6)
71------------------------------------------------------------------------------
72
73#if __GLASGOW_HASKELL__ < 801
74instance Data TypeRep where
75  toConstr _   = error "toConstr"
76  gunfold _ _  = error "gunfold"
77  dataTypeOf _ = myMkNoRepType "Data.Typeable.TypeRep"
78#endif
79
80
81------------------------------------------------------------------------------
82
83instance Data TyCon where
84  toConstr _   = error "toConstr"
85  gunfold _ _  = error "gunfold"
86  dataTypeOf _ = myMkNoRepType "Data.Typeable.TyCon"
87
88
89------------------------------------------------------------------------------
90#if __GLASGOW_HASKELL__ < 709
91deriving instance Typeable DataType
92#endif
93
94instance Data DataType where
95  toConstr _   = error "toConstr"
96  gunfold _ _  = error "gunfold"
97  dataTypeOf _ = myMkNoRepType "Data.Generics.Basics.DataType"
98
99
100------------------------------------------------------------------------------
101
102instance Data Handle where
103  toConstr _   = error "toConstr"
104  gunfold _ _  = error "gunfold"
105  dataTypeOf _ = myMkNoRepType "GHC.IOBase.Handle"
106
107
108------------------------------------------------------------------------------
109
110instance Typeable a => Data (StablePtr a) where
111  toConstr _   = error "toConstr"
112  gunfold _ _  = error "gunfold"
113  dataTypeOf _ = myMkNoRepType "GHC.Stable.StablePtr"
114
115
116------------------------------------------------------------------------------
117
118#ifdef __GLASGOW_HASKELL__
119instance Data ThreadId where
120  toConstr _   = error "toConstr"
121  gunfold _ _  = error "gunfold"
122  dataTypeOf _ = myMkNoRepType "GHC.Conc.ThreadId"
123#endif
124
125
126------------------------------------------------------------------------------
127-- Dubious instances (7)
128------------------------------------------------------------------------------
129
130#ifdef __GLASGOW_HASKELL__
131instance Typeable a => Data (TVar a) where
132  toConstr _   = error "toConstr"
133  gunfold _ _  = error "gunfold"
134  dataTypeOf _ = myMkNoRepType "GHC.Conc.TVar"
135#endif
136
137
138------------------------------------------------------------------------------
139
140instance Typeable a => Data (MVar a) where
141  toConstr _   = error "toConstr"
142  gunfold _ _  = error "gunfold"
143  dataTypeOf _ = myMkNoRepType "GHC.Conc.MVar"
144
145
146------------------------------------------------------------------------------
147
148#ifdef __GLASGOW_HASKELL__
149instance Typeable a => Data (STM a) where
150  toConstr _   = error "toConstr"
151  gunfold _ _  = error "gunfold"
152  dataTypeOf _ = myMkNoRepType "GHC.Conc.STM"
153#endif
154
155
156------------------------------------------------------------------------------
157
158instance (Typeable s, Typeable a) => Data (ST s a) where
159  toConstr _   = error "toConstr"
160  gunfold _ _  = error "gunfold"
161  dataTypeOf _ = myMkNoRepType "GHC.ST.ST"
162
163
164------------------------------------------------------------------------------
165
166instance Typeable a => Data (IORef a) where
167  toConstr _   = error "toConstr"
168  gunfold _ _  = error "gunfold"
169  dataTypeOf _ = myMkNoRepType "GHC.IOBase.IORef"
170
171
172------------------------------------------------------------------------------
173
174instance Typeable a => Data (IO a) where
175  toConstr _   = error "toConstr"
176  gunfold _ _  = error "gunfold"
177  dataTypeOf _ = myMkNoRepType "GHC.IOBase.IO"
178
179------------------------------------------------------------------------------
180
181--
182-- A last resort for functions
183--
184
185instance (Data a, Data b) => Data (a -> b) where
186  toConstr _   = error "toConstr"
187  gunfold _ _  = error "gunfold"
188  dataTypeOf _ = myMkNoRepType "Prelude.(->)"
189  dataCast2 f  = gcast2 f
190
191