syb-with-class (empty) → 0.1
raw patch · 6 files changed
+1594/−0 lines, 6 filesdep +basedep +template-haskellbuild-type:Customsetup-changed
Dependencies added: base, template-haskell
Files
- Data/Generics/SYB/WithClass/Basics.hs +488/−0
- Data/Generics/SYB/WithClass/Context.hs +57/−0
- Data/Generics/SYB/WithClass/Derive.hs +347/−0
- Data/Generics/SYB/WithClass/Instances.hs +670/−0
- Setup.hs +8/−0
- syb-with-class.cabal +24/−0
+ Data/Generics/SYB/WithClass/Basics.hs view
@@ -0,0 +1,488 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances, Rank2Types #-}++{-++(C) 2004--2005 Ralf Laemmel, Simon D. Foster++This module approximates Data.Generics.Basics.++-}+++module Data.Generics.SYB.WithClass.Basics (++ module Data.Typeable,+ module Data.Generics.SYB.WithClass.Context,+ module Data.Generics.SYB.WithClass.Basics++) where++import Data.Typeable+import Data.Generics.SYB.WithClass.Context+++data Proxy (a :: * -> *)++------------------------------------------------------------------------------+-- The ingenious Data class++class (Typeable a, Sat (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++ -- Default definition for gfoldl+ -- which copes immediately with basic datatypes+ --+ gfoldl _ _ z = z++ gunfold :: Proxy ctx+ -> (forall b r. Data ctx b => c (b -> r) -> c r)+ -> (forall r. r -> c r)+ -> Constr+ -> c a++ toConstr :: Proxy ctx -> a -> Constr++ dataTypeOf :: Proxy ctx -> a -> DataType++ -- incomplete implementation++ gunfold _ _ _ _ = undefined++ dataTypeOf _ _ = undefined++ -- | Mediate types and unary type constructors+ dataCast1 :: Typeable1 t+ => Proxy ctx+ -> (forall b. Data ctx b => w (t b))+ -> Maybe (w a)+ dataCast1 _ _ = Nothing++ -- | Mediate types and binary type constructors+ dataCast2 :: Typeable2 t+ => Proxy ctx+ -> (forall b c. (Data ctx b, Data ctx c) => w (t b c))+ -> Maybe (w a)+ dataCast2 _ _ = Nothing++++------------------------------------------------------------------------------++-- Generic transformations++type GenericT ctx = forall a. Data ctx a => a -> a+++-- Generic map for transformations++gmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx++gmapT ctx f x = unID (gfoldl ctx k ID x)+ where+ k (ID g) y = ID (g (f y))+++-- The identity type constructor++newtype ID x = ID { unID :: x }+++------------------------------------------------------------------------------++-- Generic monadic transformations++type GenericM m ctx = forall a. Data ctx a => a -> m a++-- Generic map for monadic transformations++gmapM :: Monad m => Proxy ctx -> GenericM m ctx -> GenericM m ctx+gmapM ctx f = gfoldl ctx k return+ where k c x = do c' <- c+ x' <- f x+ return (c' x')+++------------------------------------------------------------------------------++-- Generic queries++type GenericQ ctx r = forall a. Data ctx a => a -> r+++-- Map for queries++gmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r]+gmapQ ctx f = gmapQr ctx (:) [] f++gmapQr :: Data ctx a+ => Proxy ctx+ -> (r' -> r -> r)+ -> r+ -> GenericQ ctx r'+ -> a+ -> r+gmapQr ctx o r f x = unQr (gfoldl ctx k (const (Qr id)) x) r+ where+ k (Qr g) y = Qr (\s -> g (f y `o` s))++-- The type constructor used in definition of gmapQr+newtype Qr r a = Qr { unQr :: r -> r }++++------------------------------------------------------------------------------+--+-- Generic unfolding+--+------------------------------------------------------------------------------++++-- | Build a term skeleton+fromConstr :: Data ctx a => Proxy ctx -> Constr -> a+fromConstr ctx = fromConstrB ctx undefined++-- | Build a term and use a generic function for subterms+fromConstrB :: Data ctx a+ => Proxy ctx+ -> (forall b. Data ctx b => b)+ -> Constr+ -> a+fromConstrB ctx f = unID . gunfold ctx k z+ where+ k c = ID (unID c f)+ z = ID++++-- | Monadic variation on \"fromConstrB\"+fromConstrM :: (Monad m, Data ctx a)+ => Proxy ctx+ -> (forall b. Data ctx b => m b)+ -> Constr+ -> m a+fromConstrM ctx f = gunfold ctx k z+ where+ k c = do { c' <- c; b <- f; return (c' b) }+ z = return++++------------------------------------------------------------------------------+--+-- Datatype and constructor representations+--+------------------------------------------------------------------------------+++--+-- | Representation of datatypes.+-- | A package of constructor representations with names of type and module.+-- | The list of constructors could be an array, a balanced tree, or others.+--+data DataType = DataType+ { tycon :: String+ , datarep :: DataRep+ }++ deriving Show+++-- | Representation of constructors+data Constr = Constr+ { conrep :: ConstrRep+ , constring :: String+ , confields :: [String] -- for AlgRep only+ , confixity :: Fixity -- for AlgRep only+ , datatype :: DataType+ }++instance Show Constr where+ show = constring+++-- | Equality of constructors+instance Eq Constr where+ c == c' = constrRep c == constrRep c'+++-- | Public representation of datatypes+data DataRep = AlgRep [Constr]+ | IntRep+ | FloatRep+ | StringRep+ | NoRep++ deriving (Eq,Show)+++-- | Public representation of constructors+data ConstrRep = AlgConstr ConIndex+ | IntConstr Integer+ | FloatConstr Double+ | StringConstr String++ deriving (Eq,Show)+++--+-- | Unique index for datatype constructors.+-- | Textual order is respected. Starts at 1.+--+type ConIndex = Int+++-- | Fixity of constructors+data Fixity = Prefix+ | Infix -- Later: add associativity and precedence++ deriving (Eq,Show)+++------------------------------------------------------------------------------+--+-- Observers for datatype representations+--+------------------------------------------------------------------------------+++-- | Gets the type constructor including the module+dataTypeName :: DataType -> String+dataTypeName = tycon++++-- | Gets the public presentation of datatypes+dataTypeRep :: DataType -> DataRep+dataTypeRep = datarep+++-- | Gets the datatype of a constructor+constrType :: Constr -> DataType+constrType = datatype+++-- | Gets the public presentation of constructors+constrRep :: Constr -> ConstrRep+constrRep = conrep+++-- | Look up a constructor by its representation+repConstr :: DataType -> ConstrRep -> Constr+repConstr dt cr =+ case (dataTypeRep dt, cr) of+ (AlgRep cs, AlgConstr i) -> cs !! (i-1)+ (IntRep, IntConstr i) -> mkIntConstr dt i+ (FloatRep, FloatConstr f) -> mkFloatConstr dt f+ (StringRep, StringConstr str) -> mkStringConstr dt str+ _ -> error "repConstr"++++------------------------------------------------------------------------------+--+-- Representations of algebraic data types+--+------------------------------------------------------------------------------+++-- | Constructs an algebraic datatype+mkDataType :: String -> [Constr] -> DataType+mkDataType str cs = DataType+ { tycon = str+ , datarep = AlgRep cs+ }+++-- | Constructs a constructor+mkConstr :: DataType -> String -> [String] -> Fixity -> Constr+mkConstr dt str fields fix =+ Constr+ { conrep = AlgConstr idx+ , constring = str+ , confields = fields+ , confixity = fix+ , datatype = dt+ }+ where+ idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],+ showConstr c == str ]+++-- | Gets the constructors+dataTypeConstrs :: DataType -> [Constr]+dataTypeConstrs dt = case datarep dt of+ (AlgRep cons) -> cons+ _ -> error "dataTypeConstrs"+++-- | Gets the field labels of a constructor+constrFields :: Constr -> [String]+constrFields = confields+++-- | Gets the fixity of a constructor+constrFixity :: Constr -> Fixity+constrFixity = confixity++++------------------------------------------------------------------------------+--+-- From strings to constr's and vice versa: all data types+--+------------------------------------------------------------------------------+++-- | Gets the string for a constructor+showConstr :: Constr -> String+showConstr = constring+++-- | Lookup a constructor via a string+readConstr :: DataType -> String -> Maybe Constr+readConstr dt str =+ case dataTypeRep dt of+ AlgRep cons -> idx cons+ IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))+ FloatRep -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))+ StringRep -> Just (mkStringConstr dt str)+ NoRep -> Nothing+ where++ -- Read a value and build a constructor+ mkReadCon :: Read t => (t -> Constr) -> Maybe Constr+ mkReadCon f = case (reads str) of+ [(t,"")] -> Just (f t)+ _ -> Nothing++ -- Traverse list of algebraic datatype constructors+ idx :: [Constr] -> Maybe Constr+ idx cons = let fit = filter ((==) str . showConstr) cons+ in if fit == []+ then Nothing+ else Just (head fit)+++------------------------------------------------------------------------------+--+-- Convenience funtions: algebraic data types+--+------------------------------------------------------------------------------+++-- | Test for an algebraic type+isAlgType :: DataType -> Bool+isAlgType dt = case datarep dt of+ (AlgRep _) -> True+ _ -> False+++-- | Gets the constructor for an index+indexConstr :: DataType -> ConIndex -> Constr+indexConstr dt idx = case datarep dt of+ (AlgRep cs) -> cs !! (idx-1)+ _ -> error "indexConstr"+++-- | Gets the index of a constructor+constrIndex :: Constr -> ConIndex+constrIndex con = case constrRep con of+ (AlgConstr idx) -> idx+ _ -> error "constrIndex"+++-- | Gets the maximum constructor index+maxConstrIndex :: DataType -> ConIndex+maxConstrIndex dt = case dataTypeRep dt of+ AlgRep cs -> length cs+ _ -> error "maxConstrIndex"++++------------------------------------------------------------------------------+--+-- Representation of primitive types+--+------------------------------------------------------------------------------+++-- | Constructs the Int type+mkIntType :: String -> DataType+mkIntType = mkPrimType IntRep+++-- | Constructs the Float type+mkFloatType :: String -> DataType+mkFloatType = mkPrimType FloatRep+++-- | Constructs the String type+mkStringType :: String -> DataType+mkStringType = mkPrimType StringRep+++-- | Helper for mkIntType, mkFloatType, mkStringType+mkPrimType :: DataRep -> String -> DataType+mkPrimType dr str = DataType+ { tycon = str+ , datarep = dr+ }+++-- Makes a constructor for primitive types+mkPrimCon :: DataType -> String -> ConstrRep -> Constr+mkPrimCon dt str cr = Constr+ { datatype = dt+ , conrep = cr+ , constring = str+ , confields = error $ concat ["constrFields : ", (tycon dt), " is primative"]+ , confixity = error "constrFixity"+ }+++mkIntConstr :: DataType -> Integer -> Constr+mkIntConstr dt i = case datarep dt of+ IntRep -> mkPrimCon dt (show i) (IntConstr i)+ _ -> error "mkIntConstr"+++mkFloatConstr :: DataType -> Double -> Constr+mkFloatConstr dt f = case datarep dt of+ FloatRep -> mkPrimCon dt (show f) (FloatConstr f)+ _ -> error "mkFloatConstr"+++mkStringConstr :: DataType -> String -> Constr+mkStringConstr dt str = case datarep dt of+ StringRep -> mkPrimCon dt str (StringConstr str)+ _ -> error "mkStringConstr"+++------------------------------------------------------------------------------+--+-- Non-representations for non-presentable types+--+------------------------------------------------------------------------------+++-- | Constructs a non-representation+mkNorepType :: String -> DataType+mkNorepType str = DataType+ { tycon = str+ , datarep = NoRep+ }+++-- | Test for a non-representable type+isNorepType :: DataType -> Bool+isNorepType dt = case datarep dt of+ NoRep -> True+ _ -> False+
+ Data/Generics/SYB/WithClass/Context.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances, EmptyDataDecls #-}++{-++(C) 2004 Ralf Laemmel++Context parameterisation and context passing.++-}+++module Data.Generics.SYB.WithClass.Context++where++------------------------------------------------------------------------------++--+-- The Sat class from John Hughes' "Restricted Data Types in Haskell"+--++class Sat a+ where+ dict :: a+++------------------------------------------------------------------------------++-- No context++data NoCtx a++noCtx :: NoCtx ()+noCtx = undefined++instance Sat (NoCtx a) where dict = undefined+++------------------------------------------------------------------------------++-- Pair context++data PairCtx l r a+ = PairCtx { leftCtx :: l a+ , rightCtx :: r a }++pairCtx :: l () -> r () -> PairCtx l r ()+pairCtx _ _ = undefined++instance (Sat (l a), Sat (r a))+ => Sat (PairCtx l r a)+ where+ dict = PairCtx { leftCtx = dict+ , rightCtx = dict }+++------------------------------------------------------------------------------
+ Data/Generics/SYB/WithClass/Derive.hs view
@@ -0,0 +1,347 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+-- We can't warn about missing sigs as we have a group of decls in+-- quasi-quotes that we're going to put in a class instance++--+-- Ulf Norell, 2004+-- Started this module.+--+-- Sean Seefried, 2004+-- Extension for data definitions with type variables; comments added.+-- http://www.haskell.org/pipermail/template-haskell/2005-January/000393.html+--+-- Simon D. Foster, 2004--2005+-- Extended to work with SYB3.+--+-- Ralf Lammel, 2005+-- Integrated with SYB3 source distribution.+--++module Data.Generics.SYB.WithClass.Derive where++import Language.Haskell.TH+import Data.List+import Data.Char+import Control.Monad+import Data.Maybe+import Data.Generics.SYB.WithClass.Basics++-- maximum type paramters for a Typeable instance+maxTypeParams :: Int+maxTypeParams = 7+++--+-- | Takes the name of an algebraic data type, the number of type parameters+-- it has and creates a Typeable instance for it.+deriveTypeablePrim :: Name -> Int -> Q [Dec]+deriveTypeablePrim name nParam+ | nParam <= maxTypeParams =+ sequence+ [ instanceD (return [])+ (conT typeableName `appT` conT name)+ [ funD typeOfName [clause [wildP] (normalB+ [| mkTyConApp (mkTyCon $(litE $ stringL (nameBase name))) [] |]) []]+ ]+ ]+ | otherwise = error ("Typeable classes can only have a maximum of " +++ show maxTypeParams ++ " parameters")+ where+ typeableName+ | nParam == 0 = mkName "Typeable"+ | otherwise = mkName ("Typeable" ++ show nParam)+ typeOfName+ | nParam == 0 = mkName "typeOf"+ | otherwise = mkName ("typeOf" ++ show nParam)++--+-- | Takes a name of a algebraic data type, the number of parameters it+-- has and a list of constructor pairs. Each one of these constructor+-- pairs consists of a constructor name and the number of type+-- parameters it has. The function returns an automatically generated+-- instance declaration for the Data class.+--+-- Doesn't do gunfold, dataCast1 or dataCast2+deriveDataPrim :: Name -> [Type] -> [(Name, Int)] -> [(Name, [(Maybe Name, Type)])] -> Q [Dec]+deriveDataPrim name typeParams cons terms =+ do sequence (+ conDecs ++++ [ dataTypeDec+ , instanceD context (dataCxt myType)+ [ funD 'gfoldl+ [ clause ([wildP] ++ (map (varP . mkName) ["f", "z", "x"]))+ (normalB $ caseE (varE (mkName "x")) (map mkMatch cons))+ []+ ]+ , funD 'gunfold+ [clause ([wildP] ++ (map (varP. mkName) ["k", "z", "c"]))+ (if (null cons) then (normalB [| error "gunfold : Type has no constructors" |])+ else (normalB $ caseE (varE (mkName "constrIndex") `appE` varE (mkName "c")) mkMatches)) []]+ , funD 'toConstr+ [ clause [wildP, varP (mkName "x")]+ (normalB $ caseE (varE (mkName "x"))+ (zipWith mkSel cons conVarExps))+ []+ ]+ , funD 'dataTypeOf+ [ clause [wildP, wildP] (normalB $ varE (mkName theDataTypeName)) []+ ]+ ]+ ])+ where+ types = filter (\x -> case x of (VarT _) -> False; _ -> True) $ map snd $ concat $ map snd terms+ fieldNames = let fs = map (map fst.snd) terms in+ map (\x -> if (null x || all isNothing x) then [] else map (maybe "" show) x) fs+ nParam = length typeParams++{- paramNames = take nParam (zipWith (++) (repeat "a") (map show [0..]))+ typeQParams = map (\nm -> varT (mkName nm)) paramNames-}+ myType = foldl AppT (ConT name) typeParams+ dataCxt typ = conT ''Data `appT` varT (mkName "ctx") `appT` return typ+ satCxt typ = conT ''Sat `appT` (varT (mkName "ctx") `appT` return typ)+ dataCxtTypes = nub (typeParams ++ types)+ satCxtTypes = nub (myType : types)+ context = cxt (map dataCxt dataCxtTypes ++ map satCxt satCxtTypes)++ -- Takes a pair (constructor name, number of type arguments) and+ -- creates the correct definition for gfoldl+ -- It is of the form z <constr name> `f` arg1 `f` ... `f` argn+ mkMatch (c,n) =+ do vs <- mapM (\s -> newName s) names+ match (conP c $ map varP vs)+ (normalB $ foldl+ (\e x -> (varE (mkName "f") `appE` e) `appE` varE x)+ (varE (mkName "z") `appE` conE c)+ vs+ ) []+ where names = take n (zipWith (++) (repeat "x") (map show [0 :: Integer ..]))+ mkMatches = map (\(n, (cn, i)) -> match (litP $ integerL n) (normalB $ reapply (appE (varE $ mkName "k")) i (varE (mkName "z") `appE` conE cn)) []) (zip [1..] cons)+ where+ reapply _ 0 f = f+ reapply x n f = x (reapply x (n-1) f)+ lowCaseName = map toLower nameStr+ nameStr = nameBase name+ theDataTypeName = lowCaseName ++ "DataType"+ -- Creates dataTypeDec of the form:+ -- <name>DataType = mkDataType <name> [<constructors]+ dataTypeDec = funD (mkName theDataTypeName)+ [clause []+ (normalB+ [| mkDataType nameStr $(listE (conVarExps)) |]) [] ]++ -- conVarExps is a [ExpQ]. Each ExpQ is a variable expression+ -- of form varE (mkName <con>Constr)+ numCons = length cons+ constrNames =+ take numCons (map (\i -> theDataTypeName ++ show i ++ "Constr") [1 :: Integer ..])+ conNames = map (nameBase . fst) cons+ conVarExps = map (varE . mkName) constrNames+ conDecs = zipWith3 mkConstrDec constrNames conNames fieldNames+ where+ mkConstrDec decNm conNm fieldNm =+ funD (mkName decNm)+ [clause []+ (normalB+ [| mkConstr $(varE (mkName theDataTypeName)) conNm fieldNm+ $(fixity conNm)+ |]) []]++ fixity (':':_) = [| Infix |]+ fixity _ = [| Prefix |]++ mkSel (c,n) e = match (conP c $ replicate n wildP)+ (normalB e) []++deriveMinimalData :: Name -> Int -> Q [Dec]+deriveMinimalData name nParam = do+ decs <- qOfDecs+ let listOfDecQ = map return decs+ sequence+ [ instanceD context+ (conT ''Data `appT` (foldl1 appT ([conT name] ++ typeQParams)))+ listOfDecQ ]++ where+ paramNames = take nParam (zipWith (++) (repeat "a") (map show [0 :: Integer ..]))+ typeQParams = map (\nm -> varT (mkName nm)) paramNames+ context = cxt (map (\typ -> conT ''Data `appT` typ) typeQParams)+ qOfDecs =+ [d| gunfold _ _ _ = error ("gunfold not defined")+ toConstr x = error ("toConstr not defined for " +++ show (typeOf x))+ dataTypeOf x = error ("dataTypeOf not implemented for " +++ show (typeOf x))+ gfoldl _ z x = z x+ |]++{- instance Data NameSet where+ gunfold _ _ _ = error ("gunfold not implemented")+ toConstr x = error ("toConstr not implemented for " ++ show (typeOf x))+ dataTypeOf x = error ("dataTypeOf not implemented for " ++ show (typeOf x))+ gfoldl f z x = z x -}++typeInfo :: DecQ -> Q (Name, [Name], [(Name, Int)], [(Name, [(Maybe Name, Type)])])+typeInfo m =+ do d <- m+ case d of+ DataD {} ->+ return $ (simpleName $ name d, paramsA d, consA d, termsA d)+ NewtypeD {} ->+ return $ (simpleName $ name d, paramsA d, consA d, termsA d)+ _ -> error ("derive: not a data type declaration: " ++ show d)++ where+ consA (DataD _ _ _ cs _) = map conA cs+ consA (NewtypeD _ _ _ c _) = [ conA c ]+ consA d = error ("consA: Unexpected decl: " +++ show d)++ paramsA (DataD _ _ ps _ _) = ps+ paramsA (NewtypeD _ _ ps _ _) = ps+ paramsA d = error ("paramsA: Unexpected decl: " +++ show d)++ termsA (DataD _ _ _ cs _) = map termA cs+ termsA (NewtypeD _ _ _ c _) = [ termA c ]+ termsA d = error ("termsA: Unexpected decl: " +++ show d)++ termA (NormalC c xs) = (c, map (\x -> (Nothing, snd x)) xs)+ termA (RecC c xs) = (c, map (\(n, _, t) -> (Just $ simpleName n, t)) xs)+ termA (InfixC t1 c t2) = (c, [(Nothing, snd t1), (Nothing, snd t2)])+ termA (ForallC _ _ c) = termA c++ conA (NormalC c xs) = (simpleName c, length xs)+ conA (RecC c xs) = (simpleName c, length xs)+ conA (InfixC _ c _) = (simpleName c, 2)+ conA (ForallC _ _ c) = conA c++ name (DataD _ n _ _ _) = n+ name (NewtypeD _ n _ _ _) = n+ name d = error $ show d++simpleName :: Name -> Name+simpleName nm =+ let s = nameBase nm+ in case dropWhile (/=':') s of+ [] -> mkName s+ _:[] -> mkName s+ _:t -> mkName t++--+-- | Derives the Data and Typeable instances for a single given data type.+--+deriveOne :: Name -> Q [Dec]+deriveOne n =+ do info' <- reify n+ case info' of+ TyConI d -> deriveOneDec d+ _ -> error ("derive: can't be used on anything but a type " +++ "constructor of an algebraic data type")++deriveOneDec :: Dec -> Q [Dec]+deriveOneDec dec =+ do (name, param, ca, terms) <- typeInfo (return dec)+ t <- deriveTypeablePrim name (length param)+ d <- deriveDataPrim name (map VarT param) ca terms+ return (t ++ d)++deriveOneData :: Name -> Q [Dec]+deriveOneData n =+ do info' <- reify n+ case info' of+ TyConI i -> do+ (name, param, ca, terms) <- typeInfo ((return i) :: Q Dec)+ d <- deriveDataPrim name (map VarT param) ca terms+ return d+ _ -> error ("derive: can't be used on anything but a type " +++ "constructor of an algebraic data type")+++--+-- | Derives Data and Typeable instances for a list of data+-- types. Order is irrelevant. This should be used in favour of+-- deriveOne since Data and Typeable instances can often depend on+-- other Data and Typeable instances - e.g. if you are deriving a+-- large, mutually recursive data type. If you splice the derived+-- instances in one by one you will need to do it in depedency order+-- which is difficult in most cases and impossible in the mutually+-- recursive case. It is better to bring all the instances into+-- scope at once.+--+-- e.g. if+-- data Foo = Foo Int+-- is declared in an imported module then+-- $(derive [''Foo])+-- will derive the instances for it+derive :: [Name] -> Q [Dec]+derive names = do+ decss <- mapM deriveOne names+ return (concat decss)+++deriveDec :: [Dec] -> Q [Dec]+deriveDec decs = do+ decss <- mapM deriveOneDec decs+ return (concat decss)+++deriveData :: [Name] -> Q [Dec]+deriveData names = do+ decss <- mapM deriveOneData names+ return (concat decss)++deriveTypeable :: [Name] -> Q [Dec]+deriveTypeable names = do+ decss <- mapM deriveOneTypeable names+ return (concat decss)++deriveOneTypeable :: Name -> Q [Dec]+deriveOneTypeable n =+ do info' <- reify n+ case info' of+ TyConI i -> do+ (name, param, _, _) <- typeInfo ((return i) :: Q Dec)+ t <- deriveTypeablePrim name (length param)+ return t+ _ -> error ("derive: can't be used on anything but a type " +++ "constructor of an algebraic data type")+++--+-- | This function is much like deriveOne except that it brings into+-- scope an instance of Data with minimal definitions. gfoldl will+-- essentially leave a data structure untouched while gunfoldl,+-- toConstr and dataTypeOf will yield errors.+--+-- This function is useful when you are certain that you will never+-- wish to transform a particular data type. For instance you may+-- be transforming another data type that contains other data types,+-- some of which you wish to transform (perhaps recursively) and+-- some which you just wish to return unchanged.+--+-- Sometimes you will be forced to use deriveMinimalOne because you+-- do not have access to the contructors of the data type (perhaps+-- because it is an Abstract Data Type). However, should the+-- interface to the ADT be sufficiently rich it is possible to+-- define you're own Data and Typeable instances.+deriveMinimalOne :: Name -> Q [Dec]+deriveMinimalOne n =+ do info' <- reify n+ case info' of+ TyConI i -> do+ (name, param, _, _) <- typeInfo ((return i) :: Q Dec)+ t <- deriveTypeablePrim name (length param)+ d <- deriveMinimalData name (length param)+ return $ t ++ d+ _ -> error ("deriveMinimal: can't be used on anything but a " +++ "type constructor of an algebraic data type")+++deriveMinimal :: [Name] -> Q [Dec]+deriveMinimal names = do+ decss <- mapM deriveMinimalOne names+ return (concat decss)+
+ Data/Generics/SYB/WithClass/Instances.hs view
@@ -0,0 +1,670 @@+{-# LANGUAGE TemplateHaskell, FlexibleInstances,+ UndecidableInstances, OverlappingInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- This is a module full of or[hans, 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.Typeable+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 GHC.IOBase -- 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 GHC.Conc -- So we can give Data instance for MVar & Co.++------------------------------------------------------------------------------+--+-- Instances of the Data class for Prelude-like types.+-- We define top-level definitions for representations.+--+------------------------------------------------------------------------------+++falseConstr :: Constr+falseConstr = mkConstr boolDataType "False" [] Prefix+trueConstr :: Constr+trueConstr = mkConstr boolDataType "True" [] Prefix+boolDataType :: DataType+boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]++instance Sat (ctx Bool) =>+ Data ctx Bool where+ toConstr _ False = falseConstr+ toConstr _ True = trueConstr+ gunfold _ _ z c = case constrIndex c of+ 1 -> z False+ 2 -> z True+ _ -> error "gunfold Bool"+ dataTypeOf _ _ = boolDataType+++------------------------------------------------------------------------------+++charType :: DataType+charType = mkStringType "Prelude.Char"++instance Sat (ctx Char) =>+ Data ctx Char where+ toConstr _ x = mkStringConstr charType [x]+ gunfold _ _ z c = case constrRep c of+ (StringConstr [x]) -> z x+ _ -> error "gunfold Char"+ dataTypeOf _ _ = charType+++------------------------------------------------------------------------------+++floatType :: DataType+floatType = mkFloatType "Prelude.Float"++instance Sat (ctx Float) =>+ Data ctx Float where+ toConstr _ x = mkFloatConstr floatType (realToFrac x)+ gunfold _ _ z c = case constrRep c of+ (FloatConstr x) -> z (realToFrac x)+ _ -> error "gunfold Float"+ dataTypeOf _ _ = floatType+++------------------------------------------------------------------------------+++doubleType :: DataType+doubleType = mkFloatType "Prelude.Double"++instance Sat (ctx Double) =>+ Data ctx Double where+ toConstr _ = mkFloatConstr floatType+ gunfold _ _ z c = case constrRep c of+ (FloatConstr x) -> z x+ _ -> error "gunfold Double"+ dataTypeOf _ _ = doubleType+++------------------------------------------------------------------------------+++intType :: DataType+intType = mkIntType "Prelude.Int"++instance Sat (ctx Int) =>+ Data ctx Int where+ toConstr _ x = mkIntConstr intType (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Int"+ dataTypeOf _ _ = intType+++------------------------------------------------------------------------------+++integerType :: DataType+integerType = mkIntType "Prelude.Integer"++instance Sat (ctx Integer) =>+ Data ctx Integer where+ toConstr _ = mkIntConstr integerType+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z x+ _ -> error "gunfold Integer"+ dataTypeOf _ _ = integerType+++------------------------------------------------------------------------------+++int8Type :: DataType+int8Type = mkIntType "Data.Int.Int8"++instance Sat (ctx Int8) =>+ Data ctx Int8 where+ toConstr _ x = mkIntConstr int8Type (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Int8"+ dataTypeOf _ _ = int8Type+++------------------------------------------------------------------------------+++int16Type :: DataType+int16Type = mkIntType "Data.Int.Int16"++instance Sat (ctx Int16) =>+ Data ctx Int16 where+ toConstr _ x = mkIntConstr int16Type (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Int16"+ dataTypeOf _ _ = int16Type+++------------------------------------------------------------------------------+++int32Type :: DataType+int32Type = mkIntType "Data.Int.Int32"++instance Sat (ctx Int32) =>+ Data ctx Int32 where+ toConstr _ x = mkIntConstr int32Type (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Int32"+ dataTypeOf _ _ = int32Type+++------------------------------------------------------------------------------+++int64Type :: DataType+int64Type = mkIntType "Data.Int.Int64"++instance Sat (ctx Int64) =>+ Data ctx Int64 where+ toConstr _ x = mkIntConstr int64Type (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Int64"+ dataTypeOf _ _ = int64Type+++------------------------------------------------------------------------------+++wordType :: DataType+wordType = mkIntType "Data.Word.Word"++instance Sat (ctx Word) =>+ Data ctx Word where+ toConstr _ x = mkIntConstr wordType (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Word"+ dataTypeOf _ _ = wordType+++------------------------------------------------------------------------------+++word8Type :: DataType+word8Type = mkIntType "Data.Word.Word8"++instance Sat (ctx Word8) =>+ Data ctx Word8 where+ toConstr _ x = mkIntConstr word8Type (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Word8"+ dataTypeOf _ _ = word8Type+++------------------------------------------------------------------------------+++word16Type :: DataType+word16Type = mkIntType "Data.Word.Word16"++instance Sat (ctx Word16) =>+ Data ctx Word16 where+ toConstr _ x = mkIntConstr word16Type (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Word16"+ dataTypeOf _ _ = word16Type+++------------------------------------------------------------------------------+++word32Type :: DataType+word32Type = mkIntType "Data.Word.Word32"++instance Sat (ctx Word32) =>+ Data ctx Word32 where+ toConstr _ x = mkIntConstr word32Type (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Word32"+ dataTypeOf _ _ = word32Type+++------------------------------------------------------------------------------+++word64Type :: DataType+word64Type = mkIntType "Data.Word.Word64"++instance Sat (ctx Word64) =>+ Data ctx Word64 where+ toConstr _ x = mkIntConstr word64Type (fromIntegral x)+ gunfold _ _ z c = case constrRep c of+ (IntConstr x) -> z (fromIntegral x)+ _ -> error "gunfold Word64"+ dataTypeOf _ _ = word64Type+++++------------------------------------------------------------------------------+++ratioConstr :: Constr+ratioConstr = mkConstr ratioDataType ":%" [] Infix+ratioDataType :: DataType+ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]++instance (Sat (ctx (Ratio a)), Data ctx a, Integral a) =>+ Data ctx (Ratio a) where+ toConstr _ _ = ratioConstr+ gunfold _ k z c | constrIndex c == 1 = k (k (z (:%)))+ gunfold _ _ _ _ = error "gunfold Ratio"+ dataTypeOf _ _ = ratioDataType+++------------------------------------------------------------------------------+++nilConstr :: Constr+nilConstr = mkConstr listDataType "[]" [] Prefix+consConstr :: Constr+consConstr = mkConstr listDataType "(:)" [] Infix+listDataType :: DataType+listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]++instance (Sat (ctx [a]), Data ctx a) =>+ Data ctx [a] where+ gfoldl _ _ z [] = z []+ gfoldl _ f z (x:xs) = z (:) `f` x `f` xs+ toConstr _ [] = nilConstr+ toConstr _ (_:_) = consConstr+ gunfold _ k z c = case constrIndex c of+ 1 -> z []+ 2 -> k (k (z (:)))+ _ -> error "gunfold List"+ dataTypeOf _ _ = listDataType+ dataCast1 _ f = gcast1 f++------------------------------------------------------------------------------+++nothingConstr :: Constr+nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix+justConstr :: Constr+justConstr = mkConstr maybeDataType "Just" [] Prefix+maybeDataType :: DataType+maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]++instance (Sat (ctx (Maybe a)), Data ctx a) =>+ Data ctx (Maybe a) where+ gfoldl _ _ z Nothing = z Nothing+ gfoldl _ f z (Just x) = z Just `f` x+ toConstr _ Nothing = nothingConstr+ toConstr _ (Just _) = justConstr+ gunfold _ k z c = case constrIndex c of+ 1 -> z Nothing+ 2 -> k (z Just)+ _ -> error "gunfold Maybe"+ dataTypeOf _ _ = maybeDataType+ dataCast1 _ f = gcast1 f+++------------------------------------------------------------------------------+++ltConstr :: Constr+ltConstr = mkConstr orderingDataType "LT" [] Prefix+eqConstr :: Constr+eqConstr = mkConstr orderingDataType "EQ" [] Prefix+gtConstr :: Constr+gtConstr = mkConstr orderingDataType "GT" [] Prefix+orderingDataType :: DataType+orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]++instance Sat (ctx Ordering) =>+ Data ctx Ordering where+ gfoldl _ _ z LT = z LT+ gfoldl _ _ z EQ = z EQ+ gfoldl _ _ z GT = z GT+ toConstr _ LT = ltConstr+ toConstr _ EQ = eqConstr+ toConstr _ GT = gtConstr+ gunfold _ _ z c = case constrIndex c of+ 1 -> z LT+ 2 -> z EQ+ 3 -> z GT+ _ -> error "gunfold Ordering"+ dataTypeOf _ _ = orderingDataType+++------------------------------------------------------------------------------+++leftConstr :: Constr+leftConstr = mkConstr eitherDataType "Left" [] Prefix+rightConstr :: Constr+rightConstr = mkConstr eitherDataType "Right" [] Prefix+eitherDataType :: DataType+eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]++instance (Sat (ctx (Either a b)), Data ctx a, Data ctx b) =>+ Data ctx (Either a b) where+ gfoldl _ f z (Left a) = z Left `f` a+ gfoldl _ f z (Right a) = z Right `f` a+ toConstr _ (Left _) = leftConstr+ toConstr _ (Right _) = rightConstr+ gunfold _ k z c = case constrIndex c of+ 1 -> k (z Left)+ 2 -> k (z Right)+ _ -> error "gunfold Either"+ dataTypeOf _ _ = eitherDataType+ dataCast2 _ f = gcast2 f+++------------------------------------------------------------------------------+++--+-- A last resort for functions+--++instance (Sat (ctx (a -> b)), Data ctx a, Data ctx b) =>+ Data ctx (a -> b) where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold (->)"+ dataTypeOf _ _ = mkNorepType "Prelude.(->)"+ dataCast2 _ f = gcast2 f+++------------------------------------------------------------------------------+++tuple0Constr :: Constr+tuple0Constr = mkConstr tuple0DataType "()" [] Prefix+tuple0DataType :: DataType+tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]++instance (Sat (ctx ())) =>+ Data ctx () where+ toConstr _ _ = tuple0Constr+ gunfold _ _ z c | constrIndex c == 1 = z ()+ gunfold _ _ _ _ = error "gunfold ()"+ dataTypeOf _ _ = tuple0DataType+++------------------------------------------------------------------------------+++tuple2Constr :: Constr+tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix+tuple2DataType :: DataType+tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]++instance (Sat (ctx (a,b)), Data ctx a, Data ctx b) =>+ Data ctx (a,b) where+ gfoldl _ f z (a,b) = z (,) `f` a `f` b+ toConstr _ _ = tuple2Constr+ gunfold _ k z c | constrIndex c == 1 = k (k (z (,)))+ gunfold _ _ _ _ = error "gunfold (,)"+ dataTypeOf _ _ = tuple2DataType+ dataCast2 _ f = gcast2 f+++------------------------------------------------------------------------------+++tuple3Constr :: Constr+tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix+tuple3DataType :: DataType+tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr]++instance (Sat (ctx (a,b,c)), Data ctx a, Data ctx b, Data ctx c) =>+ Data ctx (a,b,c) where+ gfoldl _ f z (a,b,c) = z (,,) `f` a `f` b `f` c+ toConstr _ _ = tuple3Constr+ gunfold _ k z c | constrIndex c == 1 = k (k (k (z (,,))))+ gunfold _ _ _ _ = error "gunfold (,,)"+ dataTypeOf _ _ = tuple3DataType++------------------------------------------------------------------------------+++tuple4Constr :: Constr+tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix+tuple4DataType :: DataType+tuple4DataType = mkDataType "Prelude.(,,,)" [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 _ f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d+ toConstr _ _ = tuple4Constr+ gunfold _ k z c = case constrIndex c of+ 1 -> k (k (k (k (z (,,,)))))+ _ -> error "gunfold (,,,)"+ dataTypeOf _ _ = tuple4DataType+++------------------------------------------------------------------------------+++tuple5Constr :: Constr+tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix+tuple5DataType :: DataType+tuple5DataType = mkDataType "Prelude.(,,,,)" [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 _ f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e+ toConstr _ _ = tuple5Constr+ gunfold _ k z c = case constrIndex c of+ 1 -> k (k (k (k (k (z (,,,,))))))+ _ -> error "gunfold (,,,,)"+ dataTypeOf _ _ = tuple5DataType+++------------------------------------------------------------------------------+++tuple6Constr :: Constr+tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix+tuple6DataType :: DataType+tuple6DataType = mkDataType "Prelude.(,,,,,)" [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 _ f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'+ toConstr _ _ = tuple6Constr+ gunfold _ k z c = case constrIndex c of+ 1 -> k (k (k (k (k (k (z (,,,,,)))))))+ _ -> error "gunfold (,,,,,)"+ dataTypeOf _ _ = tuple6DataType+++------------------------------------------------------------------------------+++tuple7Constr :: Constr+tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix+tuple7DataType :: DataType+tuple7DataType = mkDataType "Prelude.(,,,,,,)" [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 _ f z (a,b,c,d,e,f',g) =+ z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g+ toConstr _ _ = tuple7Constr+ gunfold _ k z c = case constrIndex c of+ 1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))+ _ -> error "gunfold (,,,,,,)"+ dataTypeOf _ _ = tuple7DataType+++------------------------------------------------------------------------------+++instance Sat (ctx TypeRep) =>+ Data ctx TypeRep where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold TypeRep"+ dataTypeOf _ _ = mkNorepType "Data.Typeable.TypeRep"+++------------------------------------------------------------------------------+++instance Sat (ctx TyCon) =>+ Data ctx TyCon where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold TyCon"+ dataTypeOf _ _ = mkNorepType "Data.Typeable.TyCon"+++------------------------------------------------------------------------------+++-- INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType")+$(deriveTypeable [''DataType])++instance Sat (ctx DataType) =>+ Data ctx DataType where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold DataType"+ dataTypeOf _ _ = mkNorepType "Data.Generics.Basics.DataType"+++------------------------------------------------------------------------------+++instance (Sat (ctx (IO a)), Typeable a) =>+ Data ctx (IO a) where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold IO"+ dataTypeOf _ _ = mkNorepType "GHC.IOBase.IO"+++------------------------------------------------------------------------------+++instance Sat (ctx Handle) =>+ Data ctx Handle where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold Handle"+ dataTypeOf _ _ = mkNorepType "GHC.IOBase.Handle"+++------------------------------------------------------------------------------+++instance (Sat (ctx (Ptr a)), Typeable a) =>+ Data ctx (Ptr a) where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold Ptr"+ dataTypeOf _ _ = mkNorepType "GHC.Ptr.Ptr"+++------------------------------------------------------------------------------+++instance (Sat (ctx (StablePtr a)), Typeable a) =>+ Data ctx (StablePtr a) where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold StablePtr"+ dataTypeOf _ _ = mkNorepType "GHC.Stable.StablePtr"+++------------------------------------------------------------------------------+++instance (Sat (ctx (IORef a)), Typeable a) =>+ Data ctx (IORef a) where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold IORef"+ dataTypeOf _ _ = mkNorepType "GHC.IOBase.IORef"+++------------------------------------------------------------------------------+++instance (Sat (ctx (ForeignPtr a)), Typeable a) =>+ Data ctx (ForeignPtr a) where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold ForeignPtr"+ dataTypeOf _ _ = mkNorepType "GHC.ForeignPtr.ForeignPtr"+++------------------------------------------------------------------------------+++instance (Sat (ctx (ST s a)), Typeable s, Typeable a) =>+ Data ctx (ST s a) where+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold ST"+ dataTypeOf _ _ = mkNorepType "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 _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold MVar"+ dataTypeOf _ _ = mkNorepType "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 _ f z a = z (listArray (bounds a)) `f` (elems a)+ toConstr _ _ = error "toConstr"+ gunfold _ _ _ = error "gunfold Array"+ dataTypeOf _ _ = mkNorepType "Data.Array.Array"++------------------------------------------------------------------------------+
+ Setup.hs view
@@ -0,0 +1,8 @@++module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain+
+ syb-with-class.cabal view
@@ -0,0 +1,24 @@+Name: syb-with-class+Version: 0.1+License: BSD3+Copyright: 2004 - 2007 The University of Glasgow, CWI,+ Simon Peyton Jones, Ralf Laemmel,+ Ulf Norell, Sean Seefried, Simon D. Foster,+ HAppS LLC+Author: Simon Peyton Jones, Ralf Laemmel+Maintainer: AlexJacobson@HAppS.org+Stability: experimental+Synopsis: Scrap Your Boilerplate With Class+Description:+ Classes, and Template Haskell code to generate instances, for the+ Scrap Your Boilerplate With Class system.+Category: Data+Tested-With: GHC==6.6+Build-Depends: base, template-haskell+Exposed-modules:+ Data.Generics.SYB.WithClass.Basics+ Data.Generics.SYB.WithClass.Context+ Data.Generics.SYB.WithClass.Derive+ Data.Generics.SYB.WithClass.Instances+GHC-Options: -Wall -Werror+