syb-with-class 0.6.1.8 → 0.6.1.14
raw patch · 6 files changed
Files
- Data/Generics/SYB/WithClass/Basics.hs +33/−22
- Data/Generics/SYB/WithClass/Context.hs +5/−5
- Data/Generics/SYB/WithClass/Derive.hs +24/−12
- Data/Generics/SYB/WithClass/Instances.hs +9/−10
- syb-with-class.cabal +15/−6
- tests/Test.hs +42/−0
Data/Generics/SYB/WithClass/Basics.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE UndecidableInstances, OverlappingInstances, Rank2Types,+{-# LANGUAGE UndecidableInstances, Rank2Types, CPP, KindSignatures, MultiParamTypeClasses, EmptyDataDecls #-} -{-+{- | (C) 2004--2005 Ralf Laemmel, Simon D. Foster @@ -33,7 +33,7 @@ #endif --------------------------------------------------------------------------------- The ingenious Data class+-- * The ingenious Data class class (Typeable a, Sat (ctx a)) => Data ctx a @@ -66,14 +66,22 @@ dataTypeOf _ _ = undefined -- | Mediate types and unary type constructors+#if MIN_VERSION_base(4,11,0)+ dataCast1 :: Typeable t+#else dataCast1 :: Typeable1 t+#endif => Proxy ctx -> (forall b. Data ctx b => w (t b)) -> Maybe (w a) dataCast1 _ _ = Nothing -- | Mediate types and binary type constructors+#if MIN_VERSION_base(4,11,0)+ dataCast2 :: Typeable t+#else dataCast2 :: Typeable2 t+#endif => Proxy ctx -> (forall b c. (Data ctx b, Data ctx c) => w (t b c)) -> Maybe (w a)@@ -83,12 +91,12 @@ ------------------------------------------------------------------------------ --- Generic transformations+-- * Generic transformations type GenericT ctx = forall a. Data ctx a => a -> a --- Generic map for transformations+-- | Generic map for transformations gmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx @@ -97,18 +105,18 @@ k (ID g) y = ID (g (f y)) --- The identity type constructor+-- | The identity type constructor newtype ID x = ID { unID :: x } ------------------------------------------------------------------------------ --- Generic monadic transformations+-- | Generic monadic transformations type GenericM m ctx = forall a. Data ctx a => a -> m a --- Generic map for monadic transformations+-- | Generic map for monadic transformations gmapM :: Monad m => Proxy ctx -> GenericM m ctx -> GenericM m ctx gmapM ctx f = gfoldl ctx k return@@ -119,12 +127,12 @@ ------------------------------------------------------------------------------ --- Generic queries+-- * Generic queries type GenericQ ctx r = forall a. Data ctx a => a -> r --- Map for queries+-- | Map for queries gmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r] gmapQ ctx f = gmapQr ctx (:) [] f@@ -140,14 +148,14 @@ where k (Qr g) y = Qr (\s -> g (f y `o` s)) --- The type constructor used in definition of gmapQr+-- | The type constructor used in definition of gmapQr newtype Qr r a = Qr { unQr :: r -> r } ------------------------------------------------------------------------------ ----- Generic unfolding+-- * Generic unfolding -- ------------------------------------------------------------------------------ @@ -185,15 +193,15 @@ ------------------------------------------------------------------------------ ----- Datatype and constructor representations+-- * 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.+-- 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@@ -256,7 +264,7 @@ ------------------------------------------------------------------------------ ----- Observers for datatype representations+-- * Observers for datatype representations -- ------------------------------------------------------------------------------ @@ -296,7 +304,7 @@ ------------------------------------------------------------------------------ ----- Representations of algebraic data types+-- * Representations of algebraic data types -- ------------------------------------------------------------------------------ @@ -344,7 +352,7 @@ ------------------------------------------------------------------------------ ----- From strings to constr's and vice versa: all data types+-- * From strings to constr's and vice versa: all data types -- ------------------------------------------------------------------------------ @@ -381,7 +389,7 @@ ------------------------------------------------------------------------------ ----- Convenience funtions: algebraic data types+-- * Convenience funtions: algebraic data types -- ------------------------------------------------------------------------------ @@ -417,7 +425,7 @@ ------------------------------------------------------------------------------ ----- Representation of primitive types+-- * Representation of primitive types -- ------------------------------------------------------------------------------ @@ -445,7 +453,7 @@ } --- Makes a constructor for primitive types+-- | Makes a constructor for primitive types mkPrimCon :: DataType -> String -> ConstrRep -> Constr mkPrimCon dt str cr = Constr { datatype = dt@@ -456,18 +464,21 @@ } +-- | Makes a constructor for an Int mkIntConstr :: DataType -> Integer -> Constr mkIntConstr dt i = case datarep dt of IntRep -> mkPrimCon dt (show i) (IntConstr i) _ -> error "mkIntConstr" +-- | Makes a constructor for a Float mkFloatConstr :: DataType -> Double -> Constr mkFloatConstr dt f = case datarep dt of FloatRep -> mkPrimCon dt (show f) (FloatConstr f) _ -> error "mkFloatConstr" +-- | Makes a constructor for a String mkStringConstr :: DataType -> String -> Constr mkStringConstr dt str = case datarep dt of StringRep -> mkPrimCon dt str (StringConstr str)@@ -476,7 +487,7 @@ ------------------------------------------------------------------------------ ----- Non-representations for non-presentable types+-- * Non-representations for non-presentable types -- ------------------------------------------------------------------------------
Data/Generics/SYB/WithClass/Context.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE UndecidableInstances, OverlappingInstances, EmptyDataDecls #-}+{-# LANGUAGE UndecidableInstances, EmptyDataDecls #-} -{-+{- | (C) 2004 Ralf Laemmel @@ -16,7 +16,7 @@ ------------------------------------------------------------------------------ ----- The Sat class from John Hughes' "Restricted Data Types in Haskell"+-- | The Sat class from John Hughes' "Restricted Data Types in Haskell" -- class Sat a@@ -26,7 +26,7 @@ ------------------------------------------------------------------------------ --- No context+-- | No context data NoCtx a @@ -38,7 +38,7 @@ ------------------------------------------------------------------------------ --- Pair context+-- | Pair context data PairCtx l r a = PairCtx { leftCtx :: l a
Data/Generics/SYB/WithClass/Derive.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}--- We can't warn about missing sigs as we have a group of decls in+-- | 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 --@@ -54,15 +54,19 @@ where index [] _ = Nothing index (x:_) 0 = Just x index (_:xs) n = index xs (n - 1)- names = [(''Typeable, 'typeOf),- (''Typeable1, 'typeOf1),- (''Typeable2, 'typeOf2),- (''Typeable3, 'typeOf3),- (''Typeable4, 'typeOf4),- (''Typeable5, 'typeOf5),- (''Typeable6, 'typeOf6),- (''Typeable7, 'typeOf7)]+ names = [ (''Typeable, 'typeOf)+#if MIN_VERSION_base(4,11,0)+#else+ , (''Typeable1, 'typeOf1)+ , (''Typeable2, 'typeOf2)+ , (''Typeable3, 'typeOf3)+ , (''Typeable4, 'typeOf4)+ , (''Typeable5, 'typeOf5)+ , (''Typeable6, 'typeOf6)+ , (''Typeable7, 'typeOf7) #endif+ ]+#endif type Constructor = (Name, -- Name of the constructor Int, -- Number of constructor arguments@@ -232,11 +236,15 @@ |] #endif -{- instance Data NameSet where+{- |+ @@+ 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 -}+ gfoldl f z x = z x+ @@+-} typeInfo :: Dec -> Q (Name, -- Name of the datatype@@ -260,9 +268,13 @@ fields = map getField xs types = map getType xs in (c, length xs, Just fields, types)+#if MIN_VERSION_template_haskell(2,17,0)+ varName (PlainTV n _) = n+ varName (KindedTV n _ _) = n+#else varName (PlainTV n) = n varName (KindedTV n _) = n-+#endif -- -- | Derives the Data and Typeable instances for a single given data type. --
Data/Generics/SYB/WithClass/Instances.hs view
@@ -1,6 +1,12 @@-{-# LANGUAGE TemplateHaskell, FlexibleInstances,- UndecidableInstances, OverlappingInstances, CPP,- MultiParamTypeClasses #-}+------------------------------------------------------------------------------+--+-- | 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@@ -27,13 +33,6 @@ 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-------------------------------------------------------------------------------------- Instances of the Data class for Prelude-like types.--- We define top-level definitions for representations.---------------------------------------------------------------------------------- falseConstr :: Constr
syb-with-class.cabal view
@@ -1,5 +1,5 @@ Name: syb-with-class-Version: 0.6.1.8+Version: 0.6.1.14 License: BSD3 License-file: LICENSE Copyright: 2004 - 2008 The University of Glasgow, CWI,@@ -10,30 +10,39 @@ Author: Simon Peyton Jones, Ralf Laemmel Maintainer: sanzhiyan@gmail.com Stability: experimental-Bug-Reports: http://code.google.com/p/syb-with-class/issues/list 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 == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC==8.0.1, GHC==8.2.1+Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.2 Build-Type: Simple-Cabal-Version: >= 1.6+Cabal-Version: >= 1.10 source-repository head type: git location: https://github.com/Happstack/syb-with-class Library- Build-Depends: base >= 3 && < 5, template-haskell >= 2.4 && < 2.13, bytestring, array, containers+ Default-Language: Haskell2010+ Build-Depends: base >= 3 && < 5, template-haskell >= 2.4 && < 2.19, bytestring, array, containers Exposed-modules: Data.Generics.SYB.WithClass.Basics Data.Generics.SYB.WithClass.Context Data.Generics.SYB.WithClass.Derive Data.Generics.SYB.WithClass.Instances - Extensions: UndecidableInstances, OverlappingInstances, Rank2Types,+ Default-Extensions: UndecidableInstances, OverlappingInstances, Rank2Types, EmptyDataDecls, TemplateHaskell, FlexibleInstances, CPP, KindSignatures, MultiParamTypeClasses GHC-Options: -Wall++test-suite syb-with-class-test+ Default-Language: Haskell2010+ Type: exitcode-stdio-1.0+ Hs-Source-Dirs: tests+ GHC-Options: -Wall+ Main-Is: Test.hs+ Build-Depends: base, HUnit, syb-with-class+ Default-Extensions: OverlappingInstances
+ tests/Test.hs view
@@ -0,0 +1,42 @@+-- Minimal demonstration of syb-with-class. Here we have a class Size+-- with a base instance. Then we override it for lists, and+-- demonstrate how gsize uses the list behavior on lists and the base+-- behavior otherwise.++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS -Wall #-}++import Data.Generics.SYB.WithClass.Basics (Data, gmapQ, Proxy)+import Data.Generics.SYB.WithClass.Context (Sat(dict))+import Data.Generics.SYB.WithClass.Instances ()+import Test.HUnit (assertEqual, Counts(..), runTestTT, showCounts, Test(TestCase))++class Size a where+ gsize :: a -> Int++-- Dictionary type and Sat instance+data SizeD a = SizeD { gsizeD :: a -> Int }++instance Size t => Sat (SizeD t) where+ dict = SizeD { gsizeD = gsize }++instance {-# OVERLAPPABLE #-} Data SizeD t => Size t where+ -- The base behavior of gsize for any instance of Data+ gsize t = 1 + sum (gmapQ (error "urk" :: Proxy SizeD) (gsizeD dict) t)++instance Size a => Size [a] where+ -- Override base gsize behavior for lists+ gsize [] = 0+ gsize (x:xs) = gsize x + gsize xs++main :: IO ()+main = do+ counts <- runTestTT (let expected = (2,1)+ actual = (gsize ['a', 'b'], gsize 'x') in+ TestCase (assertEqual "sample" expected actual))+ case counts of+ Counts {errors = 0, failures = 0} -> return ()+ _ -> error (showCounts counts)