diff --git a/Data/Generics/SYB/WithClass/Derive.hs b/Data/Generics/SYB/WithClass/Derive.hs --- a/Data/Generics/SYB/WithClass/Derive.hs +++ b/Data/Generics/SYB/WithClass/Derive.hs @@ -118,7 +118,7 @@ -- => Data ctx DataType instanceD context (dataCxt myType) [ -- Define the gfoldl method - do f <- newName "f" + do f <- newName "_f" z <- newName "z" x <- newName "x" let -- Takes a pair (constructor name, number of type @@ -136,7 +136,7 @@ [] ] , -- Define the gunfold method - do k <- newName "k" + do k <- newName "_k" z <- newName "z" c <- newName "c" let body = if null cons diff --git a/Data/Generics/SYB/WithClass/Instances.hs b/Data/Generics/SYB/WithClass/Instances.hs --- a/Data/Generics/SYB/WithClass/Instances.hs +++ b/Data/Generics/SYB/WithClass/Instances.hs @@ -21,7 +21,8 @@ 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. - +import qualified Data.Map as M +import qualified Data.Set as S ------------------------------------------------------------------------------ -- -- Instances of the Data class for Prelude-like types. @@ -669,6 +670,54 @@ toConstr _ _ = error "toConstr" gunfold _ _ _ = error "gunfold Array" dataTypeOf _ _ = mkNorepType "Data.Array.Array" + +------------------------------------------------------------------------------ + + +emptyMapConstr :: Constr +emptyMapConstr = mkConstr mapDataType "empty" [] Prefix +insertMapConstr :: Constr +insertMapConstr = mkConstr mapDataType "insert" [] Prefix +mapDataType :: DataType +mapDataType = mkDataType "Data.Map.Map" [emptyMapConstr,insertMapConstr] + +instance (Sat (ctx (M.Map a b)), Data ctx a, Data ctx b, Ord a) => + Data ctx (M.Map a b) where + gfoldl _ f z m = case M.minViewWithKey m of + Nothing -> z M.empty + Just ((k,a),m') -> z M.insert `f` k `f` a `f` m' + toConstr _ m | M.size m == 0 = emptyMapConstr + | otherwise = insertMapConstr + gunfold _ k z c = case constrIndex c of + 1 -> z M.empty + 2 -> k (k (k (z M.insert))) + _ -> error "gunfold Map" + dataTypeOf _ _ = mapDataType + dataCast2 _ f = gcast2 f + +------------------------------------------------------------------------------ + + +emptySetConstr :: Constr +emptySetConstr = mkConstr mapDataType "empty" [] Prefix +insertSetConstr :: Constr +insertSetConstr = mkConstr mapDataType "insert" [] Prefix +setDataType :: DataType +setDataType = mkDataType "Data.Set.Set" [emptySetConstr,insertSetConstr] + +instance (Sat (ctx (S.Set a)), Data ctx a, Ord a) => + Data ctx (S.Set a ) where + gfoldl _ f z s = case S.minView s of + Nothing -> z S.empty + Just (a,s') -> z S.insert `f` a `f` s' + toConstr _ m | S.size m == 0 = emptySetConstr + | otherwise = insertSetConstr + gunfold _ k z c = case constrIndex c of + 1 -> z S.empty + 2 -> k (k (z S.insert)) + _ -> error "gunfold Set" + dataTypeOf _ _ = setDataType + dataCast1 _ f = gcast1 f ------------------------------------------------------------------------------ diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2004 - 2008 The University of Glasgow, CWI, + Simon Peyton Jones, Ralf Laemmel, + Ulf Norell, Sean Seefried, Simon D. Foster, + HAppS LLC + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/syb-with-class.cabal b/syb-with-class.cabal --- a/syb-with-class.cabal +++ b/syb-with-class.cabal @@ -1,28 +1,39 @@ Name: syb-with-class -Version: 0.4 +Version: 0.5 License: BSD3 -Copyright: 2004 - 2007 The University of Glasgow, CWI, +License-file: LICENSE +Copyright: 2004 - 2008 The University of Glasgow, CWI, Simon Peyton Jones, Ralf Laemmel, Ulf Norell, Sean Seefried, Simon D. Foster, HAppS LLC + 2009 Andrea Vezzosi Author: Simon Peyton Jones, Ralf Laemmel -Maintainer: AlexJacobson@HAppS.org +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. + Scrap Your Boilerplate With Class system. Category: Data -Tested-With: GHC==6.6, GHC==6.8.1 -Build-Depends: base, template-haskell, bytestring, array +Tested-With: GHC==6.8.3, GHC==6.10.1 Build-Type: Simple -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, +Cabal-Version: >= 1.6 + +source-repository head + type: darcs + location: http://darcs.haskell.org/cabal/ + +Library + Build-Depends: base >= 3 && < 5, template-haskell, 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, EmptyDataDecls, TemplateHaskell, FlexibleInstances, CPP, KindSignatures, MultiParamTypeClasses -GHC-Options: -Wall + GHC-Options: -Wall