------------------------------------------------------------------------------
--
-- | Instances of the Data class for Prelude-like types.
-- We define top-level definitions for representations.
--
------------------------------------------------------------------------------

{-# LANGUAGE TemplateHaskell, FlexibleContexts, FlexibleInstances,
             UndecidableInstances, CPP, MultiParamTypeClasses #-}
#if MIN_VERSION_base(4,7,0)
{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- This is a module full of orphans, so don't warn about them

module Data.Generics.SYB.WithClass.Instances () where

import Data.Generics.SYB.WithClass.Basics
import Data.Generics.SYB.WithClass.Derive

import Data.Array
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Lazy as L (ByteString)
import Data.Int              -- So we can give Data instance for Int8, ...
import Data.Word             -- So we can give Data instance for Word8, ...
import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
import System.IO             -- So we can give Data instance for IO, Handle
import GHC.Ptr               -- So we can give Data instance for Ptr
import GHC.ForeignPtr        -- So we can give Data instance for ForeignPtr
import GHC.Stable            -- So we can give Data instance for StablePtr
import GHC.ST                -- So we can give Data instance for ST
import Data.IORef            -- So we can give Data instance for IORef
import Control.Concurrent.MVar   -- So we can give Data instance for MVar & Co.
import qualified Data.Map as M
import qualified Data.Set as S


falseConstr :: Constr
falseConstr :: Constr
falseConstr  = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
boolDataType String
"False" [] Fixity
Prefix
trueConstr :: Constr
trueConstr :: Constr
trueConstr   = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
boolDataType String
"True"  [] Fixity
Prefix
boolDataType :: DataType
boolDataType :: DataType
boolDataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.Bool" [Constr
falseConstr,Constr
trueConstr]

instance Sat (ctx Bool) =>
         Data ctx Bool where
  toConstr :: Proxy ctx -> Bool -> Constr
toConstr Proxy ctx
_ Bool
False = Constr
falseConstr
  toConstr Proxy ctx
_ Bool
True  = Constr
trueConstr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Bool
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c  = case Constr -> ConIndex
constrIndex Constr
c of
                       ConIndex
1 -> Bool -> c Bool
forall r. r -> c r
z Bool
False
                       ConIndex
2 -> Bool -> c Bool
forall r. r -> c r
z Bool
True
                       ConIndex
_ -> String -> c Bool
forall a. HasCallStack => String -> a
error String
"gunfold Bool"
  dataTypeOf :: Proxy ctx -> Bool -> DataType
dataTypeOf Proxy ctx
_ Bool
_ = DataType
boolDataType


------------------------------------------------------------------------------


charType :: DataType
charType :: DataType
charType = String -> DataType
mkStringType String
"Prelude.Char"

instance Sat (ctx Char) =>
         Data ctx Char where
  toConstr :: Proxy ctx -> Char -> Constr
toConstr Proxy ctx
_ Char
x = DataType -> String -> Constr
mkStringConstr DataType
charType [Char
x]
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Char
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (StringConstr [Char
x]) -> Char -> c Char
forall r. r -> c r
z Char
x
                      ConstrRep
_ -> String -> c Char
forall a. HasCallStack => String -> a
error String
"gunfold Char"
  dataTypeOf :: Proxy ctx -> Char -> DataType
dataTypeOf Proxy ctx
_ Char
_ = DataType
charType


------------------------------------------------------------------------------


floatType :: DataType
floatType :: DataType
floatType = String -> DataType
mkFloatType String
"Prelude.Float"

instance Sat (ctx Float) =>
         Data ctx Float where
  toConstr :: Proxy ctx -> Float -> Constr
toConstr Proxy ctx
_ Float
x = DataType -> Double -> Constr
mkFloatConstr DataType
floatType (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Float
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (FloatConstr Double
x) -> Float -> c Float
forall r. r -> c r
z (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
                      ConstrRep
_ -> String -> c Float
forall a. HasCallStack => String -> a
error String
"gunfold Float"
  dataTypeOf :: Proxy ctx -> Float -> DataType
dataTypeOf Proxy ctx
_ Float
_ = DataType
floatType


------------------------------------------------------------------------------


doubleType :: DataType
doubleType :: DataType
doubleType = String -> DataType
mkFloatType String
"Prelude.Double"

instance Sat (ctx Double) =>
         Data ctx Double where
  toConstr :: Proxy ctx -> Double -> Constr
toConstr Proxy ctx
_ = DataType -> Double -> Constr
mkFloatConstr DataType
floatType
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Double
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (FloatConstr Double
x) -> Double -> c Double
forall r. r -> c r
z Double
x
                      ConstrRep
_ -> String -> c Double
forall a. HasCallStack => String -> a
error String
"gunfold Double"
  dataTypeOf :: Proxy ctx -> Double -> DataType
dataTypeOf Proxy ctx
_ Double
_ = DataType
doubleType


------------------------------------------------------------------------------


intType :: DataType
intType :: DataType
intType = String -> DataType
mkIntType String
"Prelude.Int"

instance Sat (ctx Int) =>
         Data ctx Int where
  toConstr :: Proxy ctx -> ConIndex -> Constr
toConstr Proxy ctx
_ ConIndex
x = DataType -> Integer -> Constr
mkIntConstr DataType
intType (ConIndex -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConIndex
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ConIndex
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> ConIndex -> c ConIndex
forall r. r -> c r
z (Integer -> ConIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c ConIndex
forall a. HasCallStack => String -> a
error String
"gunfold Int"
  dataTypeOf :: Proxy ctx -> ConIndex -> DataType
dataTypeOf Proxy ctx
_ ConIndex
_ = DataType
intType


------------------------------------------------------------------------------


integerType :: DataType
integerType :: DataType
integerType = String -> DataType
mkIntType String
"Prelude.Integer"

instance Sat (ctx Integer) =>
         Data ctx Integer where
  toConstr :: Proxy ctx -> Integer -> Constr
toConstr Proxy ctx
_ = DataType -> Integer -> Constr
mkIntConstr DataType
integerType
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Integer
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Integer -> c Integer
forall r. r -> c r
z Integer
x
                      ConstrRep
_ -> String -> c Integer
forall a. HasCallStack => String -> a
error String
"gunfold Integer"
  dataTypeOf :: Proxy ctx -> Integer -> DataType
dataTypeOf Proxy ctx
_ Integer
_ = DataType
integerType


------------------------------------------------------------------------------


int8Type :: DataType
int8Type :: DataType
int8Type = String -> DataType
mkIntType String
"Data.Int.Int8"

instance Sat (ctx Int8) =>
         Data ctx Int8 where
  toConstr :: Proxy ctx -> Int8 -> Constr
toConstr Proxy ctx
_ Int8
x = DataType -> Integer -> Constr
mkIntConstr DataType
int8Type (Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Int8
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Int8 -> c Int8
forall r. r -> c r
z (Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Int8
forall a. HasCallStack => String -> a
error String
"gunfold Int8"
  dataTypeOf :: Proxy ctx -> Int8 -> DataType
dataTypeOf Proxy ctx
_ Int8
_ = DataType
int8Type


------------------------------------------------------------------------------


int16Type :: DataType
int16Type :: DataType
int16Type = String -> DataType
mkIntType String
"Data.Int.Int16"

instance Sat (ctx Int16) =>
         Data ctx Int16 where
  toConstr :: Proxy ctx -> Int16 -> Constr
toConstr Proxy ctx
_ Int16
x = DataType -> Integer -> Constr
mkIntConstr DataType
int16Type (Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Int16
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Int16 -> c Int16
forall r. r -> c r
z (Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Int16
forall a. HasCallStack => String -> a
error String
"gunfold Int16"
  dataTypeOf :: Proxy ctx -> Int16 -> DataType
dataTypeOf Proxy ctx
_ Int16
_ = DataType
int16Type


------------------------------------------------------------------------------


int32Type :: DataType
int32Type :: DataType
int32Type = String -> DataType
mkIntType String
"Data.Int.Int32"

instance Sat (ctx Int32) =>
         Data ctx Int32 where
  toConstr :: Proxy ctx -> Int32 -> Constr
toConstr Proxy ctx
_ Int32
x = DataType -> Integer -> Constr
mkIntConstr DataType
int32Type (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Int32
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Int32 -> c Int32
forall r. r -> c r
z (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Int32
forall a. HasCallStack => String -> a
error String
"gunfold Int32"
  dataTypeOf :: Proxy ctx -> Int32 -> DataType
dataTypeOf Proxy ctx
_ Int32
_ = DataType
int32Type


------------------------------------------------------------------------------


int64Type :: DataType
int64Type :: DataType
int64Type = String -> DataType
mkIntType String
"Data.Int.Int64"

instance Sat (ctx Int64) =>
         Data ctx Int64 where
  toConstr :: Proxy ctx -> Int64 -> Constr
toConstr Proxy ctx
_ Int64
x = DataType -> Integer -> Constr
mkIntConstr DataType
int64Type (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Int64
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Int64 -> c Int64
forall r. r -> c r
z (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Int64
forall a. HasCallStack => String -> a
error String
"gunfold Int64"
  dataTypeOf :: Proxy ctx -> Int64 -> DataType
dataTypeOf Proxy ctx
_ Int64
_ = DataType
int64Type


------------------------------------------------------------------------------


wordType :: DataType
wordType :: DataType
wordType = String -> DataType
mkIntType String
"Data.Word.Word"

instance Sat (ctx Word) =>
         Data ctx Word where
  toConstr :: Proxy ctx -> Word -> Constr
toConstr Proxy ctx
_ Word
x = DataType -> Integer -> Constr
mkIntConstr DataType
wordType (Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Word
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Word -> c Word
forall r. r -> c r
z (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Word
forall a. HasCallStack => String -> a
error String
"gunfold Word"
  dataTypeOf :: Proxy ctx -> Word -> DataType
dataTypeOf Proxy ctx
_ Word
_ = DataType
wordType


------------------------------------------------------------------------------


word8Type :: DataType
word8Type :: DataType
word8Type = String -> DataType
mkIntType String
"Data.Word.Word8"

instance Sat (ctx Word8) =>
         Data ctx Word8 where
  toConstr :: Proxy ctx -> Word8 -> Constr
toConstr Proxy ctx
_ Word8
x = DataType -> Integer -> Constr
mkIntConstr DataType
word8Type (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Word8
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Word8 -> c Word8
forall r. r -> c r
z (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Word8
forall a. HasCallStack => String -> a
error String
"gunfold Word8"
  dataTypeOf :: Proxy ctx -> Word8 -> DataType
dataTypeOf Proxy ctx
_ Word8
_ = DataType
word8Type


------------------------------------------------------------------------------


word16Type :: DataType
word16Type :: DataType
word16Type = String -> DataType
mkIntType String
"Data.Word.Word16"

instance Sat (ctx Word16) =>
         Data ctx Word16 where
  toConstr :: Proxy ctx -> Word16 -> Constr
toConstr Proxy ctx
_ Word16
x = DataType -> Integer -> Constr
mkIntConstr DataType
word16Type (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Word16
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Word16 -> c Word16
forall r. r -> c r
z (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Word16
forall a. HasCallStack => String -> a
error String
"gunfold Word16"
  dataTypeOf :: Proxy ctx -> Word16 -> DataType
dataTypeOf Proxy ctx
_ Word16
_ = DataType
word16Type


------------------------------------------------------------------------------


word32Type :: DataType
word32Type :: DataType
word32Type = String -> DataType
mkIntType String
"Data.Word.Word32"

instance Sat (ctx Word32) =>
         Data ctx Word32 where
  toConstr :: Proxy ctx -> Word32 -> Constr
toConstr Proxy ctx
_ Word32
x = DataType -> Integer -> Constr
mkIntConstr DataType
word32Type (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Word32
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Word32 -> c Word32
forall r. r -> c r
z (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Word32
forall a. HasCallStack => String -> a
error String
"gunfold Word32"
  dataTypeOf :: Proxy ctx -> Word32 -> DataType
dataTypeOf Proxy ctx
_ Word32
_ = DataType
word32Type


------------------------------------------------------------------------------


word64Type :: DataType
word64Type :: DataType
word64Type = String -> DataType
mkIntType String
"Data.Word.Word64"

instance Sat (ctx Word64) =>
         Data ctx Word64 where
  toConstr :: Proxy ctx -> Word64 -> Constr
toConstr Proxy ctx
_ Word64
x = DataType -> Integer -> Constr
mkIntConstr DataType
word64Type (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x)
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Word64
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
                      (IntConstr Integer
x) -> Word64 -> c Word64
forall r. r -> c r
z (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
                      ConstrRep
_ -> String -> c Word64
forall a. HasCallStack => String -> a
error String
"gunfold Word64"
  dataTypeOf :: Proxy ctx -> Word64 -> DataType
dataTypeOf Proxy ctx
_ Word64
_ = DataType
word64Type




------------------------------------------------------------------------------


ratioConstr :: Constr
ratioConstr :: Constr
ratioConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
ratioDataType String
":%" [] Fixity
Infix
ratioDataType :: DataType
ratioDataType :: DataType
ratioDataType = String -> [Constr] -> DataType
mkDataType String
"GHC.Real.Ratio" [Constr
ratioConstr]

instance (Sat (ctx (Ratio a)), Data ctx a, Integral a) =>
          Data ctx (Ratio a) where
  toConstr :: Proxy ctx -> Ratio a -> Constr
toConstr Proxy ctx
_ Ratio a
_ = Constr
ratioConstr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Ratio a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c | Constr -> ConIndex
constrIndex Constr
c ConIndex -> ConIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ConIndex
1 = c (a -> Ratio a) -> c (Ratio a)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> a -> Ratio a) -> c (a -> Ratio a)
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> a -> Ratio a) -> c (a -> a -> Ratio a)
forall r. r -> c r
z a -> a -> Ratio a
forall a. a -> a -> Ratio a
(:%)))
  gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ = String -> c (Ratio a)
forall a. HasCallStack => String -> a
error String
"gunfold Ratio"
  dataTypeOf :: Proxy ctx -> Ratio a -> DataType
dataTypeOf Proxy ctx
_ Ratio a
_  = DataType
ratioDataType


------------------------------------------------------------------------------


nilConstr :: Constr
nilConstr :: Constr
nilConstr    = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
listDataType String
"[]" [] Fixity
Prefix
consConstr :: Constr
consConstr :: Constr
consConstr   = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
listDataType String
"(:)" [] Fixity
Infix
listDataType :: DataType
listDataType :: DataType
listDataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.[]" [Constr
nilConstr,Constr
consConstr]

instance (Sat (ctx [a]), Data ctx a) =>
         Data ctx [a] where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> [a]
-> w [a]
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
_ forall g. g -> w g
z []     = [a] -> w [a]
forall g. g -> w g
z []
  gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (a
x:[a]
xs) = (a -> [a] -> [a]) -> w (a -> [a] -> [a])
forall g. g -> w g
z (:) w (a -> [a] -> [a]) -> a -> w ([a] -> [a])
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
x w ([a] -> [a]) -> [a] -> w [a]
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` [a]
xs
  toConstr :: Proxy ctx -> [a] -> Constr
toConstr Proxy ctx
_ []    = Constr
nilConstr
  toConstr Proxy ctx
_ (a
_:[a]
_) = Constr
consConstr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c [a]
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> [a] -> c [a]
forall r. r -> c r
z []
                      ConIndex
2 -> c ([a] -> [a]) -> c [a]
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> [a] -> [a]) -> c ([a] -> [a])
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> [a] -> [a]) -> c (a -> [a] -> [a])
forall r. r -> c r
z (:)))
                      ConIndex
_ -> String -> c [a]
forall a. HasCallStack => String -> a
error String
"gunfold List"
  dataTypeOf :: Proxy ctx -> [a] -> DataType
dataTypeOf Proxy ctx
_ [a]
_ = DataType
listDataType
  dataCast1 :: Proxy ctx -> (forall b. Data ctx b => w (t b)) -> Maybe (w [a])
dataCast1 Proxy ctx
_ forall b. Data ctx b => w (t b)
f = w (t a) -> Maybe (w [a])
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 w (t a)
forall b. Data ctx b => w (t b)
f

------------------------------------------------------------------------------


nothingConstr :: Constr
nothingConstr :: Constr
nothingConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
maybeDataType String
"Nothing" [] Fixity
Prefix
justConstr :: Constr
justConstr :: Constr
justConstr    = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
maybeDataType String
"Just"    [] Fixity
Prefix
maybeDataType :: DataType
maybeDataType :: DataType
maybeDataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.Maybe" [Constr
nothingConstr,Constr
justConstr]

instance (Sat (ctx (Maybe a)), Data ctx a) =>
          Data ctx (Maybe a) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> Maybe a
-> w (Maybe a)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
_ forall g. g -> w g
z Maybe a
Nothing  = Maybe a -> w (Maybe a)
forall g. g -> w g
z Maybe a
forall a. Maybe a
Nothing
  gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (Just a
x) = (a -> Maybe a) -> w (a -> Maybe a)
forall g. g -> w g
z a -> Maybe a
forall a. a -> Maybe a
Just w (a -> Maybe a) -> a -> w (Maybe a)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
x
  toConstr :: Proxy ctx -> Maybe a -> Constr
toConstr Proxy ctx
_ Maybe a
Nothing  = Constr
nothingConstr
  toConstr Proxy ctx
_ (Just a
_) = Constr
justConstr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Maybe a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> Maybe a -> c (Maybe a)
forall r. r -> c r
z Maybe a
forall a. Maybe a
Nothing
                      ConIndex
2 -> c (a -> Maybe a) -> c (Maybe a)
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> Maybe a) -> c (a -> Maybe a)
forall r. r -> c r
z a -> Maybe a
forall a. a -> Maybe a
Just)
                      ConIndex
_ -> String -> c (Maybe a)
forall a. HasCallStack => String -> a
error String
"gunfold Maybe"
  dataTypeOf :: Proxy ctx -> Maybe a -> DataType
dataTypeOf Proxy ctx
_ Maybe a
_ = DataType
maybeDataType
  dataCast1 :: Proxy ctx
-> (forall b. Data ctx b => w (t b)) -> Maybe (w (Maybe a))
dataCast1 Proxy ctx
_ forall b. Data ctx b => w (t b)
f  = w (t a) -> Maybe (w (Maybe a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 w (t a)
forall b. Data ctx b => w (t b)
f


------------------------------------------------------------------------------


ltConstr :: Constr
ltConstr :: Constr
ltConstr         = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
orderingDataType String
"LT" [] Fixity
Prefix
eqConstr :: Constr
eqConstr :: Constr
eqConstr         = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
orderingDataType String
"EQ" [] Fixity
Prefix
gtConstr :: Constr
gtConstr :: Constr
gtConstr         = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
orderingDataType String
"GT" [] Fixity
Prefix
orderingDataType :: DataType
orderingDataType :: DataType
orderingDataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.Ordering" [Constr
ltConstr,Constr
eqConstr,Constr
gtConstr]

instance Sat (ctx Ordering) =>
         Data ctx Ordering where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> Ordering
-> w Ordering
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
_ forall g. g -> w g
z Ordering
LT  = Ordering -> w Ordering
forall g. g -> w g
z Ordering
LT
  gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
_ forall g. g -> w g
z Ordering
EQ  = Ordering -> w Ordering
forall g. g -> w g
z Ordering
EQ
  gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
_ forall g. g -> w g
z Ordering
GT  = Ordering -> w Ordering
forall g. g -> w g
z Ordering
GT
  toConstr :: Proxy ctx -> Ordering -> Constr
toConstr Proxy ctx
_ Ordering
LT  = Constr
ltConstr
  toConstr Proxy ctx
_ Ordering
EQ  = Constr
eqConstr
  toConstr Proxy ctx
_ Ordering
GT  = Constr
gtConstr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Ordering
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> Ordering -> c Ordering
forall r. r -> c r
z Ordering
LT
                      ConIndex
2 -> Ordering -> c Ordering
forall r. r -> c r
z Ordering
EQ
                      ConIndex
3 -> Ordering -> c Ordering
forall r. r -> c r
z Ordering
GT
                      ConIndex
_ -> String -> c Ordering
forall a. HasCallStack => String -> a
error String
"gunfold Ordering"
  dataTypeOf :: Proxy ctx -> Ordering -> DataType
dataTypeOf Proxy ctx
_ Ordering
_ = DataType
orderingDataType


------------------------------------------------------------------------------


leftConstr :: Constr
leftConstr :: Constr
leftConstr     = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
eitherDataType String
"Left"  [] Fixity
Prefix
rightConstr :: Constr
rightConstr :: Constr
rightConstr    = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
eitherDataType String
"Right" [] Fixity
Prefix
eitherDataType :: DataType
eitherDataType :: DataType
eitherDataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.Either" [Constr
leftConstr,Constr
rightConstr]

instance (Sat (ctx (Either a b)), Data ctx a, Data ctx b) =>
          Data ctx (Either a b) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> Either a b
-> w (Either a b)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (Left a
a)   = (a -> Either a b) -> w (a -> Either a b)
forall g. g -> w g
z a -> Either a b
forall a b. a -> Either a b
Left  w (a -> Either a b) -> a -> w (Either a b)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
a
  gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (Right b
a)  = (b -> Either a b) -> w (b -> Either a b)
forall g. g -> w g
z b -> Either a b
forall a b. b -> Either a b
Right w (b -> Either a b) -> b -> w (Either a b)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` b
a
  toConstr :: Proxy ctx -> Either a b -> Constr
toConstr Proxy ctx
_ (Left a
_)  = Constr
leftConstr
  toConstr Proxy ctx
_ (Right b
_) = Constr
rightConstr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Either a b)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> c (a -> Either a b) -> c (Either a b)
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> Either a b) -> c (a -> Either a b)
forall r. r -> c r
z a -> Either a b
forall a b. a -> Either a b
Left)
                      ConIndex
2 -> c (b -> Either a b) -> c (Either a b)
forall b r. Data ctx b => c (b -> r) -> c r
k ((b -> Either a b) -> c (b -> Either a b)
forall r. r -> c r
z b -> Either a b
forall a b. b -> Either a b
Right)
                      ConIndex
_ -> String -> c (Either a b)
forall a. HasCallStack => String -> a
error String
"gunfold Either"
  dataTypeOf :: Proxy ctx -> Either a b -> DataType
dataTypeOf Proxy ctx
_ Either a b
_ = DataType
eitherDataType
  dataCast2 :: Proxy ctx
-> (forall b c. (Data ctx b, Data ctx c) => w (t b c))
-> Maybe (w (Either a b))
dataCast2 Proxy ctx
_ forall b c. (Data ctx b, Data ctx c) => w (t b c)
f  = w (t a b) -> Maybe (w (Either a b))
forall k1 k2 k3 (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 w (t a b)
forall b c. (Data ctx b, Data ctx c) => w (t b c)
f


------------------------------------------------------------------------------


--
-- A last resort for functions
--

instance (Sat (ctx (a -> b)), Data ctx a, Data ctx b) =>
          Data ctx (a -> b) where
  toConstr :: Proxy ctx -> (a -> b) -> Constr
toConstr Proxy ctx
_ a -> b
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (a -> b)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (a -> b)
forall a. HasCallStack => String -> a
error String
"gunfold (->)"
  dataTypeOf :: Proxy ctx -> (a -> b) -> DataType
dataTypeOf Proxy ctx
_ a -> b
_ = String -> DataType
mkNorepType String
"Prelude.(->)"
  dataCast2 :: Proxy ctx
-> (forall b c. (Data ctx b, Data ctx c) => w (t b c))
-> Maybe (w (a -> b))
dataCast2 Proxy ctx
_ forall b c. (Data ctx b, Data ctx c) => w (t b c)
f  = w (t a b) -> Maybe (w (a -> b))
forall k1 k2 k3 (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 w (t a b)
forall b c. (Data ctx b, Data ctx c) => w (t b c)
f


------------------------------------------------------------------------------


tuple0Constr :: Constr
tuple0Constr :: Constr
tuple0Constr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tuple0DataType String
"()" [] Fixity
Prefix
tuple0DataType :: DataType
tuple0DataType :: DataType
tuple0DataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.()" [Constr
tuple0Constr]

instance (Sat (ctx ())) =>
          Data ctx () where
  toConstr :: Proxy ctx -> () -> Constr
toConstr Proxy ctx
_ ()
_    = Constr
tuple0Constr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ()
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c | Constr -> ConIndex
constrIndex Constr
c ConIndex -> ConIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ConIndex
1 = () -> c ()
forall r. r -> c r
z ()
  gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ = String -> c ()
forall a. HasCallStack => String -> a
error String
"gunfold ()"
  dataTypeOf :: Proxy ctx -> () -> DataType
dataTypeOf Proxy ctx
_ ()
_  = DataType
tuple0DataType


------------------------------------------------------------------------------


tuple2Constr :: Constr
tuple2Constr :: Constr
tuple2Constr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tuple2DataType String
"(,)" [] Fixity
Infix
tuple2DataType :: DataType
tuple2DataType :: DataType
tuple2DataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.(,)" [Constr
tuple2Constr]

instance (Sat (ctx (a,b)), Data ctx a, Data ctx b) =>
          Data ctx (a,b) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> (a, b)
-> w (a, b)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (a
a,b
b) = (a -> b -> (a, b)) -> w (a -> b -> (a, b))
forall g. g -> w g
z (,) w (a -> b -> (a, b)) -> a -> w (b -> (a, b))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
a w (b -> (a, b)) -> b -> w (a, b)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` b
b
  toConstr :: Proxy ctx -> (a, b) -> Constr
toConstr Proxy ctx
_ (a, b)
_    = Constr
tuple2Constr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (a, b)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c | Constr -> ConIndex
constrIndex Constr
c ConIndex -> ConIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ConIndex
1 = c (b -> (a, b)) -> c (a, b)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> b -> (a, b)) -> c (b -> (a, b))
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> b -> (a, b)) -> c (a -> b -> (a, b))
forall r. r -> c r
z (,)))
  gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ = String -> c (a, b)
forall a. HasCallStack => String -> a
error String
"gunfold (,)"
  dataTypeOf :: Proxy ctx -> (a, b) -> DataType
dataTypeOf Proxy ctx
_ (a, b)
_  = DataType
tuple2DataType
  dataCast2 :: Proxy ctx
-> (forall b c. (Data ctx b, Data ctx c) => w (t b c))
-> Maybe (w (a, b))
dataCast2 Proxy ctx
_ forall b c. (Data ctx b, Data ctx c) => w (t b c)
f   = w (t a b) -> Maybe (w (a, b))
forall k1 k2 k3 (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 w (t a b)
forall b c. (Data ctx b, Data ctx c) => w (t b c)
f


------------------------------------------------------------------------------


tuple3Constr :: Constr
tuple3Constr :: Constr
tuple3Constr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tuple3DataType String
"(,,)" [] Fixity
Infix
tuple3DataType :: DataType
tuple3DataType :: DataType
tuple3DataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.(,)" [Constr
tuple3Constr]

instance (Sat (ctx (a,b,c)), Data ctx a, Data ctx b, Data ctx c) =>
          Data ctx (a,b,c) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> (a, b, c)
-> w (a, b, c)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (a
a,b
b,c
c) = (a -> b -> c -> (a, b, c)) -> w (a -> b -> c -> (a, b, c))
forall g. g -> w g
z (,,) w (a -> b -> c -> (a, b, c)) -> a -> w (b -> c -> (a, b, c))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
a w (b -> c -> (a, b, c)) -> b -> w (c -> (a, b, c))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` b
b w (c -> (a, b, c)) -> c -> w (a, b, c)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` c
c
  toConstr :: Proxy ctx -> (a, b, c) -> Constr
toConstr Proxy ctx
_ (a, b, c)
_    = Constr
tuple3Constr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (a, b, c)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c | Constr -> ConIndex
constrIndex Constr
c ConIndex -> ConIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ConIndex
1 = c (c -> (a, b, c)) -> c (a, b, c)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (b -> c -> (a, b, c)) -> c (c -> (a, b, c))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> b -> c -> (a, b, c)) -> c (b -> c -> (a, b, c))
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> b -> c -> (a, b, c)) -> c (a -> b -> c -> (a, b, c))
forall r. r -> c r
z (,,))))
  gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ = String -> c (a, b, c)
forall a. HasCallStack => String -> a
error String
"gunfold (,,)"
  dataTypeOf :: Proxy ctx -> (a, b, c) -> DataType
dataTypeOf Proxy ctx
_ (a, b, c)
_  = DataType
tuple3DataType

------------------------------------------------------------------------------


tuple4Constr :: Constr
tuple4Constr :: Constr
tuple4Constr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tuple4DataType String
"(,,,)" [] Fixity
Infix
tuple4DataType :: DataType
tuple4DataType :: DataType
tuple4DataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.(,,,)" [Constr
tuple4Constr]

instance (Sat (ctx (a,b,c,d)), Data ctx a, Data ctx b, Data ctx c, Data ctx d) =>
          Data ctx (a,b,c,d) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> (a, b, c, d)
-> w (a, b, c, d)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (a
a,b
b,c
c,d
d) = (a -> b -> c -> d -> (a, b, c, d))
-> w (a -> b -> c -> d -> (a, b, c, d))
forall g. g -> w g
z (,,,) w (a -> b -> c -> d -> (a, b, c, d))
-> a -> w (b -> c -> d -> (a, b, c, d))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
a w (b -> c -> d -> (a, b, c, d)) -> b -> w (c -> d -> (a, b, c, d))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` b
b w (c -> d -> (a, b, c, d)) -> c -> w (d -> (a, b, c, d))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` c
c w (d -> (a, b, c, d)) -> d -> w (a, b, c, d)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` d
d
  toConstr :: Proxy ctx -> (a, b, c, d) -> Constr
toConstr Proxy ctx
_ (a, b, c, d)
_ = Constr
tuple4Constr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (a, b, c, d)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> c (d -> (a, b, c, d)) -> c (a, b, c, d)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (c -> d -> (a, b, c, d)) -> c (d -> (a, b, c, d))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (b -> c -> d -> (a, b, c, d)) -> c (c -> d -> (a, b, c, d))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> b -> c -> d -> (a, b, c, d))
-> c (b -> c -> d -> (a, b, c, d))
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> b -> c -> d -> (a, b, c, d))
-> c (a -> b -> c -> d -> (a, b, c, d))
forall r. r -> c r
z (,,,)))))
                      ConIndex
_ -> String -> c (a, b, c, d)
forall a. HasCallStack => String -> a
error String
"gunfold (,,,)"
  dataTypeOf :: Proxy ctx -> (a, b, c, d) -> DataType
dataTypeOf Proxy ctx
_ (a, b, c, d)
_ = DataType
tuple4DataType


------------------------------------------------------------------------------


tuple5Constr :: Constr
tuple5Constr :: Constr
tuple5Constr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tuple5DataType String
"(,,,,)" [] Fixity
Infix
tuple5DataType :: DataType
tuple5DataType :: DataType
tuple5DataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.(,,,,)" [Constr
tuple5Constr]

instance (Sat (ctx (a,b,c,d,e)), Data ctx a, Data ctx b, Data ctx c, Data ctx d, Data ctx e) =>
          Data ctx (a,b,c,d,e) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> (a, b, c, d, e)
-> w (a, b, c, d, e)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (a
a,b
b,c
c,d
d,e
e) = (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> w (a -> b -> c -> d -> e -> (a, b, c, d, e))
forall g. g -> w g
z (,,,,) w (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> a -> w (b -> c -> d -> e -> (a, b, c, d, e))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
a w (b -> c -> d -> e -> (a, b, c, d, e))
-> b -> w (c -> d -> e -> (a, b, c, d, e))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` b
b w (c -> d -> e -> (a, b, c, d, e))
-> c -> w (d -> e -> (a, b, c, d, e))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` c
c w (d -> e -> (a, b, c, d, e)) -> d -> w (e -> (a, b, c, d, e))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` d
d w (e -> (a, b, c, d, e)) -> e -> w (a, b, c, d, e)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` e
e
  toConstr :: Proxy ctx -> (a, b, c, d, e) -> Constr
toConstr Proxy ctx
_ (a, b, c, d, e)
_ = Constr
tuple5Constr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (a, b, c, d, e)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> c (e -> (a, b, c, d, e)) -> c (a, b, c, d, e)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (d -> e -> (a, b, c, d, e)) -> c (e -> (a, b, c, d, e))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (c -> d -> e -> (a, b, c, d, e)) -> c (d -> e -> (a, b, c, d, e))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (b -> c -> d -> e -> (a, b, c, d, e))
-> c (c -> d -> e -> (a, b, c, d, e))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> c (b -> c -> d -> e -> (a, b, c, d, e))
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> b -> c -> d -> e -> (a, b, c, d, e))
-> c (a -> b -> c -> d -> e -> (a, b, c, d, e))
forall r. r -> c r
z (,,,,))))))
                      ConIndex
_ -> String -> c (a, b, c, d, e)
forall a. HasCallStack => String -> a
error String
"gunfold (,,,,)"
  dataTypeOf :: Proxy ctx -> (a, b, c, d, e) -> DataType
dataTypeOf Proxy ctx
_ (a, b, c, d, e)
_ = DataType
tuple5DataType


------------------------------------------------------------------------------


tuple6Constr :: Constr
tuple6Constr :: Constr
tuple6Constr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tuple6DataType String
"(,,,,,)" [] Fixity
Infix
tuple6DataType :: DataType
tuple6DataType :: DataType
tuple6DataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.(,,,,,)" [Constr
tuple6Constr]

instance (Sat (ctx (a,b,c,d,e,f)), Data ctx a, Data ctx b, Data ctx c, Data ctx d, Data ctx e, Data ctx f) =>
          Data ctx (a,b,c,d,e,f) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> (a, b, c, d, e, f)
-> w (a, b, c, d, e, f)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (a
a,b
b,c
c,d
d,e
e,f
f') = (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> w (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall g. g -> w g
z (,,,,,) w (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> a -> w (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
a w (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> b -> w (c -> d -> e -> f -> (a, b, c, d, e, f))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` b
b w (c -> d -> e -> f -> (a, b, c, d, e, f))
-> c -> w (d -> e -> f -> (a, b, c, d, e, f))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` c
c w (d -> e -> f -> (a, b, c, d, e, f))
-> d -> w (e -> f -> (a, b, c, d, e, f))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` d
d w (e -> f -> (a, b, c, d, e, f))
-> e -> w (f -> (a, b, c, d, e, f))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` e
e w (f -> (a, b, c, d, e, f)) -> f -> w (a, b, c, d, e, f)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` f
f'
  toConstr :: Proxy ctx -> (a, b, c, d, e, f) -> Constr
toConstr Proxy ctx
_ (a, b, c, d, e, f)
_ = Constr
tuple6Constr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (a, b, c, d, e, f)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> c (f -> (a, b, c, d, e, f)) -> c (a, b, c, d, e, f)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (e -> f -> (a, b, c, d, e, f)) -> c (f -> (a, b, c, d, e, f))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (d -> e -> f -> (a, b, c, d, e, f))
-> c (e -> f -> (a, b, c, d, e, f))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (c -> d -> e -> f -> (a, b, c, d, e, f))
-> c (d -> e -> f -> (a, b, c, d, e, f))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> c (c -> d -> e -> f -> (a, b, c, d, e, f))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> c (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> c (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall r. r -> c r
z (,,,,,)))))))
                      ConIndex
_ -> String -> c (a, b, c, d, e, f)
forall a. HasCallStack => String -> a
error String
"gunfold (,,,,,)"
  dataTypeOf :: Proxy ctx -> (a, b, c, d, e, f) -> DataType
dataTypeOf Proxy ctx
_ (a, b, c, d, e, f)
_ = DataType
tuple6DataType


------------------------------------------------------------------------------


tuple7Constr :: Constr
tuple7Constr :: Constr
tuple7Constr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tuple7DataType String
"(,,,,,,)" [] Fixity
Infix
tuple7DataType :: DataType
tuple7DataType :: DataType
tuple7DataType = String -> [Constr] -> DataType
mkDataType String
"Prelude.(,,,,,,)" [Constr
tuple7Constr]

instance (Sat (ctx (a,b,c,d,e,f,g)), Data ctx a, Data ctx b, Data ctx c, Data ctx d, Data ctx e, Data ctx f, Data ctx g) =>
          Data ctx (a,b,c,d,e,f,g) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> (a, b, c, d, e, f, g)
-> w (a, b, c, d, e, f, g)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z (a
a,b
b,c
c,d
d,e
e,f
f',g
g) =
    (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> w (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall g. g -> w g
z (,,,,,,) w (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> a -> w (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
a w (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> b -> w (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` b
b w (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> c -> w (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` c
c w (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> d -> w (e -> f -> g -> (a, b, c, d, e, f, g))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` d
d w (e -> f -> g -> (a, b, c, d, e, f, g))
-> e -> w (f -> g -> (a, b, c, d, e, f, g))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` e
e w (f -> g -> (a, b, c, d, e, f, g))
-> f -> w (g -> (a, b, c, d, e, f, g))
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` f
f' w (g -> (a, b, c, d, e, f, g)) -> g -> w (a, b, c, d, e, f, g)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` g
g
  toConstr :: Proxy ctx -> (a, b, c, d, e, f, g) -> Constr
toConstr Proxy ctx
_ (a, b, c, d, e, f, g)
_ = Constr
tuple7Constr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (a, b, c, d, e, f, g)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> c (g -> (a, b, c, d, e, f, g)) -> c (a, b, c, d, e, f, g)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (f -> g -> (a, b, c, d, e, f, g))
-> c (g -> (a, b, c, d, e, f, g))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (e -> f -> g -> (a, b, c, d, e, f, g))
-> c (f -> g -> (a, b, c, d, e, f, g))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> c (e -> f -> g -> (a, b, c, d, e, f, g))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> c (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> c (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> c (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> c (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall r. r -> c r
z (,,,,,,))))))))
                      ConIndex
_ -> String -> c (a, b, c, d, e, f, g)
forall a. HasCallStack => String -> a
error String
"gunfold (,,,,,,)"
  dataTypeOf :: Proxy ctx -> (a, b, c, d, e, f, g) -> DataType
dataTypeOf Proxy ctx
_ (a, b, c, d, e, f, g)
_ = DataType
tuple7DataType


------------------------------------------------------------------------------


instance Sat (ctx TypeRep) =>
         Data ctx TypeRep where
  toConstr :: Proxy ctx -> TypeRep -> Constr
toConstr Proxy ctx
_ TypeRep
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c TypeRep
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c TypeRep
forall a. HasCallStack => String -> a
error String
"gunfold TypeRep"
  dataTypeOf :: Proxy ctx -> TypeRep -> DataType
dataTypeOf Proxy ctx
_ TypeRep
_ = String -> DataType
mkNorepType String
"Data.Typeable.TypeRep"


------------------------------------------------------------------------------


instance Sat (ctx TyCon) =>
         Data ctx TyCon where
  toConstr :: Proxy ctx -> TyCon -> Constr
toConstr Proxy ctx
_ TyCon
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c TyCon
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c TyCon
forall a. HasCallStack => String -> a
error String
"gunfold TyCon"
  dataTypeOf :: Proxy ctx -> TyCon -> DataType
dataTypeOf Proxy ctx
_ TyCon
_ = String -> DataType
mkNorepType String
"Data.Typeable.TyCon"


------------------------------------------------------------------------------


-- INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType")
#if MIN_VERSION_base(4,7,0)
deriving instance Typeable DataType
#else
#ifndef __HADDOCK__
$(deriveTypeable [''DataType])
#endif
#endif

instance Sat (ctx DataType) =>
         Data ctx DataType where
  toConstr :: Proxy ctx -> DataType -> Constr
toConstr Proxy ctx
_ DataType
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c DataType
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c DataType
forall a. HasCallStack => String -> a
error String
"gunfold DataType"
  dataTypeOf :: Proxy ctx -> DataType -> DataType
dataTypeOf Proxy ctx
_ DataType
_ = String -> DataType
mkNorepType String
"Data.Generics.Basics.DataType"


------------------------------------------------------------------------------


instance (Sat (ctx (IO a)), Typeable a) =>
          Data ctx (IO a) where
  toConstr :: Proxy ctx -> IO a -> Constr
toConstr Proxy ctx
_ IO a
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (IO a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (IO a)
forall a. HasCallStack => String -> a
error String
"gunfold IO"
  dataTypeOf :: Proxy ctx -> IO a -> DataType
dataTypeOf Proxy ctx
_ IO a
_ = String -> DataType
mkNorepType String
"GHC.IOBase.IO"


------------------------------------------------------------------------------


instance Sat (ctx Handle) =>
         Data ctx Handle where
  toConstr :: Proxy ctx -> Handle -> Constr
toConstr Proxy ctx
_ Handle
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c Handle
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c Handle
forall a. HasCallStack => String -> a
error String
"gunfold Handle"
  dataTypeOf :: Proxy ctx -> Handle -> DataType
dataTypeOf Proxy ctx
_ Handle
_ = String -> DataType
mkNorepType String
"GHC.IOBase.Handle"


------------------------------------------------------------------------------


instance (Sat (ctx (Ptr a)), Typeable a) =>
          Data ctx (Ptr a) where
  toConstr :: Proxy ctx -> Ptr a -> Constr
toConstr Proxy ctx
_ Ptr a
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Ptr a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (Ptr a)
forall a. HasCallStack => String -> a
error String
"gunfold Ptr"
  dataTypeOf :: Proxy ctx -> Ptr a -> DataType
dataTypeOf Proxy ctx
_ Ptr a
_ = String -> DataType
mkNorepType String
"GHC.Ptr.Ptr"


------------------------------------------------------------------------------


instance (Sat (ctx (StablePtr a)), Typeable a) =>
          Data ctx (StablePtr a) where
  toConstr :: Proxy ctx -> StablePtr a -> Constr
toConstr Proxy ctx
_ StablePtr a
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (StablePtr a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (StablePtr a)
forall a. HasCallStack => String -> a
error String
"gunfold StablePtr"
  dataTypeOf :: Proxy ctx -> StablePtr a -> DataType
dataTypeOf Proxy ctx
_ StablePtr a
_ = String -> DataType
mkNorepType String
"GHC.Stable.StablePtr"


------------------------------------------------------------------------------


instance (Sat (ctx (IORef a)), Typeable a) =>
          Data ctx (IORef a) where
  toConstr :: Proxy ctx -> IORef a -> Constr
toConstr Proxy ctx
_ IORef a
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (IORef a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (IORef a)
forall a. HasCallStack => String -> a
error String
"gunfold IORef"
  dataTypeOf :: Proxy ctx -> IORef a -> DataType
dataTypeOf Proxy ctx
_ IORef a
_ = String -> DataType
mkNorepType String
"GHC.IOBase.IORef"


------------------------------------------------------------------------------


instance (Sat (ctx (ForeignPtr a)), Typeable a) =>
          Data ctx (ForeignPtr a) where
  toConstr :: Proxy ctx -> ForeignPtr a -> Constr
toConstr Proxy ctx
_ ForeignPtr a
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (ForeignPtr a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (ForeignPtr a)
forall a. HasCallStack => String -> a
error String
"gunfold ForeignPtr"
  dataTypeOf :: Proxy ctx -> ForeignPtr a -> DataType
dataTypeOf Proxy ctx
_ ForeignPtr a
_ = String -> DataType
mkNorepType String
"GHC.ForeignPtr.ForeignPtr"


------------------------------------------------------------------------------


instance (Sat (ctx (ST s a)), Typeable s, Typeable a) =>
          Data ctx (ST s a) where
  toConstr :: Proxy ctx -> ST s a -> Constr
toConstr Proxy ctx
_ ST s a
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (ST s a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (ST s a)
forall a. HasCallStack => String -> a
error String
"gunfold ST"
  dataTypeOf :: Proxy ctx -> ST s a -> DataType
dataTypeOf Proxy ctx
_ ST s a
_ = String -> DataType
mkNorepType String
"GHC.ST.ST"


------------------------------------------------------------------------------

{-
instance Sat (ctx ThreadId) =>
         Data ctx ThreadId where
  toConstr _ _   = error "toConstr"
  gunfold _ _ _  = error "gunfold ThreadId"
  dataTypeOf _ _ = mkNorepType "GHC.Conc.ThreadId"


------------------------------------------------------------------------------


instance (Sat (ctx (TVar a)), Typeable a) =>
          Data ctx (TVar a) where
  toConstr _ _   = error "toConstr"
  gunfold _ _ _  = error "gunfold TVar"
  dataTypeOf _ _ = mkNorepType "GHC.Conc.TVar"-}


------------------------------------------------------------------------------


instance (Sat (ctx (MVar a)), Typeable a) =>
          Data ctx (MVar a) where
  toConstr :: Proxy ctx -> MVar a -> Constr
toConstr Proxy ctx
_ MVar a
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (MVar a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (MVar a)
forall a. HasCallStack => String -> a
error String
"gunfold MVar"
  dataTypeOf :: Proxy ctx -> MVar a -> DataType
dataTypeOf Proxy ctx
_ MVar a
_ = String -> DataType
mkNorepType String
"GHC.Conc.MVar"


------------------------------------------------------------------------------


{-instance (Sat (ctx (STM a)), Typeable a) =>
          Data ctx (STM a) where
  toConstr _ _   = error "toConstr"
  gunfold _ _ _  = error "gunfold STM"
  dataTypeOf _ _ = mkNorepType "GHC.Conc.STM"-}


------------------------------------------------------------------------------
-- The following instances were adapted from various modules within the Data
-- namespace. Until GHC takes onboard SYB3, they'll have to stay in here.
------------------------------------------------------------------------------

instance (Sat (ctx [b]), Sat (ctx (Array a b)), Typeable a, Data ctx b, Data ctx [b], Ix a) =>
          Data ctx (Array a b) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> Array a b
-> w (Array a b)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z Array a b
a = ([b] -> Array a b) -> w ([b] -> Array a b)
forall g. g -> w g
z ((a, a) -> [b] -> Array a b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array a b -> (a, a)
forall i e. Array i e -> (i, i)
bounds Array a b
a)) w ([b] -> Array a b) -> [b] -> w (Array a b)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` (Array a b -> [b]
forall i e. Array i e -> [e]
elems Array a b
a)
  toConstr :: Proxy ctx -> Array a b -> Constr
toConstr Proxy ctx
_ Array a b
_   = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Array a b)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (Array a b)
forall a. HasCallStack => String -> a
error String
"gunfold Array"
  dataTypeOf :: Proxy ctx -> Array a b -> DataType
dataTypeOf Proxy ctx
_ Array a b
_ = String -> DataType
mkNorepType String
"Data.Array.Array"

------------------------------------------------------------------------------


emptyMapConstr :: Constr
emptyMapConstr :: Constr
emptyMapConstr     = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
mapDataType String
"empty"  [] Fixity
Prefix
insertMapConstr :: Constr
insertMapConstr :: Constr
insertMapConstr    = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
mapDataType String
"insert" [] Fixity
Prefix
mapDataType :: DataType
mapDataType :: DataType
mapDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Map.Map" [Constr
emptyMapConstr,Constr
insertMapConstr]

instance (Sat (ctx (M.Map a b)), Data ctx a, Data ctx b, Ord a) =>
          Data ctx (M.Map a b) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> Map a b
-> w (Map a b)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z Map a b
m = case Map a b -> Maybe ((a, b), Map a b)
forall k a. Map k a -> Maybe ((k, a), Map k a)
M.minViewWithKey Map a b
m of
                     Maybe ((a, b), Map a b)
Nothing -> Map a b -> w (Map a b)
forall g. g -> w g
z Map a b
forall k a. Map k a
M.empty
                     Just ((a
k,b
a),Map a b
m') -> (a -> b -> Map a b -> Map a b) -> w (a -> b -> Map a b -> Map a b)
forall g. g -> w g
z a -> b -> Map a b -> Map a b
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert w (a -> b -> Map a b -> Map a b)
-> a -> w (b -> Map a b -> Map a b)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
k w (b -> Map a b -> Map a b) -> b -> w (Map a b -> Map a b)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` b
a w (Map a b -> Map a b) -> Map a b -> w (Map a b)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` Map a b
m' 
  toConstr :: Proxy ctx -> Map a b -> Constr
toConstr Proxy ctx
_ Map a b
m | Map a b -> ConIndex
forall k a. Map k a -> ConIndex
M.size Map a b
m ConIndex -> ConIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ConIndex
0 = Constr
emptyMapConstr
               | Bool
otherwise     = Constr
insertMapConstr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Map a b)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> Map a b -> c (Map a b)
forall r. r -> c r
z Map a b
forall k a. Map k a
M.empty
                      ConIndex
2 -> c (Map a b -> Map a b) -> c (Map a b)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (b -> Map a b -> Map a b) -> c (Map a b -> Map a b)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> b -> Map a b -> Map a b) -> c (b -> Map a b -> Map a b)
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> b -> Map a b -> Map a b) -> c (a -> b -> Map a b -> Map a b)
forall r. r -> c r
z a -> b -> Map a b -> Map a b
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert)))
                      ConIndex
_ -> String -> c (Map a b)
forall a. HasCallStack => String -> a
error String
"gunfold Map"
  dataTypeOf :: Proxy ctx -> Map a b -> DataType
dataTypeOf Proxy ctx
_ Map a b
_ = DataType
mapDataType
  dataCast2 :: Proxy ctx
-> (forall b c. (Data ctx b, Data ctx c) => w (t b c))
-> Maybe (w (Map a b))
dataCast2 Proxy ctx
_ forall b c. (Data ctx b, Data ctx c) => w (t b c)
f  = w (t a b) -> Maybe (w (Map a b))
forall k1 k2 k3 (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 w (t a b)
forall b c. (Data ctx b, Data ctx c) => w (t b c)
f

------------------------------------------------------------------------------


emptySetConstr :: Constr
emptySetConstr :: Constr
emptySetConstr     = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
mapDataType String
"empty"  [] Fixity
Prefix
insertSetConstr :: Constr
insertSetConstr :: Constr
insertSetConstr    = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
mapDataType String
"insert" [] Fixity
Prefix
setDataType :: DataType
setDataType :: DataType
setDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Set.Set" [Constr
emptySetConstr,Constr
insertSetConstr]

instance (Sat (ctx (S.Set a)), Data ctx a, Ord a) =>
          Data ctx (S.Set a ) where
  gfoldl :: Proxy ctx
-> (forall b c. Data ctx b => w (b -> c) -> b -> w c)
-> (forall g. g -> w g)
-> Set a
-> w (Set a)
gfoldl Proxy ctx
_ forall b c. Data ctx b => w (b -> c) -> b -> w c
f forall g. g -> w g
z Set a
s = case Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
S.minView Set a
s of
                     Maybe (a, Set a)
Nothing -> Set a -> w (Set a)
forall g. g -> w g
z Set a
forall a. Set a
S.empty
                     Just (a
a,Set a
s') -> (a -> Set a -> Set a) -> w (a -> Set a -> Set a)
forall g. g -> w g
z a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert w (a -> Set a -> Set a) -> a -> w (Set a -> Set a)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` a
a w (Set a -> Set a) -> Set a -> w (Set a)
forall b c. Data ctx b => w (b -> c) -> b -> w c
`f` Set a
s' 
  toConstr :: Proxy ctx -> Set a -> Constr
toConstr Proxy ctx
_ Set a
m | Set a -> ConIndex
forall a. Set a -> ConIndex
S.size Set a
m ConIndex -> ConIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ConIndex
0 = Constr
emptySetConstr
               | Bool
otherwise     = Constr
insertSetConstr
  gunfold :: Proxy ctx
-> (forall b r. Data ctx b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c (Set a)
gunfold Proxy ctx
_ forall b r. Data ctx b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> ConIndex
constrIndex Constr
c of
                      ConIndex
1 -> Set a -> c (Set a)
forall r. r -> c r
z Set a
forall a. Set a
S.empty
                      ConIndex
2 -> c (Set a -> Set a) -> c (Set a)
forall b r. Data ctx b => c (b -> r) -> c r
k (c (a -> Set a -> Set a) -> c (Set a -> Set a)
forall b r. Data ctx b => c (b -> r) -> c r
k ((a -> Set a -> Set a) -> c (a -> Set a -> Set a)
forall r. r -> c r
z a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert))
                      ConIndex
_ -> String -> c (Set a)
forall a. HasCallStack => String -> a
error String
"gunfold Set"
  dataTypeOf :: Proxy ctx -> Set a -> DataType
dataTypeOf Proxy ctx
_ Set a
_ = DataType
setDataType
  dataCast1 :: Proxy ctx -> (forall b. Data ctx b => w (t b)) -> Maybe (w (Set a))
dataCast1 Proxy ctx
_ forall b. Data ctx b => w (t b)
f  = w (t a) -> Maybe (w (Set a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 w (t a)
forall b. Data ctx b => w (t b)
f

------------------------------------------------------------------------------

$( deriveData [''ByteString] )
$( deriveData [''L.ByteString] )