emgm (empty) → 0.1
raw patch · 27 files changed
+3445/−0 lines, 27 filesdep +HUnitdep +QuickCheckdep +basebuild-type:Customsetup-changed
Dependencies added: HUnit, QuickCheck, base
Files
- LICENSE +28/−0
- README +218/−0
- Setup.lhs +23/−0
- emgm.cabal +171/−0
- src/Generics/EMGM.hs +34/−0
- src/Generics/EMGM/Common.hs +27/−0
- src/Generics/EMGM/Common/Base.hs +173/−0
- src/Generics/EMGM/Common/Base2.hs +124/−0
- src/Generics/EMGM/Common/Base3.hs +126/−0
- src/Generics/EMGM/Common/Representation.hs +169/−0
- src/Generics/EMGM/Data.hs +29/−0
- src/Generics/EMGM/Data/Bool.hs +73/−0
- src/Generics/EMGM/Data/Either.hs +73/−0
- src/Generics/EMGM/Data/List.hs +98/−0
- src/Generics/EMGM/Data/Maybe.hs +99/−0
- src/Generics/EMGM/Data/Tuple.hs +203/−0
- src/Generics/EMGM/Functions.hs +36/−0
- src/Generics/EMGM/Functions/Collect.hs +161/−0
- src/Generics/EMGM/Functions/Compare.hs +162/−0
- src/Generics/EMGM/Functions/Crush.hs +244/−0
- src/Generics/EMGM/Functions/Enum.hs +148/−0
- src/Generics/EMGM/Functions/Map.hs +73/−0
- src/Generics/EMGM/Functions/Read.hs +399/−0
- src/Generics/EMGM/Functions/Show.hs +279/−0
- src/Generics/EMGM/Functions/UnzipWith.hs +112/−0
- src/Generics/EMGM/Functions/ZipWith.hs +131/−0
- tests/Main.hs +32/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2008 Universiteit Utrecht+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 Universiteit Utrecht nor the names of its contributors+ may be used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER 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.+
+ README view
@@ -0,0 +1,218 @@++Extensible and Modular Generics for the Masses+==============================================++[Extensible and Modular Generics for the Masses] (EMGM) is a library for generic+programming in Haskell.++[Extensible and Modular Generics for the Masses]: http://www.cs.uu.nl/wiki/GenericProgramming/EMGM++Features+--------++The primary features of EMGM include:++* Datatype-generic programming using sum-of-product views+* Large collection of ready-to-use generic functions+* Included support for standard datatypes: lists, Maybe, tuples+* Easy to add support for new datatypes+* Type classes make writing new functions straightforward in a structurally+ inductive style+* Generic functions are extensible with ad-hoc cases for arbitrary datatypes+* Good performance of generic functions++The features of this distribution include:++* The API is thoroughly documented with Haddock+* Fully tested with QuickCheck and HUnit+* Program coverage ensures that all useful code has been touched by tests+* Tested on both Mac and Windows systems+++Requirements+------------++EMGM has the following requirements:++* [GHC] 6.8.1 - It has been tested with versions 6.8.3 and 6.9.20080916.+* [Cabal] library 1.2.1 - It has been tested with versions 1.2.3 and 1.4.0.1.++[GHC]: http://www.haskell.org/ghc/+[Cabal]: http://www.haskell.org/cabal/+++Download & Installation+-----------------------++*If you have [cabal-install]*, you should use that to install the package,+because it will handle everything for you.++ cabal install emgm++*If you don't have cabal-install*, you must download the [emgm package] from+the HackageDB and install it manually. Get the `tar.gz` file and decompress it.++Once downloaded, use the following commands for configuring, building, and+installing the library.++ runghc Setup.lhs configure+ runghc Setup.lhs build+ runghc Setup.lhs install++To generate the Haddock documentation, run this commmand:++ runghc Setup.lhs haddock++For more details on the general options available, refer to the [Cabal User's+Guide].++For more details on library-specific options, see the [Development] section.++[emgm package]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/emgm+[cabal-install]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/cabal-install+[Cabal User's Guide]: http://www.haskell.org/cabal/release/latest/doc/users-guide/+[Development]: #development+++Documentation+-------------++The API is documented using [Haddock] and available on the [emgm package] site.++[Haddock]: http://www.haskell.org/haddock/+[emgm package]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/emgm+++Examples+--------++You can find examples of using EMGM in the [`examples` directory] of the source+distribution.++[`examples` directory]: https://svn.cs.uu.nl:12443/viewvc/dgp-haskell/EMGM/examples/+++Bugs & Support+--------------++To report bugs, use the Google Code [project page for EMGM].++For general concerns and questions, use the [Generics mailing list].++[project page for EMGM]: http://code.google.com/p/emgm/+[Generics mailing list]: http://www.haskell.org/mailman/listinfo/generics+++Licensing+---------++EMGM is licensed under the so-called [BSD3 license]. See the included `LICENSE`+file.++[BSD3 license]: http://www.opensource.org/licenses/bsd-license.php+++Credits+-------++The research for EMGM originated with [Ralf Hinze]. It was extended with work by+[Bruno Oliveira] and [Andres Löh]. More details of the library functionality+were explored by [Alexey Rodriguez]. We are very grateful to all of these people+for the foundation on which this library was built.++The current authors and maintainers of EMGM are:++* [Sean Leather]+* [José Pedro Magalhães]+* [Alexey Rodriguez]+* [Andres Löh]++[Ralf Hinze]: http://www.comlab.ox.ac.uk/ralf.hinze/+[Bruno Oliveira]: http://web.comlab.ox.ac.uk/people/Bruno.Oliveira/+[Andres Löh]: http://people.cs.uu.nl/andres/+[Alexey Rodriguez]: http://www.cs.uu.nl/wiki/Alexey+[Sean Leather]: http://www.cs.uu.nl/staff/leather.html+[José Pedro Magalhães]: http://www.dreixel.net/+++Development+-----------++If you're interesting in contributing to the development of EMGM or just in+playing with the code, there are some useful things to know.++### Source ###++The source can be checked out from its repository using [Subversion].++ svn checkout https://svn.cs.uu.nl:12443/repos/dgp-haskell/EMGM++You can also [view the files online].++[Subversion]: http://subversion.tigris.org/+[view the files online]: https://svn.cs.uu.nl:12443/viewvc/dgp-haskell/EMGM/++### Requirements ###++In addition to the requirements for using the library, EMGM has the following+requirements for development:++* Cabal library 1.4.0.1 - This is preferred for uploading to HackageDB. Some+ issues were encountered with the current flags setup in emgm.cabal that gave+ errors in an older version of Cabal.+* [QuickCheck 2.0] - Required for testing.+* HUnit 1.2 - Required for testing.++[QuickCheck 2.0]: http://darcs.haskell.org/QuickCheck/++### Configuring ###++If you've been changing many files or the `emgm.cabal` file, you should clean+this distribution and build files.++ runghc Setup.lhs clean++In order to test the library, configure it with the following options:++ runghc Setup.lhs configure -ftest -fnolib++This enables building the test executable (while reducing the optimization level+to speed up the build) and disables building the library (thus also speeding up+the build). `nolib` is optional in case you actually do want to build the+library.++To enable program coverage, add the `hpc` flag. This adds coverage only on the+test executable, so the `test` flag is required.++ runghc Setup.lhs configure -ftest -fnolib -fhpc++### Testing ###++After configuring with the `test` flag and building, you can run the test suite.++ runghc Setup.lhs test++You will see some output from both QuickCheck and HUnit. It should all work!++### Program coverage ###++If you have configured the library for HPC (see above), then you can get the+program coverage using the included script after running the test suite. This+uses the `hpc` command in your path and passes a number of flags excluding+modules that should be ignored for coverage purposes.++Run the script from the top-level directory to see its usage.++ runghc util/hpc.lhs++To get a simple report of the coverage, use the `report` option.++ runghc util/hpc.lhs report++To get a set of HTML files with code coverage indications, use the `markup`+option.++ runghc util/hpc.lhs markup++At the end of this run, the command tells you where to find the HTML files.+
+ Setup.lhs view
@@ -0,0 +1,23 @@+#! /usr/bin/env runhaskell++\begin{code}++{-# OPTIONS -Wall -fno-warn-missing-signatures #-}++module Main (main) where++import Distribution.Simple (defaultMainWithHooks, simpleUserHooks, UserHooks(..))+import System.Cmd (system)+import System.FilePath ((</>))++main :: IO ()+main = defaultMainWithHooks hooks where+ hooks = simpleUserHooks { runTests = runTests' }++runTests' _ _ _ _ = system cmd >> return ()+ where testdir = "dist" </> "build" </> "test"+ testcmd = "." </> "test"+ cmd = "cd " ++ testdir ++ " && " ++ testcmd++\end{code}+
+ emgm.cabal view
@@ -0,0 +1,171 @@+name: emgm+version: 0.1+synopsis: Extensible and Modular Generics for the Masses+homepage: http://www.cs.uu.nl/wiki/GenericProgramming/EMGM+description:++ EMGM is a general-purpose library for generic programming with type classes.+ .+ The design is based on the idea of modeling algebraic datatypes as+ sum-of-product structures. Many datatypes can be modeled this way, and,+ because they all share a common structure, we can write generic functions that+ work on this structure.+ .+ The library provides three main components:+ .+ (1) 'Common' - /A common foundation for building generic functions and adding support for datatypes./+ This includes the collection of datatypes (e.g. sum, product, unit) and type+ classes (e.g. 'Generic', 'Rep'), that are used throughout the library. This is+ what you need to define your own generic functions, to add generic support for+ your datatype, or to define ad-hoc cases.+ .+ (2) 'Functions' - /A collection of useful generic functions./+ These work with a variety of datatypes and provide a wide range of operations.+ For example, there is 'crush', a generalization of the fold functions. It is+ one of the most useful functions, because it allows you to flexibly extract+ the elements of a polymorphic container.+ .+ (3) 'Data' - /Support for using standard datatypes generically./+ Types such as @[a]@, tuples, and @Maybe@ are built into Haskell or come+ included in the standard libraries. EMGM provides full support for generic+ functions on these datatypes. The modules in this component are also useful as+ guides when adding generic support for your own datatypes.+ .+ EMGM originated in the research of Ralf Hinze, Bruno Oliveira, and Andres Löh+ [1,2]. The library was further explored in a comparison of generic programming+ libraries by Alexey Rodriguez, et al [3]. Lastly, this released package was+ developed simultaneously with the writing of lecture notes for the 2008+ Advanced Functional Programming Summer School [4] (forthcoming). These are+ good resources for learning how the library works and how to use it, but be+ aware that names may have been changed to protect the innocent.+ .+ (1) Ralf Hinze. Generics for the Masses. In ICFP 2004: Proceedings of the 9th ACM+ SIGPLAN international conference on Functional programming, pages 236-243. ACM+ Press, 2004.+ (<http://www.informatik.uni-bonn.de/~ralf/publications.html#P21>)+ .+ (2) Bruno C. d. S. Oliveira, Ralf Hinze, and Andres Löh. Extensible and Modular+ Generics for the Masses. In Henrik Nilsson, editor, Trends in Functional+ Programming, pages 199-216, 2006.+ (<http://web.comlab.ox.ac.uk/publications/publication444-abstract.html>)+ .+ (3) Alexey Rodriguez, Johan Jeuring, Patrik Jansson, Alex Gerdes, Oleg Kiselyov,+ and Bruno C. d. S. Oliveira. Comparing Libraries for Generic Programming in+ Haskell. Technical Report UU-CS-2008-010. Department of Information and+ Computing Sciences, Utrecht University.+ (<http://www.cs.uu.nl/wiki/bin/view/Alexey/ComparingLibrariesForGenericProgrammingInHaskell>)+ .+ (4) Johan Jeuring, Sean Leather, José Pedro Magalhães, and Alexey Rodriguez+ Yakushev. Libraries for Generic Programming in Haskell. Technical Report+ UU-CS-2008-025. Department of Information and Computing Sciences, Utrecht+ University.+ (<http://www.cs.uu.nl/research/techreps/UU-CS-2008-025.html>)++category: Generics+copyright: (c) 2008 Universiteit Utrecht+license: BSD3+license-file: LICENSE+author: Sean Leather,+ José Pedro Magalhães,+ Alexey Rodriguez,+ Andres Löh+maintainer: generics@haskell.org+stability: experimental+extra-source-files: README+extra-tmp-files: .hpc+build-type: Custom+cabal-version: >= 1.2.1+tested-with: GHC == 6.8.3, GHC == 6.9.20080916++--------------------------------------------------------------------------------++flag test+ description: Enable the test configuration: Build the test+ executable, reduce build time.+ default: False++flag hpc+ description: Enable program coverage on test executable.+ default: False++flag nolib+ description: Don't build the library. This is useful for speeding up+ the modify-build-test loop. With "-ftest" (only), the+ build command will build both the library and the test+ executable. With "-ftest -fnolib", the build command+ builds only the test executable.+ default: False++--------------------------------------------------------------------------------++Library+ hs-source-dirs: src+ exposed-modules: Generics.EMGM++ -- Common foundation+ Generics.EMGM.Common+ Generics.EMGM.Common.Representation+ Generics.EMGM.Common.Base+ Generics.EMGM.Common.Base2+ Generics.EMGM.Common.Base3++ -- Generic functions+ Generics.EMGM.Functions+ Generics.EMGM.Functions.Collect+ Generics.EMGM.Functions.Compare+ Generics.EMGM.Functions.Crush+ Generics.EMGM.Functions.Enum+ Generics.EMGM.Functions.Map+ Generics.EMGM.Functions.Read+ Generics.EMGM.Functions.Show+ Generics.EMGM.Functions.ZipWith+ Generics.EMGM.Functions.UnzipWith++ -- Supported datatypes+ Generics.EMGM.Data+ Generics.EMGM.Data.Bool+ Generics.EMGM.Data.Either+ Generics.EMGM.Data.List+ Generics.EMGM.Data.Maybe+ Generics.EMGM.Data.Tuple++ build-depends: base >= 3.0+ extensions: CPP++ ghc-options: -Wall+ if flag(test)+ -- Faster build+ ghc-options: -O0+ else+ -- Smaller binary, more optimized?+ ghc-options: -O2++ -- This adds even more optimization, but slows the build down a lot (e.g.+ -- 5x) I think we shouldn't use it unless we can prove the benefit. [SPL]+ --ghc-options: -fvia-C -optc-O3++ -- Don't build the library+ if flag(nolib)+ buildable: False++--------------------------------------------------------------------------------++Executable test+ hs-source-dirs: src, tests, examples+ other-modules: Generics.EMGM+ extensions: CPP+ main-is: Main.hs++ ghc-options: -Wall -O0 -fno-warn-missing-signatures++ -- Add program coverage if configured with "-fhpc".+ if flag(hpc)+ ghc-options: -fhpc++ -- Only enable the build-depends here if configured with "-ftest". This+ -- keeps users from having to install QuickCheck 2 in order to use EMGM.+ if flag(test)+ build-depends: QuickCheck >= 2.0, HUnit >= 1.2+ else+ buildable: False+
+ src/Generics/EMGM.hs view
@@ -0,0 +1,34 @@+----------------------------------------------------------------------------- +-- | +-- Module : Generics.EMGM +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- \"Extensible and Modular Generics for the Masses\" --- EMGM. +-- +-- This top-level module re-exports all other modules of the +-- Generics.EMGM library. +-- +----------------------------------------------------------------------------- + +module Generics.EMGM ( + + -- * Common foundation + module Generics.EMGM.Common, + + -- * Generic functions + module Generics.EMGM.Functions, + + -- * Supported datatypes + module Generics.EMGM.Data, + +) where + +import Generics.EMGM.Common +import Generics.EMGM.Functions +import Generics.EMGM.Data +
+ src/Generics/EMGM/Common.hs view
@@ -0,0 +1,27 @@+----------------------------------------------------------------------------- +-- | +-- Module : Generics.EMGM.Common +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Exports all modules in the Generics.EMGM.Common.* hierarchy. +----------------------------------------------------------------------------- + +module Generics.EMGM.Common ( + + module Generics.EMGM.Common.Representation, + module Generics.EMGM.Common.Base, + module Generics.EMGM.Common.Base2, + module Generics.EMGM.Common.Base3, + +) where + +import Generics.EMGM.Common.Representation +import Generics.EMGM.Common.Base +import Generics.EMGM.Common.Base2 +import Generics.EMGM.Common.Base3 +
+ src/Generics/EMGM/Common/Base.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverlappingInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Common.Base+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Type classes used for generic functions with /one/ generic argument.+--+-- Generic functions using one generic argument are defined as instances of+-- 'Generic'. This class contains all of the methods (called \"type cases\" in+-- datatype-generic language) used to define the run-time type representation of+-- a datatype.+--+-- To simplify generic functions, we use type classes for representation+-- dispatching. There are \"dispatchers\" for each category of function (see+-- below) and each category has one \"Rep\" class.+--+-- Some 'Generic'-based functions operate on monomorphic values (using 'Rep').+-- The functions included with the library are:+--+-- * "Generics.EMGM.Functions.Collect"+--+-- * "Generics.EMGM.Functions.Compare"+--+-- * "Generics.EMGM.Functions.Enum"+--+-- * "Generics.EMGM.Functions.Read"+--+-- * "Generics.EMGM.Functions.Show"+--+-- Other 'Generic'-based functions operate on types of the form @f a@ (using+-- 'FRep') where @f@ is the actual generic argument (the one that needs a+-- run-time representation). The functions included with the library are:+--+-- * "Generics.EMGM.Functions.Crush"+-----------------------------------------------------------------------------++module Generics.EMGM.Common.Base (++ -- * Generic function class+ Generic(..),++ -- * Representation dispatcher classes+ Rep(..),+ FRep(..),+) where++import Generics.EMGM.Common.Representation++infixr 5 `rsum`+infixr 6 `rprod`++-- | This class forms the foundation for defining generic functions with a+-- single generic argument. Each method represents a type case. The class+-- includes cases for primitive types, cases for the structural representation,+-- and the 'rtype' case for adding support for new datatypes.+class Generic g where++ -- | Many functions perform the same operation on the non-structural cases (as+ -- well as 'Unit'). The cases for constant datatypes ('Int', 'Integer',+ -- 'Float', 'Double', 'Char', and 'Unit') have a default implementation of+ -- 'rconstant', thus a generic function may only override 'rconstant' if+ -- desired. Note that there is no default implementation for 'rconstant'+ -- itself.+ --+ -- The class context represents the intersection set of supported type+ -- classes.+ rconstant :: (Enum a, Eq a, Ord a, Read a, Show a) => g a++ -- | Case for the primitive type 'Int'. (Default implementation:+ -- 'rconstant'.)+ rint :: g Int++ -- | Case for the primitive type 'Integer'. (Default implementation:+ -- 'rconstant'.)+ rinteger :: g Integer++ -- | Case for the primitive type 'Float'. (Default implementation:+ -- 'rconstant'.)+ rfloat :: g Float++ -- | Case for the primitive type 'Double'. (Default implementation:+ -- 'rconstant'.)+ rdouble :: g Double++ -- | Case for the primitive type 'Char'. (Default implementation:+ -- 'rconstant'.)+ rchar :: g Char++ -- | Case for the structural representation type 'Unit'. It is used to+ -- represent a constructor with no arguments. (Default implementation:+ -- 'rconstant'.)+ runit :: g Unit++ -- | Case for the structural representation type '(:+:)', called \"sum\". It+ -- is used to represent alternative choices between constructors. (No+ -- default implementation.)+ rsum :: g a -> g b -> g (a :+: b)++ -- | Case for the structural representation type '(:*:)', called \"product\".+ -- It is used to represent multiple arguments to a constructor. (No+ -- default implementation.)+ rprod :: g a -> g b -> g (a :*: b)++ -- | Case for constructors. While not necessary for every generic function,+ -- this method is required for 'Read' and 'Show'. It is used to hold the+ -- meta-information about a constructor ('ConDescr'), e.g. name, arity,+ -- fixity, etc. (Since most generic functions do not use 'rcon' and simply pass+ -- the value through, the default implementation is @const id@.)+ rcon :: ConDescr -> g a -> g a++ -- | Case for datatypes. This method is used to define the structural+ -- representation of an arbitrary Haskell datatype. The first argument is the+ -- embedding-projection pair, necessary for establishing the isomorphism+ -- between datatype and representation. The second argument is the+ -- run-time representation using the methods of 'Generic'. (No default+ -- implementation.)+ rtype :: EP b a -> g a -> g b++ rint = rconstant+ rinteger = rconstant+ rfloat = rconstant+ rdouble = rconstant+ rchar = rconstant+ runit = rconstant++ rcon = const id++-- | The 'Generic' representation dispatcher for monomorphic types (kind @*@).+-- Every structure type and supported datatype should have an instance of+-- 'Rep'. (No default implementation.)+class Rep g a where+ rep :: g a++instance (Generic g) => Rep g Int where+ rep = rint++instance (Generic g) => Rep g Integer where+ rep = rinteger++instance (Generic g) => Rep g Float where+ rep = rfloat++instance (Generic g) => Rep g Double where+ rep = rdouble++instance (Generic g) => Rep g Char where+ rep = rchar++instance (Generic g) => Rep g Unit where+ rep = runit++instance (Generic g, Rep g a, Rep g b) => Rep g (a :+: b) where+ rep = rsum rep rep++instance (Generic g, Rep g a, Rep g b) => Rep g (a :*: b) where+ rep = rprod rep rep++-- | The 'Generic' representation dispatcher for datatypes of functional kind+-- @* -> *@, often called container types, type constructors, or functor types.+-- (No default implementation.)+class FRep g f where+ frep :: g a -> g (f a)+
+ src/Generics/EMGM/Common/Base2.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Common.Base2+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Type classes used for generic functions with /two/ generic+-- arguments.+--+-- Generic functions using two generic arguments are defined as instances of+-- 'Generic2'. This class contains all of the methods (called \"type cases\" in+-- datatype-generic language) used to define the run-time type representation of+-- a datatype.+--+-- 'Generic2'-based functions have a representation dispatcher type class+-- 'FRep2'.+--+-- The functions included with the library are:+--+-- * "Generics.EMGM.Functions.Map"+-----------------------------------------------------------------------------++module Generics.EMGM.Common.Base2 (++ -- * Generic function class+ Generic2(..),++ -- * Representation dispatcher classes+ FRep2(..),+) where++import Generics.EMGM.Common.Representation++infixr 5 `rsum2`+infixr 6 `rprod2`++-- | This class forms the foundation for defining generic functions with two+-- generic arguments. Each method represents a type case. The class includes+-- cases for primitive types, cases for the structural representation, and the+-- 'rtype' case for adding support for new datatypes.+class Generic2 g where++ -- | Many functions perform the same operation on the non-structural cases (as+ -- well as 'Unit'). The cases for constant datatypes ('Int', 'Integer',+ -- 'Float', 'Double', 'Char', and 'Unit') have a default implementation of+ -- 'rconstant2', thus a generic function may only override 'rconstant2' if+ -- desired. Note that there is no default implementation for 'rconstant2'+ -- itself.+ --+ -- The class context represents the intersection set of supported type+ -- classes.+ rconstant2 :: (Enum a, Eq a, Ord a, Read a, Show a) => g a a++ -- | Case for the primitive type 'Int'. (Default implementation:+ -- 'rconstant2'.)+ rint2 :: g Int Int++ -- | Case for the primitive type 'Integer'. (Default implementation:+ -- 'rconstant2'.)+ rinteger2 :: g Integer Integer++ -- | Case for the primitive type 'Float'. (Default implementation:+ -- 'rconstant2'.)+ rfloat2 :: g Float Float++ -- | Case for the primitive type 'Double'. (Default implementation:+ -- 'rconstant2'.)+ rdouble2 :: g Double Double++ -- | Case for the primitive type 'Char'. (Default implementation:+ -- 'rconstant2'.)+ rchar2 :: g Char Char++ -- | Case for the structural representation type 'Unit'. It is used to+ -- represent a constructor with no arguments. (Default implementation:+ -- 'rconstant2'.)+ runit2 :: g Unit Unit++ -- | Case for the structural representation type '(:+:)', called \"sum\". It+ -- is used to represent alternative choices between constructors. (No+ -- default implementation.)+ rsum2 :: g a1 a2 -> g b1 b2 -> g (a1 :+: b1) (a2 :+: b2)++ -- | Case for the structural representation type '(:*:)', called \"product\".+ -- It is used to represent multiple arguments to a constructor. (No+ -- default implementation.)+ rprod2 :: g a1 a2 -> g b1 b2 -> g (a1 :*: b1) (a2 :*: b2)++ -- | Case for constructors. It is used to hold the meta-information about a+ -- constructor ('ConDescr'), e.g. name, arity, fixity, etc. (Since most+ -- generic functions do not use 'rcon' and simply pass the value through, the+ -- default implementation is @const id@.)+ rcon2 :: ConDescr -> g a1 a2 -> g a1 a2++ -- | Case for datatypes. This method is used to define the structural+ -- representation of an arbitrary Haskell datatype. The first two arguments+ -- are the embedding-projection pairs, necessary for establishing the+ -- isomorphisms between datatype and representation of the two generic types.+ -- The third argument is the run-time representation using the methods of+ -- 'Generic2'. (No default implementation.)+ rtype2 :: EP a2 a1 -> EP b2 b1 -> g a1 b1 -> g a2 b2++ rint2 = rconstant2+ rinteger2 = rconstant2+ rfloat2 = rconstant2+ rdouble2 = rconstant2+ rchar2 = rconstant2+ runit2 = rconstant2++ rcon2 = const id++-- | The 'Generic2' representation dispatcher for datatypes of functional kind+-- @* -> *@, often called container types, type constructors, or functor types.+-- (No default implementation.)+class FRep2 g f where+ frep2 :: g a b -> g (f a) (f b)+
+ src/Generics/EMGM/Common/Base3.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Common.Base3+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Type classes used for generic functions with /three/ generic+-- arguments.+--+-- Generic functions using three generic arguments are defined as instances of+-- 'Generic3'. This class contains all of the methods (called \"type cases\" in+-- datatype-generic language) used to define the run-time type representation of+-- a datatype.+--+-- 'Generic3'-based functions have a non-extensible representation dispatcher+-- type class, 'FRep3'.+--+-- The functions included with the library are:+--+-- * "Generics.EMGM.Functions.UnzipWith"+--+-- * "Generics.EMGM.Functions.ZipWith"+-----------------------------------------------------------------------------++module Generics.EMGM.Common.Base3 (++ -- * Generic function class+ Generic3(..),++ -- * Representation dispatcher classes+ FRep3(..),+) where++import Generics.EMGM.Common.Representation++infixr 5 `rsum3`+infixr 6 `rprod3`++-- | This class forms the foundation for defining generic functions with three+-- generic arguments. Each method represents a type case. The class includes+-- cases for primitive types, cases for the structural representation, and the+-- 'rtype' case for adding support for new datatypes.+class Generic3 g where++ -- | Many functions perform the same operation on the non-structural cases (as+ -- well as 'Unit'). The cases for constant datatypes ('Int', 'Integer',+ -- 'Float', 'Double', 'Char', and 'Unit') have a default implementation of+ -- 'rconstant3', thus a generic function may only override 'rconstant3' if+ -- desired. Note that there is no default implementation for 'rconstant3'+ -- itself.+ --+ -- The class context represents the intersection set of supported type+ -- classes.+ rconstant3 :: (Enum a, Eq a, Ord a, Read a, Show a) => g a a a++ -- | Case for the primitive type 'Int'. (Default implementation:+ -- 'rconstant3'.)+ rint3 :: g Int Int Int++ -- | Case for the primitive type 'Integer'. (Default implementation:+ -- 'rconstant3'.)+ rinteger3 :: g Integer Integer Integer++ -- | Case for the primitive type 'Float'. (Default implementation:+ -- 'rconstant3'.)+ rfloat3 :: g Float Float Float++ -- | Case for the primitive type 'Double'. (Default implementation:+ -- 'rconstant3'.)+ rdouble3 :: g Double Double Double++ -- | Case for the primitive type 'Char'. (Default implementation:+ -- 'rconstant3'.)+ rchar3 :: g Char Char Char++ -- | Case for the structural representation type 'Unit'. It is used to+ -- represent a constructor with no arguments. (Default implementation:+ -- 'rconstant3'.)+ runit3 :: g Unit Unit Unit++ -- | Case for the structural representation type '(:+:)', called \"sum\". It+ -- is used to represent alternative choices between constructors. (No+ -- default implementation.)+ rsum3 :: g a1 a2 a3 -> g b1 b2 b3 -> g (a1 :+: b1) (a2 :+: b2) (a3 :+: b3)++ -- | Case for the structural representation type '(:*:)', called \"product\".+ -- It is used to represent multiple arguments to a constructor. (No+ -- default implementation.)+ rprod3 :: g a1 a2 a3 -> g b1 b2 b3 -> g (a1 :*: b1) (a2 :*: b2) (a3 :*: b3)++ -- | Case for constructors. It is used to hold the meta-information about a+ -- constructor ('ConDescr'), e.g. name, arity, fixity, etc. (Since most+ -- generic functions do not use 'rcon' and simply pass the value through, the+ -- default implementation is @const id@.)+ rcon3 :: ConDescr -> g a1 a2 a3 -> g a1 a2 a3++ -- | Case for datatypes. This method is used to define the structural+ -- representation of an arbitrary Haskell datatype. The first three arguments+ -- are the embedding-projection pairs, necessary for establishing the+ -- isomorphisms between datatype and representation of the four generic types.+ -- The fourth argument is the run-time representation using the methods of+ -- 'Generic3'. (No default implementation.)+ rtype3 :: EP a2 a1 -> EP b2 b1 -> EP c2 c1 -> g a1 b1 c1 -> g a2 b2 c2++ rint3 = rconstant3+ rinteger3 = rconstant3+ rfloat3 = rconstant3+ rdouble3 = rconstant3+ rchar3 = rconstant3+ runit3 = rconstant3++ rcon3 = const id++-- | The 'Generic3' representation dispatcher for datatypes of functional kind+-- @* -> *@, often called container types, type constructors, or functor types.+-- (No default implementation.)+class FRep3 g f where+ frep3 :: g a b c -> g (f a) (f b) (f c)+
+ src/Generics/EMGM/Common/Representation.hs view
@@ -0,0 +1,169 @@+-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Common.Representation+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Types and related functions for the representation used in EMGM.+--+-- EMGM uses a generic sum-of-products view of datatypes encoded into the+-- 'Unit', '(:^:)' (sum), and '(:*:)' (product). Many Haskell datatypes can be+-- represented in this way. Right-nested sums replace the @|@, and right-nested+-- products replace the arguments to a constructor. Units replace constructors+-- with no arguments.+--+-- Since constructors encode more than just a list of arguments, this library+-- uses 'ConDescr' to store that information. This includes name, arity, record+-- labels, fixity, and operator precedence. Constructor descriptions are useful+-- for generic operations such as 'Read' and 'Show' and possibly others.+--+-- Generic functions need to convert values between the Haskell datatype and its+-- structure representation. This is done using the embedding-projection pair,+-- which is simply a pair a functions for translating between two types.+--+-----------------------------------------------------------------------------++module Generics.EMGM.Common.Representation (++ -- * Structure representation+ -- | The generic sum-of-products view of a Haskell datatype.++ Unit(..),+ (:+:)(..),+ (:*:)(..),++ -- * Constructor description+ -- | Since this library does not have access to the syntax of a @data@+ -- declaration, it relies on 'ConDescr' for meta-information. It is+ -- important that the 'ConDescr' for a constructor accurately describe the+ -- actual syntax in the declaration. An incorrect description may lead to+ -- bad 'Read' or 'Show' operation.++ ConDescr(..),+ ConType(..),++ -- * Fixity and precedence+ -- | These are used to determine whether a constructor is infix or not and, if+ -- it is infix, what its associativity and precedence are.++ Fixity(..),+ Prec,+ prec,+ minPrec,+ maxPrec,+ appPrec,+ recPrec,++ -- * Embedding-projection pair++ EP(..),++ ) where++import Text.ParserCombinators.ReadPrec (minPrec, Prec)++infixr 5 :+:+infixr 6 :*:++-- | 'Unit' encodes a constructor with no arguments. An analogous standard+-- Haskell type is @()@.+data Unit+ = Unit -- ^ The only value of type 'Unit' (ignoring @_|_@).+ deriving (Enum, Eq, Ord)++-- | The Read instance for Unit should always return a value and consume nothing+-- of the input, because there is no string representation for it. This allows+-- us to use 'readPrec' in the 'rconstant' method of the generic 'Read'+-- definition.+instance Read Unit where+ readsPrec _ s = [(Unit, s)]++-- | The Show instance for Unit should return an empty string, because there is+-- no representation for it. This allows us to use 'showsPrec' in the+-- 'rconstant' method of the generic 'Show' definition.+instance Show Unit where+ showsPrec _ _ = id++-- | The \"sum\" encodes 2 constructor alternatives. An analogous standard+-- Haskell type is @'Either' a b@.+data a :+: b+ = L a -- ^ Left alternative+ | R b -- ^ Right alternative+ deriving (Eq, Ord, Read, Show)++-- | The \"product\" encodes 2 constructor arguments. An analogous standard+-- Haskell type is @(a, b)@.+data a :*: b+ = a :*: b -- ^ A pair of arguments+ deriving (Eq, Ord, Read, Show)++-- | The Embedding-Projection pair contains two functions for converting between+-- the datatype and its representation. This pair preserves an isomorphism+-- (ignoring @_|_@s) between a datatype and its structure.+data EP d r+ = EP+ { from :: (d -> r) -- ^ Embed a @d@atatype into its @r@epresentation.+ , to :: (r -> d) -- ^ Project @d@atatype from its @r@epresentation.+ }++-- | A constructor description containing useful meta-information about the+-- syntax used in the data declaration. This is particularly useful in 'Read'+-- and 'Show' but may also be helpful in other generic functions.+data ConDescr+ = ConDescr+ { conName :: String -- ^ Name of the constructor. If it is infix,+ -- don't provide parentheses.++ , conArity :: Int -- ^ Arity or number of arguments.++ , conLabels :: [String] -- ^ A list of labels used in record syntax.+ -- They must be declared in the same order as+ -- the @data@ declaration. The list should be+ -- empty if the constructor is not a record.++ , conFixity :: Fixity -- ^ Infix or not, associativity, precedence.+ }+ deriving Show++-- | The constructor type used in 'Read' and 'Show' to determine how to parse or+-- print the constructor.+data ConType+ = ConStd -- ^ Standard (function-type, nonfix)+ | ConRec [String] -- ^ Record-style (nonfix or infix)+ | ConIfx String -- ^ Infix (no record syntax)+ deriving Show++-- TODO: Need smart constructor(s) for ConDescr, so we can verify things.++-- | Determine an identifier's status as infix or not. If infix, the+-- associativity and precedence are also determined.+data Fixity+ = Nonfix -- ^ Not infix. Precedence is same as function application (see 'appPrec').+ | Infix Prec -- ^ Non-associative infix with precedence.+ | Infixl Prec -- ^ Left-associative infix with precedence.+ | Infixr Prec -- ^ Right-associative Infix with precedence.+ deriving (Eq, Show)++-- | Get the precedence of a fixity value.+prec :: Fixity -> Prec+prec Nonfix = appPrec+prec (Infix n) = n+prec (Infixl n) = n+prec (Infixr n) = n++-- | Maximum precedence: 11+maxPrec :: Prec+maxPrec = 11++-- | Precedence for function application: 10+appPrec :: Prec+appPrec = 10++-- | Precedence for record construction: 11+recPrec :: Prec+recPrec = appPrec + 1+
+ src/Generics/EMGM/Data.hs view
@@ -0,0 +1,29 @@+----------------------------------------------------------------------------- +-- | +-- Module : Generics.EMGM.Data +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Exports all modules in the Generics.EMGM.Data.* hierarchy. +----------------------------------------------------------------------------- + +module Generics.EMGM.Data ( + + module Generics.EMGM.Data.Bool, + module Generics.EMGM.Data.Either, + module Generics.EMGM.Data.List, + module Generics.EMGM.Data.Maybe, + module Generics.EMGM.Data.Tuple, + +) where + +import Generics.EMGM.Data.Bool +import Generics.EMGM.Data.Either +import Generics.EMGM.Data.List +import Generics.EMGM.Data.Maybe +import Generics.EMGM.Data.Tuple +
+ src/Generics/EMGM/Data/Bool.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverlappingInstances #-}+{-# OPTIONS -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Data.Bool+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic representation and instances for 'Bool'.+--+-- This module exports the reusable components of the 'Bool'+-- representation. These include the embedding-projection pair used in a type+-- representation as well as the type representation of 'Bool' for+-- 'Generic'.+--+-- This module also exports the instance for the representation dispatcher+-- 'Rep'.+-----------------------------------------------------------------------------++module Generics.EMGM.Data.Bool (++ -- * Embedding-projection pair+ epBool,++ -- * Representation+ rBool,+) where++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Embedding-projection pair+-----------------------------------------------------------------------------++fromBool :: Bool -> Unit :+: Unit+fromBool False = L Unit+fromBool True = R Unit++toBool :: Unit :+: Unit -> Bool+toBool (L Unit) = False+toBool (R Unit) = True++-- | Embedding-projection pair for @Bool@+epBool :: EP Bool (Unit :+: Unit)+epBool = EP fromBool toBool++-----------------------------------------------------------------------------+-- Representation values+-----------------------------------------------------------------------------++conFalse, conTrue :: ConDescr+conFalse = ConDescr "False" 0 [] Nonfix+conTrue = ConDescr "True" 0 [] Nonfix++-- | Representation for @Bool@ in 'Generic'+rBool :: (Generic g) => g Bool+rBool = rtype epBool (rcon conFalse runit `rsum` rcon conTrue runit)++-----------------------------------------------------------------------------+-- Instance declarations+-----------------------------------------------------------------------------++instance (Generic g) => Rep g Bool where+ rep = rBool+
+ src/Generics/EMGM/Data/Either.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverlappingInstances #-}+{-# OPTIONS -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Data.Either+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic representation and instances for @'Either' a b@.+--+-- This module exports the reusable components of the @'Either' a b@+-- representation. These include the embedding-projection pair used in a type+-- representation as well as the type representation of @'Either' a b@ for+-- 'Generic'.+--+-- This module also exports the instance for the representation dispatcher+-- 'Rep'.+-----------------------------------------------------------------------------++module Generics.EMGM.Data.Either (++ -- * Embedding-projection pair+ epEither,++ -- * Representation+ rEither,+) where++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Embedding-projection pair+-----------------------------------------------------------------------------++fromEither :: Either a b -> a :+: b+fromEither (Left a) = L a+fromEither (Right b) = R b++toEither :: a :+: b -> Either a b+toEither (L a) = Left a+toEither (R b) = Right b++-- | Embedding-projection pair for @Either a b@+epEither :: EP (Either a b) (a :+: b)+epEither = EP fromEither toEither++-----------------------------------------------------------------------------+-- Representation values+-----------------------------------------------------------------------------++conLeft, conRight :: ConDescr+conLeft = ConDescr "Left" 1 [] Nonfix+conRight = ConDescr "Right" 1 [] Nonfix++-- | Representation for @Either a b@ in 'Generic'+rEither :: (Generic g) => g a -> g b -> g (Either a b)+rEither ra rb = rtype epEither (rcon conLeft ra `rsum` rcon conRight rb)++-----------------------------------------------------------------------------+-- Instance declarations+-----------------------------------------------------------------------------++instance (Generic g, Rep g a, Rep g b) => Rep g (Either a b) where+ rep = rEither rep rep+
+ src/Generics/EMGM/Data/List.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-}+{-# OPTIONS -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Data.List+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic representation and instances for @[a]@.+--+-- This module exports the reusable components of the @[a]@ representation.+-- These include the embedding-projection pair used in a type representation as+-- well as the type representations of @[a]@ for 'Generic', 'Generic2', and+-- 'Generic3'.+--+-- This module also exports the instances for the representation dispatchers+-- 'Rep', 'FRep', 'FRep2', and 'FRep3'.+-----------------------------------------------------------------------------++module Generics.EMGM.Data.List (++ -- * Embedding-projection pair+ epList,++ -- * Representations+ rList,+ rList2,+ rList3+) where++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Embedding-projection pair+-----------------------------------------------------------------------------++fromList :: [a] -> Unit :+: (a :*: [a])+fromList [] = L Unit+fromList (a : as) = R (a :*: as)++toList :: Unit :+: (a :*: [a]) -> [a]+toList (L Unit) = []+toList (R (a :*: as)) = a : as++-- | Embedding-projection pair for @[a]@+epList :: EP [a] (Unit :+: (a :*: [a]))+epList = EP fromList toList++-----------------------------------------------------------------------------+-- Representation values+-----------------------------------------------------------------------------++conNil, conCons :: ConDescr+conNil = ConDescr "[]" 0 [] Nonfix+conCons = ConDescr ":" 2 [] (Infixr 5)++-- | Representation for @[a]@ in 'Generic'+rList :: (Generic g) => g a -> g [a]+rList ra =+ rtype epList+ (rcon conNil runit `rsum` rcon conCons (ra `rprod` rList ra))++-- | Representation for @[a]@ in 'Generic2'+rList2 :: (Generic2 g) => g a b -> g [a] [b]+rList2 ra =+ rtype2 epList epList+ (rcon2 conNil runit2 `rsum2` rcon2 conCons (ra `rprod2` rList2 ra))++-- | Representation for @[a]@ in 'Generic3'+rList3 :: (Generic3 g) => g a b c -> g [a] [b] [c]+rList3 ra =+ rtype3 epList epList epList+ (rcon3 conNil runit3 `rsum3` rcon3 conCons (ra `rprod3` rList3 ra))++-----------------------------------------------------------------------------+-- Instance declarations+-----------------------------------------------------------------------------++instance (Generic g, Rep g a) => Rep g [a] where+ rep = rList rep++instance (Generic g) => FRep g [] where+ frep = rList++instance (Generic2 g) => FRep2 g [] where+ frep2 = rList2++instance (Generic3 g) => FRep3 g [] where+ frep3 = rList3+
+ src/Generics/EMGM/Data/Maybe.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverlappingInstances #-}+{-# OPTIONS -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Data.Maybe+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic representation and instances for @'Maybe' a@.+--+-- This module exports the reusable components of the @'Maybe' a@ representation.+-- These include the embedding-projection pair used in a type representation as+-- well as the type representations of @'Maybe' a@ for 'Generic', 'Generic2',+-- and 'Generic3'.+--+-- This module also exports the instances for the representation dispatchers+-- 'Rep', 'FRep', 'FRep2', and 'FRep3'.+--+-----------------------------------------------------------------------------++module Generics.EMGM.Data.Maybe (++ -- * Embedding-projection pair+ epMaybe,++ -- * Representations+ rMaybe,+ rMaybe2,+ rMaybe3,+) where++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Embedding-projection pair+-----------------------------------------------------------------------------++fromMaybe :: Maybe a -> Unit :+: a+fromMaybe Nothing = L Unit+fromMaybe (Just a) = R a++toMaybe :: Unit :+: a -> Maybe a+toMaybe (L Unit) = Nothing+toMaybe (R a) = Just a++-- | Embedding-projection pair for @Maybe a@+epMaybe :: EP (Maybe a) (Unit :+: a)+epMaybe = EP fromMaybe toMaybe++-----------------------------------------------------------------------------+-- Representation values+-----------------------------------------------------------------------------++conNothing, conJust :: ConDescr+conNothing = ConDescr "Nothing" 0 [] Nonfix+conJust = ConDescr "Just" 1 [] Nonfix++-- | Representation for @Maybe a@ in 'Generic'+rMaybe :: (Generic g) => g a -> g (Maybe a)+rMaybe ra =+ rtype epMaybe+ (rcon conNothing runit `rsum` rcon conJust ra)++-- | Representation for @Maybe a@ in 'Generic2'+rMaybe2 :: (Generic2 g) => g a b -> g (Maybe a) (Maybe b)+rMaybe2 ra =+ rtype2 epMaybe epMaybe+ (rcon2 conNothing runit2 `rsum2` rcon2 conJust ra)++-- | Representation for @Maybe a@ in 'Generic3'+rMaybe3 :: (Generic3 g) => g a b c -> g (Maybe a) (Maybe b) (Maybe c)+rMaybe3 ra =+ rtype3 epMaybe epMaybe epMaybe+ (rcon3 conNothing runit3 `rsum3` rcon3 conJust ra)++-----------------------------------------------------------------------------+-- Instance declarations+-----------------------------------------------------------------------------++instance (Generic g, Rep g a) => Rep g (Maybe a) where+ rep = rMaybe rep++instance (Generic g) => FRep g Maybe where+ frep = rMaybe++instance (Generic2 g) => FRep2 g Maybe where+ frep2 = rMaybe2++instance (Generic3 g) => FRep3 g Maybe where+ frep3 = rMaybe3+
+ src/Generics/EMGM/Data/Tuple.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-}+{-# OPTIONS -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Data.Tuple+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic representation and instances for tuples of arity 0+-- (a.k.a. unit) and 2 to 7.+--+-- This module exports the reusable components of tuple representations. These+-- include the embedding-projection pair used in a type representation as well+-- as the type representations for 'Generic'.+--+-- This module also exports the instances for the representation dispatcher+-- 'Rep'.+-----------------------------------------------------------------------------++module Generics.EMGM.Data.Tuple (++ -- * Embedding-projection pairs+ epTuple0,+ epTuple2,+ epTuple3,+ epTuple4,+ epTuple5,+ epTuple6,+ epTuple7,++ -- * Representations+ rTuple0,+ rTuple2,+ rTuple3,+ rTuple4,+ rTuple5,+ rTuple6,+ rTuple7,+) where++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- 0: ()+-----------------------------------------------------------------------------++-- | Embedding-projection pair for @()@+epTuple0 :: EP () Unit+epTuple0 = EP (\() -> Unit)+ (\Unit -> ())++conTuple0 :: ConDescr+conTuple0 = ConDescr "()" 0 [] Nonfix++-- | Representation for @()@ in 'Generic'+rTuple0 :: Generic g => g ()+rTuple0 =+ rtype epTuple0 $+ rcon conTuple0 runit++-----------------------------------------------------------------------------+-- 2: (a,b)+-----------------------------------------------------------------------------++-- | Embedding-projection pair for @(a,b)@+epTuple2 :: EP (a,b) (a :*: b)+epTuple2 = EP (\(a,b) -> a :*: b)+ (\(a :*: b) -> (a,b))++conTuple2 :: ConDescr+conTuple2 = ConDescr "(,)" 2 [] Nonfix++-- | Representation for @(a,b)@ in 'Generic'+rTuple2 :: Generic g => g a -> g b -> g (a,b)+rTuple2 ra rb =+ rtype epTuple2 $+ rcon conTuple2 (ra `rprod` rb)++-----------------------------------------------------------------------------+-- 3: (a,b,c)+-----------------------------------------------------------------------------++-- | Embedding-projection pair for @(a,b,c)@+epTuple3 :: EP (a,b,c) (a :*: b :*: c)+epTuple3 = EP (\(a,b,c) -> a :*: b :*: c)+ (\(a :*: b :*: c) -> (a,b,c))++conTuple3 :: ConDescr+conTuple3 = ConDescr "(,,)" 3 [] Nonfix++-- | Representation for @(a,b,c)@ in 'Generic'+rTuple3 :: Generic g => g a -> g b -> g c -> g (a,b,c)+rTuple3 ra rb rc =+ rtype epTuple3 $+ rcon conTuple3 (ra `rprod` rb `rprod` rc)++-----------------------------------------------------------------------------+-- 4: (a,b,c,d)+-----------------------------------------------------------------------------++-- | Embedding-projection pair for @(a,b,c,d)@+epTuple4 :: EP (a,b,c,d) (a :*: b :*: c :*: d)+epTuple4 = EP (\(a,b,c,d) -> a :*: b :*: c :*: d)+ (\(a :*: b :*: c :*: d) -> (a,b,c,d))++conTuple4 :: ConDescr+conTuple4 = ConDescr "(,,,)" 4 [] Nonfix++-- | Representation for @(a,b,c,d)@ in 'Generic'+rTuple4 :: Generic g => g a -> g b -> g c -> g d -> g (a,b,c,d)+rTuple4 ra rb rc rd =+ rtype epTuple4 $+ rcon conTuple4 (ra `rprod` rb `rprod` rc `rprod` rd)++-----------------------------------------------------------------------------+-- 5: (a,b,c,d,e)+-----------------------------------------------------------------------------++-- | Embedding-projection pair for @(a,b,c,d,e)@+epTuple5 :: EP (a,b,c,d,e) (a :*: b :*: c :*: d :*: e)+epTuple5 = EP (\(a,b,c,d,e) -> a :*: b :*: c :*: d :*: e)+ (\(a :*: b :*: c :*: d :*: e) -> (a,b,c,d,e))++conTuple5 :: ConDescr+conTuple5 = ConDescr "(,,,,)" 5 [] Nonfix++-- | Representation for @(a,b,c,d,e)@ in 'Generic'+rTuple5 :: Generic g => g a -> g b -> g c -> g d -> g e -> g (a,b,c,d,e)+rTuple5 ra rb rc rd re =+ rtype epTuple5 $+ rcon conTuple5 (ra `rprod` rb `rprod` rc `rprod` rd `rprod` re)++-----------------------------------------------------------------------------+-- 6: (a,b,c,d,e,f)+-----------------------------------------------------------------------------++-- | Embedding-projection pair for @(a,b,c,d,e,f)@+epTuple6 :: EP (a,b,c,d,e,f) (a :*: b :*: c :*: d :*: e :*: f)+epTuple6 = EP (\(a,b,c,d,e,f) -> a :*: b :*: c :*: d :*: e :*: f)+ (\(a :*: b :*: c :*: d :*: e :*: f) -> (a,b,c,d,e,f))++conTuple6 :: ConDescr+conTuple6 = ConDescr "(,,,,,)" 6 [] Nonfix++-- | Representation for @(a,b,c,d,e,f)@ in 'Generic'+rTuple6 :: Generic g => g a -> g b -> g c -> g d -> g e -> g f -> g (a,b,c,d,e,f)+rTuple6 ra rb rc rd re rf =+ rtype epTuple6 $+ rcon conTuple6 (ra `rprod` rb `rprod` rc `rprod` rd `rprod` re `rprod` rf)+++-----------------------------------------------------------------------------+-- 7: (a,b,c,d,e,f,h)+-----------------------------------------------------------------------------++-- | Embedding-projection pair for @(a,b,c,d,e,f,h)@+epTuple7 :: EP (a,b,c,d,e,f,h) (a :*: b :*: c :*: d :*: e :*: f :*: h)+epTuple7 = EP (\(a,b,c,d,e,f,h) -> a :*: b :*: c :*: d :*: e :*: f :*: h)+ (\(a :*: b :*: c :*: d :*: e :*: f :*: h) -> (a,b,c,d,e,f,h))++conTuple7 :: ConDescr+conTuple7 = ConDescr "(,,,,,)" 7 [] Nonfix++-- | Representation for @(a,b,c,d,e,f,h)@ in 'Generic'+rTuple7 :: Generic g => g a -> g b -> g c -> g d -> g e -> g f -> g h -> g (a,b,c,d,e,f,h)+rTuple7 ra rb rc rd re rf rh =+ rtype epTuple7 $+ rcon conTuple7 (ra `rprod` rb `rprod` rc `rprod` rd `rprod` re `rprod` rf `rprod` rh)++-----------------------------------------------------------------------------+-- Instance declarations+-----------------------------------------------------------------------------++instance (Generic g) => Rep g () where+ rep = rTuple0++instance (Generic g, Rep g a, Rep g b) => Rep g (a,b) where+ rep = rTuple2 rep rep++instance (Generic g, Rep g a, Rep g b, Rep g c) => Rep g (a,b,c) where+ rep = rTuple3 rep rep rep++instance (Generic g, Rep g a, Rep g b, Rep g c, Rep g d) => Rep g (a,b,c,d) where+ rep = rTuple4 rep rep rep rep++instance (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e) => Rep g (a,b,c,d,e) where+ rep = rTuple5 rep rep rep rep rep++instance (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e, Rep g f) => Rep g (a,b,c,d,e,f) where+ rep = rTuple6 rep rep rep rep rep rep++instance (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e, Rep g f, Rep g h) => Rep g (a,b,c,d,e,f,h) where+ rep = rTuple7 rep rep rep rep rep rep rep++
+ src/Generics/EMGM/Functions.hs view
@@ -0,0 +1,36 @@+----------------------------------------------------------------------------- +-- | +-- Module : Generics.EMGM.Functions +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Exports all modules in the Generics.EMGM.Functions.* hierarchy. +----------------------------------------------------------------------------- + +module Generics.EMGM.Functions ( + + module Generics.EMGM.Functions.Collect, + module Generics.EMGM.Functions.Compare, + module Generics.EMGM.Functions.Crush, + module Generics.EMGM.Functions.Enum, + module Generics.EMGM.Functions.Map, + module Generics.EMGM.Functions.Read, + module Generics.EMGM.Functions.Show, + module Generics.EMGM.Functions.UnzipWith, + module Generics.EMGM.Functions.ZipWith, + +) where + +import Generics.EMGM.Functions.Collect +import Generics.EMGM.Functions.Compare +import Generics.EMGM.Functions.Crush +import Generics.EMGM.Functions.Enum +import Generics.EMGM.Functions.Map +import Generics.EMGM.Functions.Read +import Generics.EMGM.Functions.Show +import Generics.EMGM.Functions.UnzipWith +import Generics.EMGM.Functions.ZipWith
+ src/Generics/EMGM/Functions/Collect.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.Collect+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic function that collects all values of a specified type from a+-- generic value.+--+-- 'collect' works by searching a datatype for values that are the same type as+-- the return type specified. Here are some examples using the same value but+-- different return types:+--+-- @+-- GHCi> collect [Just 1, Nothing, Just (2 :: Int)] :: [Int]+-- [1,2]+-- GHCi> collect [Just 1, Nothing, Just (2 :: Int)] :: [Maybe Int]+-- [Just 1,Nothing,Just 2]+-- GHCi> collect [Just 1, Nothing, Just (2 :: Int)] :: [[Maybe Int]]+-- [[Just 1,Nothing,Just 2]]+-- @+--+-- Note that the number @2@ has the type @Int@. Some arguments (such as numeric+-- constants which have type @Num a => a@) may need explicit type annotations.+-- By design, there is no connection that can be inferred between the return+-- type and the argument type.+--+-- 'collect' only works if the return type has been made an instance of 'Rep'.+-- The library provides instances for all datatypes with included+-- representation.+--+-- An instance is trivial to write. Given a type @D@, the 'Rep' instance looks+-- like this:+--+-- > {-# LANGUAGE OverlappingInstances #-}+-- >+-- > data D = ...+-- >+-- > instance Rep (Collect D) D where+-- > rep = Collect (:[])+--+-- (Note the requirement of overlapping instances.) This instance triggers when+-- the result type (the first @D@) matches some value type (the second @D@)+-- contained within the argument to 'collect'. See the source of this module for+-- more examples.+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.Collect (+ Collect(..),+ collect,+) where++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++-- | Type for 'collect'+newtype Collect b a = Collect { selCollect :: a -> [b] }++-----------------------------------------------------------------------------+-- Generic instance declaration+-----------------------------------------------------------------------------++rconstantCollect :: a -> [b]+rconstantCollect _ = []++rsumCollect :: Collect c a -> Collect c b -> a :+: b -> [c]+rsumCollect ra _ (L a) = selCollect ra a+rsumCollect _ rb (R b) = selCollect rb b++rprodCollect :: Collect c a -> Collect c b -> a :*: b -> [c]+rprodCollect ra rb (a :*: b) = selCollect ra a ++ selCollect rb b++rtypeCollect :: EP b a -> Collect c a -> b -> [c]+rtypeCollect ep ra b = selCollect ra (from ep b)++rconCollect :: ConDescr -> Collect c a -> a -> [c]+rconCollect _ = selCollect++instance Generic (Collect b) where+ rconstant = Collect rconstantCollect+ rsum ra rb = Collect (rsumCollect ra rb)+ rprod ra rb = Collect (rprodCollect ra rb)+ rcon cd ra = Collect (rconCollect cd ra)+ rtype ep ra = Collect (rtypeCollect ep ra)++-----------------------------------------------------------------------------+-- Rep instance declarations+-----------------------------------------------------------------------------++instance Rep (Collect Int) Int where+ rep = Collect (:[])++instance Rep (Collect Integer) Integer where+ rep = Collect (:[])++instance Rep (Collect Float) Float where+ rep = Collect (:[])++instance Rep (Collect Double) Double where+ rep = Collect (:[])++instance Rep (Collect Char) Char where+ rep = Collect (:[])++instance Rep (Collect Bool) Bool where+ rep = Collect (:[])++instance Rep (Collect (Either a b)) (Either a b) where+ rep = Collect (:[])++instance Rep (Collect [a]) [a] where+ rep = Collect (:[])++instance Rep (Collect (Maybe a)) (Maybe a) where+ rep = Collect (:[])++instance Rep (Collect ()) () where+ rep = Collect (:[])++instance Rep (Collect (a,b)) (a,b) where+ rep = Collect (:[])++instance Rep (Collect (a,b,c)) (a,b,c) where+ rep = Collect (:[])++instance Rep (Collect (a,b,c,d)) (a,b,c,d) where+ rep = Collect (:[])++instance Rep (Collect (a,b,c,d,e)) (a,b,c,d,e) where+ rep = Collect (:[])++instance Rep (Collect (a,b,c,d,e,f)) (a,b,c,d,e,f) where+ rep = Collect (:[])++instance Rep (Collect (a,b,c,d,e,f,h)) (a,b,c,d,e,f,h) where+ rep = Collect (:[])++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Collect values of type @b@ from some value of type @a@. An empty list means+-- no values were collected. If you expected otherwise, be sure that you have an+-- instance such as @'Rep' ('Collect' B) B@ for the type @B@ that you are+-- collecting. See the description of this module for details.+collect :: (Rep (Collect b) a) => a -> [b]+collect = selCollect rep+
+ src/Generics/EMGM/Functions/Compare.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.Compare+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic functions for comparing two values in different ways.+--+-- The fundamental function here is 'compare', a function that returns the+-- 'Ordering' of two values (less than, equal to, or greater than). It uses the+-- same lexicographical ordering as @deriving Ord@ (e.g. left alternative of a+-- sum is less than the right alternative, the first component of a product is+-- compared first while the second is only compared if the first is equal,+-- etc.).+--+-- All of the remaining functions are simply derived (in the most obvious way)+-- from 'compare'. All of these functions are equivalent to methods in the 'Eq'+-- and 'Ord' type classes. The difference with using this approach vs. @deriving+-- (Eq, Ord)@ is that you can write ad-hoc cases for certain datatypes while+-- most of the functionality is handled generically.+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.Compare (++ -- * Compare+ -- | 'compare' is equivalent to the function of the same name when @deriving+ -- Ord@. All other comparison functions in this module are derived from+ -- 'compare'.+ Compare(..),+ compare,++ -- * Equality, inequality+ -- | These functions are equivalent to @(==)@ and @(/=)@ when @deriving Eq@.+ eq,+ neq,++ -- * Less than, greater than+ -- | These functions are equivalent to @(\<)@, @(\<=)@, @(>)@, and @(>=)@ when+ -- @deriving Ord@.+ lt,+ lteq,+ gt,+ gteq,++ -- * Minimum and maximum+ -- | These functions are equivalent to functions of the same name when+ -- @deriving Ord@.+ min,+ max,+) where++import Prelude hiding (compare, min, max)+import qualified Prelude as P (compare)++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++-- | Type for 'compare'+newtype Compare a = Compare { selCompare :: a -> a -> Ordering }++-----------------------------------------------------------------------------+-- Generic instance declaration+-----------------------------------------------------------------------------++rconstantCompare :: Ord a => a -> a -> Ordering+rconstantCompare = P.compare++rsumCompare :: Compare a -> Compare b -> a :+: b -> a :+: b -> Ordering+rsumCompare ra _ (L a1) (L a2) = {-EQ-} selCompare ra a1 a2+rsumCompare _ rb (R b1) (R b2) = {-EQ-} selCompare rb b1 b2+rsumCompare _ _ (L _) (R _) = LT+rsumCompare _ _ (R _) (L _) = GT++rprodCompare :: Compare a -> Compare b -> a :*: b -> a :*: b -> Ordering+rprodCompare ra rb (a1 :*: b1) (a2 :*: b2) =+ case selCompare ra a1 a2 of+ EQ -> selCompare rb b1 b2+ other -> other++rconCompare :: ConDescr -> Compare a -> a -> a -> Ordering+rconCompare _ = selCompare++rtypeCompare :: EP a b -> Compare b -> a -> a -> Ordering+rtypeCompare ep rb a1 a2 = selCompare rb (from ep a1) (from ep a2)++instance Generic Compare where+ rconstant = Compare rconstantCompare+ rsum ra rb = Compare (rsumCompare ra rb)+ rprod ra rb = Compare (rprodCompare ra rb)+ rcon cd ra = Compare (rconCompare cd ra)+ rtype ep ra = Compare (rtypeCompare ep ra)++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Compare two values and return an 'Ordering' (i.e. @LT@, @GT@, or @EQ@).+-- This is implemented exactly as if the datatype was @deriving Ord@.++compare :: Rep Compare a => a -> a -> Ordering+compare = selCompare rep++-- | Less than. Returns @x < y@.+lt :: Rep Compare a => a -> a -> Bool+lt x y =+ case compare x y of+ LT -> True+ _ -> False++-- | Less than or equal to. Returns @x <= y@.+lteq :: Rep Compare a => a -> a -> Bool+lteq x y =+ case compare x y of+ GT -> False+ _ -> True++-- | Equal to. Returns @x == y@.+eq :: Rep Compare a => a -> a -> Bool+eq x y =+ case compare x y of+ EQ -> True+ _ -> False++-- | Not equal to. Returns @x /= y@.+neq :: Rep Compare a => a -> a -> Bool+neq x y =+ case compare x y of+ EQ -> False+ _ -> True++-- | Greater than. Returns @x > y@.+gt :: Rep Compare a => a -> a -> Bool+gt x y =+ case compare x y of+ GT -> True+ _ -> False++-- | Greater than or equal to. Returns @x >= y@.+gteq :: Rep Compare a => a -> a -> Bool+gteq x y =+ case compare x y of+ LT -> False+ _ -> True++-- | The minimum of two values.+min :: Rep Compare a => a -> a -> a+min x y = if x `lteq` y then x else y++-- | The maximum of two values.+max :: Rep Compare a => a -> a -> a+max x y = if x `gteq` y then x else y+
+ src/Generics/EMGM/Functions/Crush.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.Crush+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic functions that crush a container into an iteration over+-- its elements.+--+-- Crush is a datatype-generic operation on container types. It is a+-- generalization of folds, but it is not a catamorphism. To understand how+-- crush works, one can think of it as generating a list of all elements and+-- mapping an accumulating function over each one. With this image in mind, it+-- is evident that (unlike a catamorphism) very little information can be+-- determined about the structure of the container.+--+-- The EMGM implementation of 'crush' can not inherently know the associativity+-- of the binary operator. Consequently, associativity is left as an argument,+-- but there are variants specific to left- and right-associativity for+-- convenience.+--+-- Many standard Haskell datatypes (e.g. '[]', 'Data.Tree') are designed such+-- that a constructor with more than one argument (i.e. a product structurally+-- represented by '(:*:)') has the element on the left and any recursive points+-- towards the right. Due to this, the right-associative functions would+-- typically produce the expected values. See examples in the comments for+-- 'flattenr' and 'firstr'.+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.Crush (++ -- * Crush functions++ Crush(..),+ Assoc(..),+ crush,+ crushl,+ crushr,++ -- * Left- and right-associative derived functions+ -- | The operation of these functions changes depending on the associativity+ -- of the binary operator.++ flatten,+ flattenl,+ flattenr,++ first,+ firstl,+ firstr,++ -- * Other derived functions+ -- | The operation of these functions is independent of the associativity of+ -- the binary operator. Many of these functions are generalizations of the+ -- 'Prelude' functions of the same name++ and,+ or,+ any,+ all,+ sum,+ product,+ maximum,+ minimum,+ elem,+ notElem,++) where++import Prelude hiding (and, or, any, all, elem, notElem, sum, product, maximum, minimum)++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++-- | Associativity of the binary operator used for 'crush'+data Assoc = AssocLeft -- ^ Left-associative+ | AssocRight -- ^ Right-associative++-- | Type for 'crush'+newtype Crush b a = Crush { selCrush :: Assoc -> a -> b -> b }++-----------------------------------------------------------------------------+-- Generic instance declaration+-----------------------------------------------------------------------------++rconstantCrush :: Assoc -> a -> b -> b+rconstantCrush _ _ = id++rsumCrush :: Crush d a -> Crush d b -> Assoc -> a :+: b -> d -> d+rsumCrush ra _ asc (L a) = selCrush ra asc a+rsumCrush _ rb asc (R b) = selCrush rb asc b++rprodCrush :: Crush d a -> Crush d b -> Assoc -> a :*: b -> d -> d+rprodCrush ra rb asc@AssocLeft (a :*: b) = selCrush rb asc b . selCrush ra asc a+rprodCrush ra rb asc@AssocRight (a :*: b) = selCrush ra asc a . selCrush rb asc b++rconCrush :: ConDescr -> Crush d a -> Assoc -> a -> d -> d+rconCrush _ = selCrush++rtypeCrush :: EP b a -> Crush d a -> Assoc -> b -> d -> d+rtypeCrush ep ra asc = selCrush ra asc . from ep++instance Generic (Crush b) where+ rconstant = Crush rconstantCrush+ rsum ra rb = Crush (rsumCrush ra rb)+ rprod ra rb = Crush (rprodCrush ra rb)+ rcon cd ra = Crush (rconCrush cd ra)+ rtype ep ra = Crush (rtypeCrush ep ra)++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Apply a function (@a -> b -> b@) to each element (@a@) of a container (@f+-- a@) and an accumulator value (@b@) to produce an accumulated result (@b@).+--+-- This is the most general form in which you must specify the associativity.+-- You may prefer to use 'crushr' or 'crushl'.+crush ::+ (FRep (Crush b) f)+ => Assoc -- ^ Associativity of the binary operator (left or right).+ -> (a -> b -> b) -- ^ Binary operator on @a@-elements with an accumulator.+ -> b -- ^ The initial @b@-value for the binary operator.+ -> f a -- ^ Container of @a@-values.+ -> b -- ^ The result after applying the above operator on all+ -- @a@-values.+crush asc f z x = selCrush (frep (Crush f')) asc x z+ where f' _ = f -- necessary to skip the asc arg++-- | A right-associative variant of 'crush'.+crushr :: (FRep (Crush b) f) => (a -> b -> b) -> b -> f a -> b+crushr = crush AssocRight++-- | A left-associative variant of 'crush'.+crushl :: (FRep (Crush b) f) => (a -> b -> b) -> b -> f a -> b+crushl = crush AssocLeft++-- | Flatten the elements of a container into a list.+--+-- This is the most general form in which you must specify the associativity.+-- You may prefer to use 'flattenr' or 'flattenl'.+flatten :: (FRep (Crush [a]) f) => Assoc -> f a -> [a]+flatten asc = crush asc (:) []++-- | A right-associative variant of 'flatten'.+--+-- Note that, for a list @ls :: [a]@, @flattenr ls == ls@.+flattenr :: (FRep (Crush [a]) f) => f a -> [a]+flattenr = flatten AssocRight++-- | A left-associative variant of 'flatten'.+--+-- Note that, for a list @ls :: [a]@, @flattenl ls == reverse ls@.+flattenl :: (FRep (Crush [a]) f) => f a -> [a]+flattenl = flatten AssocLeft++-- | Extract the first element of a container. If the container is empty, return+-- @Nothing@.+--+-- This is the most general form in which you must specify the associativity.+-- You may prefer to use 'firstr' or 'firstl'.+first :: (FRep (Crush [a]) f) => Assoc -> f a -> Maybe a+first asc as = case flatten asc as of+ [] -> Nothing+ a:_ -> Just a++-- | A right-associative variant of 'first'.+--+-- Note that, for a list @ls :: [a]@, @fromJust (firstr ls) == head ls@.+firstr :: (FRep (Crush [a]) f) => f a -> Maybe a+firstr = first AssocRight++-- | A left-associative variant of 'first'.+--+-- Note that, for a list @ls :: [a]@, @fromJust (firstl ls) == last ls@.+firstl :: (FRep (Crush [a]) f) => f a -> Maybe a+firstl = first AssocLeft++-- | Determine if an element is a member of a container. This is a+-- generalization of the 'Prelude' function of the same name.+elem :: (Eq a, FRep (Crush Bool) f) => a -> f a -> Bool+elem x = any (== x)++-- | Determine if an element is not a member of a container. This is a+-- generalization of the 'Prelude' function of the same name.+notElem :: (Eq a, FRep (Crush Bool) f) => a -> f a -> Bool+notElem x = all (/= x)++-- | Compute the sum of all elements in a container. This is a generalization of+-- the 'Prelude' function of the same name.+sum :: (Num a, FRep (Crush a) f) => f a -> a+sum = crushr (+) 0++-- | Compute the product of all elements in a container. This is a+-- generalization of the 'Prelude' function of the same name.+product :: (Num a, FRep (Crush a) f) => f a -> a+product = crushr (*) 1++-- | Determine the maximum element of a container. If the container is empty,+-- return 'Nothing'. This is a generalization of the 'Prelude' function of the+-- same name.+maximum :: (Ord a, FRep (Crush (Maybe a)) f) => f a -> Maybe a+maximum = crushr f Nothing+ where f x Nothing = Just x+ f x (Just y) = Just $ max x y++-- | Determine the minimum element of a container. If the container is empty,+-- return 'Nothing'. This is a generalization of the 'Prelude' function of the+-- same name.+minimum :: (Ord a, FRep (Crush (Maybe a)) f) => f a -> Maybe a+minimum = crushr f Nothing+ where f x Nothing = Just x+ f x (Just y) = Just $ min x y++-- | Compute the conjunction of all elements in a container. This is a+-- generalization of the 'Prelude' function of the same name.+and :: (FRep (Crush Bool) f) => f Bool -> Bool+and = crushr (&&) True++-- | Compute the disjunction of all elements in a container. This is a+-- generalization of the 'Prelude' function of the same name.+or :: (FRep (Crush Bool) f) => f Bool -> Bool+or = crushr (||) False++-- | Determine if any element in a container satisfies the predicate @p@. This+-- is a generalization of the 'Prelude' function of the same name.+any :: (FRep (Crush Bool) f) => (a -> Bool) -> f a -> Bool+any p = crushr (\x b -> b || p x) False++-- | Determine if all elements in a container satisfy the predicate @p@. This+-- is a generalization the 'Prelude' function of the same name.+all :: (FRep (Crush Bool) f) => (a -> Bool) -> f a -> Bool+all p = crushr (\x b -> b && p x) True+
+ src/Generics/EMGM/Functions/Enum.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.Enum+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic function that enumerates the values of a datatype.+--+-- 'enum' generates a list of the values of a datatypes. It will produce all+-- values of all supported datatypes (with only a few exceptions [1]). For+-- datatypes that have an infinite enumeration (e.g. 'Integer' and @[a]@),+-- 'enum' produces an infinite list.+--+-- A number of the techniques used to write 'enum' came from a talk by Mark+-- Jones at the 2008 Advanced Functional Programming Summer School. The authors+-- gratefully acknowledge his contribution.+--+-- [1] The exceptions are 'Float' and 'Double'. These are treated in the same way+-- as their 'Enum' instances are treated. The result looks like this:+-- @[0.0,-1.0,1.0,-2.0,..]@, thus skipping all non-integral values. Note that+-- these may overflow, because they are unbounded.+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.Enum (+ Enum(..),+ enum,+ enumN,+ empty,+) where++import Prelude hiding (Enum)+import qualified Prelude as P (Enum)+import Data.List (genericTake)++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++-- | Type for 'enum'+newtype Enum a = Enum { selEnum :: [a] }++-----------------------------------------------------------------------------+-- Utility functions+-----------------------------------------------------------------------------++infixr 5 |||++-- | Interleave elements from two lists. Similar to (++), but swap left and+-- right arguments on every recursive application.+--+-- From Mark Jones' talk at AFP2008+(|||) :: [a] -> [a] -> [a]+[] ||| ys = ys+(x:xs) ||| ys = x : ys ||| xs++-- | Diagonalization of nested lists. Ensure that some elements from every+-- sublist will be included. Handles infinite sublists.+--+-- From Mark Jones' talk at AFP2008+diag :: [[a]] -> [a]+diag = concat . foldr skew [] . map (map (\x -> [x]))++skew :: [[a]] -> [[a]] -> [[a]]+skew [] ys = ys+skew (x:xs) ys = x : combine (++) xs ys++combine :: (a -> a -> a) -> [a] -> [a] -> [a]+combine _ xs [] = xs+combine _ [] ys = ys+combine f (x:xs) (y:ys) = f x y : combine f xs ys++infixr 6 ><++-- | Cartesian product with diagonalization.+--+-- From Mark Jones' talk at AFP2008+(><) :: [a] -> [b] -> [a :*: b]+xs >< ys = diag [ [ x :*: y | y <- ys ] | x <- xs ]++-----------------------------------------------------------------------------+-- Generic instance declaration+-----------------------------------------------------------------------------++-- | 'Int' values starting with 0 and enumerating to the positive and negative+-- bounds.+intEnum :: [Int]+intEnum = [0..maxBound] ||| pred 0 `downTo` minBound+ where downTo :: Int -> Int -> [Int]+ downTo n m | n < m = []+ downTo n m = n : downTo (n - 1) m++-- | Numeric and enumerable values starting with 0 and enumerating in the+-- positive and negative directions. Useful for 'Integer', 'Float', and+-- 'Double'.+numEnum :: (Num a, P.Enum a) => [a]+numEnum = [0..] ||| map negate [1..]++rsumEnum :: Enum a -> Enum b -> [a :+: b]+rsumEnum ra rb = [L x | x <- selEnum ra]+ ||| [R y | y <- selEnum rb]++rprodEnum :: Enum a -> Enum b -> [a :*: b]+rprodEnum ra rb = selEnum ra >< selEnum rb++rtypeEnum :: EP b a -> Enum a -> [b]+rtypeEnum ep ra = map (to ep) $ selEnum ra++instance Generic Enum where+ rconstant = error "Unreachable"+ rint = Enum intEnum+ rinteger = Enum numEnum+ rfloat = Enum numEnum+ rdouble = Enum numEnum+ rchar = Enum [minBound..maxBound]+ runit = Enum [Unit]+ rsum ra rb = Enum (rsumEnum ra rb)+ rprod ra rb = Enum (rprodEnum ra rb)+ rtype ep ra = Enum (rtypeEnum ep ra)++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Enumerate the values of a datatype. If the number of values is infinite,+-- the result will be an infinite list. The remaining functions are derived from+-- 'enum'.+enum :: (Rep Enum a) => [a]+enum = selEnum rep++-- | Enumerate the first @n@ values of a datatype. This is a shortcut for+-- @'genericTake' n ('enum')@.+enumN :: (Integral n, Rep Enum a) => n -> [a]+enumN n = genericTake n $ enum++-- | Returns the first element of the enumeration from 'enum'. This is+-- often called the neutral or empty value.+empty :: (Rep Enum a) => a+empty = head $ enumN (1::Int)+
+ src/Generics/EMGM/Functions/Map.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.Map+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic function that applies a (non-generic) function to all+-- elements contained in a polymorphic datatype.+--+-- 'map' is a generic version of the @Prelude@ @map@ function. It works on all+-- supported container datatypes of kind @* -> *@. The 'map' function is+-- equivalent to 'fmap' after @deriving 'Functor'@ if that were possible.+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.Map (+ Map(..),+ map,+ replace,+) where++import Prelude hiding (map)++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++-- | Type for 'map'+newtype Map a b = Map { selMap :: a -> b }++-----------------------------------------------------------------------------+-- Generic2 instance declaration+-----------------------------------------------------------------------------++rconstantMap :: a -> a+rconstantMap = id++rsumMap :: Map a1 a2 -> Map b1 b2 -> a1 :+: b1 -> a2 :+: b2+rsumMap ra _ (L a) = L (selMap ra a)+rsumMap _ rb (R b) = R (selMap rb b)++rprodMap :: Map a1 a2 -> Map b1 b2 -> a1 :*: b1 -> a2 :*: b2+rprodMap ra rb (a :*: b) = selMap ra a :*: selMap rb b++rtypeMap :: EP b r -> EP d a -> Map r a -> b -> d+rtypeMap ep1 ep2 ra = to ep2 . selMap ra . from ep1++instance Generic2 Map where+ rconstant2 = Map rconstantMap+ rsum2 ra rb = Map (rsumMap ra rb)+ rprod2 ra rb = Map (rprodMap ra rb)+ rtype2 ep1 ep2 ra = Map (rtypeMap ep1 ep2 ra)++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Apply a function to all elements of a container datatype (kind @* -> *@).+map :: (FRep2 Map f) => (a -> b) -> f a -> f b+map = selMap . frep2 . Map++-- | Replace all @a@-values in @as@ with @b@.+replace :: (FRep2 Map f) => f a -> b -> f b+replace as b = map (const b) as+
+ src/Generics/EMGM/Functions/Read.hs view
@@ -0,0 +1,399 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.Read+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic functions that parse strings to produce values.+--+-- The functions in this module involve generically parsing a string and+-- producing a value. They rely on the return type to determine the structure+-- for parsing. Often, this can be determined by the type checker, but+-- you will occasionally need to give an explicit type signature.+--+-- The underlying parser is designed to be as similar to @deriving Read@ (as+-- implemented by GHC) as possible. Refer to documentation in "Text.Read" for+-- details.+--+-- Since this library does not have access to the syntax of a @data@+-- declaration, it relies on 'ConDescr' for information. It is important that+-- 'ConDescr' accurately describe, for each constructor, the name, record+-- labels (in same order as declared) if present, and fixity.+--+-- See also "Generics.EMGM.Functions.Show".+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.Read (+ Read(..),+ readPrec,+ readP,+ readsPrec,+ reads,+ read,+) where++import Prelude hiding (Read, read, reads, readsPrec)+import qualified Prelude as P (Read)+import Data.List (find)+import Control.Monad+import Debug.Trace++import Text.ParserCombinators.ReadPrec (ReadPrec, step, (+++), pfail, lift,+ look, readPrec_to_S, readPrec_to_P)+import qualified Text.ParserCombinators.ReadPrec as RP (prec)+import Text.ParserCombinators.ReadP (ReadP)+import Text.Read (Lexeme(Punc), lexP, parens, reset)+import qualified Text.Read as TR (readPrec)+import Text.Read.Lex (hsLex)++import qualified GHC.Read as GHC (list)++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++-- | Type for 'readPrec'+newtype Read a = Read { selRead :: ConType -> ReadPrec a }++-----------------------------------------------------------------------------+-- Utility functions+-----------------------------------------------------------------------------++-- | "Look and trace" - print the unconsumed part of the input string+ltrace :: String -> ReadPrec ()+ltrace =+ let debug = False+ in if debug+ then \s -> do la <- look+ (trace $ "<<" ++ la ++ ">> " ++ s) $ return ()+ else const $ do return ()++comma :: ReadPrec ()+comma = do Punc "," <- lexP+ return ()++equals :: ReadPrec ()+equals = do Punc "=" <- lexP+ return ()++-- | @(paren p)@ parses \"(P0)\" where @p@ parses \"P0\" at precedence 0+paren :: ReadPrec a -> ReadPrec a+paren p = do Punc "(" <- lexP+ x <- reset p+ Punc ")" <- lexP+ return x++-- | Read optional parentheses plus a single required pair.+wrapTuple :: ReadPrec a -> ReadPrec a+wrapTuple = parens . paren++-- | Read "a , b" without parens.+tuple2 :: ReadPrec a -> ReadPrec b -> ReadPrec (a,b)+tuple2 pa pb =+ do a <- pa+ comma+ b <- pb+ return (a,b)++-- | Read "a , b , c" without parens.+tuple3 :: ReadPrec a -> ReadPrec b -> ReadPrec c -> ReadPrec (a,b,c)+tuple3 pa pb pc =+ do (a,b) <- tuple2 pa pb+ comma+ c <- pc+ return (a,b,c)++-- | Read "a , b , c , d" without parens.+tuple4 :: ReadPrec a -> ReadPrec b -> ReadPrec c -> ReadPrec d -> ReadPrec (a,b,c,d)+tuple4 pa pb pc pd =+ do (a,b) <- tuple2 pa pb+ comma+ (c,d) <- tuple2 pc pd+ return (a,b,c,d)++-- | @(paren p)@ parses \"{P0}\" where @p@ parses \"P0\" at precedence 0+braces :: ReadPrec a -> ReadPrec a+braces p = do ltraceme "{ before"+ Punc "{" <- lexP+ ltraceme "{ after"+ x <- reset p+ ltraceme "} before"+ Punc "}" <- lexP+ ltraceme "} after"+ return x+ where ltraceme s = ltrace $ "braces: " ++ s++-- | Parse a Haskell token and verify that it is the one expected.+lexT :: String -> ReadPrec ()+lexT expected =+ do found <- lift hsLex+ if found == expected+ then do ltraceme "success"+ return ()+ else do ltraceme $ "fnd=" ++ found ++ " FAIL"+ pfail+ where ltraceme s = ltrace $ "lexT: exp=" ++ expected ++ " -> " ++ s++-- | Parse a record entry: "label = x[,]" where x comes from the parameter+-- parser @p@.+recEntry :: Bool -> String -> ReadPrec a -> ReadPrec a+recEntry isComma label p =+ do lexT label+ ltraceme "before ="+ equals+ ltraceme "after ="+ x <- p+ ltraceme "after p"+ if isComma+ then do ltraceme "before ,"+ comma+ return x+ else do ltraceme "no ,"+ return x+ where ltraceme s =+ ltrace $ "recEntry: com=" ++ show isComma +++ " lbl=" ++ label ++ " " ++ s++-----------------------------------------------------------------------------+-- Generic instance declaration+-----------------------------------------------------------------------------++rconstantRead :: (P.Read a) => ConType -> ReadPrec a+rconstantRead ct =+ case ct of++ -- Standard constructor+ ConStd ->+ do ltraceme "ConStd"+ TR.readPrec++ -- Record-style constructor with 1 label+ ConRec (label:[]) ->+ do ltraceme "ConRec1"+ recEntry False label TR.readPrec++ -- No other patterns expected+ _ ->+ do ltraceme "FAIL"+ pfail++ where ltraceme s = ltrace $ "rconstantRead: " ++ s++rsumRead :: Read a -> Read b -> ConType -> ReadPrec (a :+: b)+rsumRead ra rb _ =+ do ltrace "rsumRead:"+ (return . L =<< selRead ra ConStd) +++ (return . R =<< selRead rb ConStd)++rprodRead :: Read a -> Read b -> ConType -> ReadPrec (a :*: b)+rprodRead ra rb ct =+ case ct of++ -- Standard nonfix constructor+ ConStd ->+ do ltraceme "ConStd (a)"+ a <- step (selRead ra ConStd)+ ltraceme "ConStd (b)"+ b <- step (selRead rb ConStd)+ return (a :*: b)++ -- Standard infix constructor+ ConIfx symbol ->+ do ltraceme "ConIfx (a)"+ a <- step (selRead ra ConStd)+ lexT symbol+ ltraceme "ConIfx (b)"+ b <- step (selRead rb ConStd)+ return (a :*: b)++ -- Record-style constructor+ ConRec (label:labels) ->+ do ltraceme "ConRec2 (a)"+ a <- step (recEntry True label (selRead ra ConStd))+ ltraceme "ConRec2 (b)"+ b <- step $ selRead rb (ConRec (labels))+ return (a :*: b)++ -- No other patterns expected+ _ ->+ do ltraceme "FAIL"+ pfail++ where+ ltraceme s = ltrace $ "rprodRead: " ++ show ct ++ " " ++ s++rconRead :: ConDescr -> Read a -> ConType -> ReadPrec a+rconRead cd ra _ =+ parens $+ case cd of++ -- Standard nonfix constructor+ ConDescr name _ [] Nonfix ->+ do ltraceme "ConStd"+ lexT name+ step $ selRead ra ConStd++ -- Standard infix constructor+ ConDescr name _ [] fixity ->+ do ltraceme "ConIfx"+ let p = prec fixity+ RP.prec p $ step $ selRead ra $ ConIfx name++ -- Record-style nonfix constructor+ ConDescr name _ labels Nonfix ->+ do ltraceme "ConRec (a)"+ lexT name+ braces $ step $ selRead ra $ ConRec labels++ -- Record-style infix constructor+ ConDescr name _ labels _ ->+ do ltraceme "ConRec (b)"+ paren (lexT name)+ braces $ step $ selRead ra $ ConRec labels++ where ltraceme s = ltrace $ "rconRead: " ++ show cd ++ " " ++ s++rtypeRead :: EP d a -> Read a -> ConType -> ReadPrec d+rtypeRead ep ra ct =+ case ct of++ -- Standard constructor+ ConStd ->+ do ltraceme "ConStd"+ fmap (to ep) $ selRead ra ConStd++ -- Record-style constructor+ ConRec (label:[]) ->+ do ltraceme "ConRec"+ fmap (to ep) $ recEntry False label (selRead ra ConStd)++ -- No other patterns expected+ _ ->+ do ltraceme "FAIL"+ pfail++ where+ ltraceme s = ltrace $ "rtypeRead: " ++ show ct ++ " " ++ s++instance Generic Read where+ rconstant = Read rconstantRead+ rsum ra rb = Read (rsumRead ra rb)+ rprod ra rb = Read (rprodRead ra rb)+ rcon cd ra = Read (rconRead cd ra)+ rtype ep ra = Read (rtypeRead ep ra)++-----------------------------------------------------------------------------+-- Rep instance declarations+-----------------------------------------------------------------------------++-- | Ad-hoc instance for lists+instance (Rep Read a) => Rep Read [a] where+ rep = Read $ const $ GHC.list $ readPrec++-- | Ad-hoc instance for strings+instance Rep Read String where+ rep = Read $ const TR.readPrec++-- | Ad-hoc instance for @()@+instance Rep Read () where+ rep = Read $ const TR.readPrec++-- | Ad-hoc instance for @(a,b)@+instance (Rep Read a, Rep Read b) => Rep Read (a,b) where+ rep = Read $ const $ wrapTuple $+ tuple2 readPrec readPrec++-- | Ad-hoc instance for @(a,b,c)@+instance (Rep Read a, Rep Read b, Rep Read c)+ => Rep Read (a,b,c) where+ rep = Read $ const $ wrapTuple $+ tuple3 readPrec readPrec readPrec++-- | Ad-hoc instance for @(a,b,c,d)@+instance (Rep Read a, Rep Read b, Rep Read c, Rep Read d)+ => Rep Read (a,b,c,d) where+ rep = Read $ const $ wrapTuple $+ tuple4 readPrec readPrec readPrec readPrec++-- | Ad-hoc instance for @(a,b,c,d,e)@+instance (Rep Read a, Rep Read b, Rep Read c, Rep Read d, Rep Read e)+ => Rep Read (a,b,c,d,e) where+ rep = Read $ const $ wrapTuple $+ do (a,b,c,d) <- tuple4 readPrec readPrec readPrec readPrec+ comma+ e <- readPrec+ return (a,b,c,d,e)++-- | Ad-hoc instance for @(a,b,c,d,e,f)@+instance (Rep Read a, Rep Read b, Rep Read c, Rep Read d, Rep Read e,+ Rep Read f)+ => Rep Read (a,b,c,d,e,f) where+ rep = Read $ const $ wrapTuple $+ do (a,b,c,d) <- tuple4 readPrec readPrec readPrec readPrec+ comma+ (e,f) <- tuple2 readPrec readPrec+ return (a,b,c,d,e,f)++-- | Ad-hoc instance for @(a,b,c,d,e,f,h)@+instance (Rep Read a, Rep Read b, Rep Read c, Rep Read d, Rep Read e,+ Rep Read f, Rep Read h)+ => Rep Read (a,b,c,d,e,f,h) where+ rep = Read $ const $ wrapTuple $+ do (a,b,c,d) <- tuple4 readPrec readPrec readPrec readPrec+ comma+ (e,f,h) <- tuple3 readPrec readPrec readPrec+ return (a,b,c,d,e,f,h)++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Generate a 'ReadPrec' parser combinator for the datatype @a@ that handles+-- operator precedence. This uses the library in+-- "Text.ParserCombinators.ReadPrec" and should be similar to a derived+-- implementation of 'Text.Read.readPrec'.+--+-- Note that all of the other read functions in this module are derived from+-- 'readPrec'.+readPrec :: (Rep Read a) => ReadPrec a+readPrec = selRead rep ConStd++-- | Attempt to parse a value from the front of the string using the given+-- precedence. 'readsPrec' returns a list of (parsed value, remaining string)+-- pairs. If parsing fails, 'readsPrec' returns an empty list.+readsPrec ::+ (Rep Read a)+ => Int -- ^ Operator precedence of the enclosing context (a number from 0 to 11).+ -> ReadS a -- ^ Equivalent to @String -> [(a,String)]@.+readsPrec = readPrec_to_S readPrec++-- | Generate a 'ReadP' parser combinator for the datatype @a@. This can be used+-- with 'Text.ParserCombinators.ReadP'.+readP ::+ (Rep Read a)+ => Int -- ^ Operator precedence of the enclosing context (a number from 0 to 11).+ -> ReadP a+readP = readPrec_to_P readPrec++-- | A variant of 'readsPrec' with the minimum precedence (0).+reads :: (Rep Read a) => ReadS a+reads = readsPrec minPrec++-- | A variant of 'reads' that returns @Just value@ on a successful parse.+-- Otherwise, 'read' returns 'Nothing'. Note that a successful parse requires+-- the input to be completely consumed.+read :: (Rep Read a) => String -> Maybe a+read = fmap fst . find (null . snd) . reads+
+ src/Generics/EMGM/Functions/Show.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.Show+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic functions that convert values to readable strings.+--+-- The functions in this module involve generically producing a string from a+-- value of a supported datatype. The functions 'showsPrec' and 'show' are+-- modeled after those in the class @Show@, and 'shows' after the related+-- function of the same name.+--+-- The underlying unparser is designed to be as similar to @deriving Show@ as+-- possible. Refer to documentation in "Text.Show" for details.+--+-- Since this library does not have access to the syntax of a @data@+-- declaration, it relies on 'ConDescr' for information. It is important that+-- 'ConDescr' accurately describe, for each constructor, the name, arity, record+-- labels (in same order as declared) if present, and fixity.+--+-- See also "Generics.EMGM.Functions.Read".+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.Show (+ Show(..),+ showsPrec,+ shows,+ show,+) where++import Prelude hiding (Show, showsPrec, show, shows)+import qualified Prelude as P (Show, showsPrec)++import qualified GHC.Show as GHC (showList__)++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++type ShowsPrec a = Int -> a -> ShowS++-- | Type for 'showsPrec'+newtype Show a = Show { selShow :: ConType -> ShowsPrec a }++-----------------------------------------------------------------------------+-- Utility functions+-----------------------------------------------------------------------------++showSpace :: ShowS+showSpace = showChar ' '++showBraces :: ShowsPrec a -> ShowsPrec a+showBraces showsPrec' p x =+ showChar '{' .+ showsPrec' p x .+ showChar '}'++showTuple :: [ShowS] -> ShowS+showTuple ss = showParen True $+ foldr1 (\s r -> s . showChar ',' . r) ss++recEntry :: Bool -> String -> ShowsPrec a -> ShowsPrec a+recEntry comma label showsPrec' _ x =+ showString label .+ showString " = " .+ showsPrec' minPrec x . -- Reset precedence for record fields+ showString (if comma then ", " else "")++-----------------------------------------------------------------------------+-- Generic instance declaration+-----------------------------------------------------------------------------++rconstantShow :: (P.Show a) => ConType -> ShowsPrec a+rconstantShow ct =+ case ct of++ -- Standard constructor+ ConStd -> P.showsPrec++ -- Record-style constructor with 1 label+ ConRec (label:[]) -> recEntry False label P.showsPrec++ -- No other patterns expected+ _ -> error "Should not reach here!"++rsumShow :: Show a -> Show b -> ConType -> ShowsPrec (a :+: b)+rsumShow ra _ _ p (L a) = selShow ra ConStd p a+rsumShow _ rb _ p (R b) = selShow rb ConStd p b++rprodShow :: Show a -> Show b -> ConType -> ShowsPrec (a :*: b)+rprodShow ra rb ct p (a :*: b) =+ case ct of++ -- Standard nonfix constructor+ ConStd ->+ selShowStep ra ConStd p a .+ showSpace .+ selShowStep rb ConStd p b++ -- Standard infix constructor+ ConIfx symbol ->+ selShowStep ra ConStd p a .+ showSpace .+ showString symbol .+ showSpace .+ selShowStep rb ConStd p b++ -- Record-style constructor+ ConRec (label:labels) ->+ let p' = p + 1 in+ recEntry True label (selShowStep ra ConStd) p' a .+ selShowStep rb (ConRec (labels)) p' b++ -- No other patterns expected+ _ -> error "Should not reach here!"++ where selShowStep r ct' = selShow r ct' . (+1)++rconShow :: ConDescr -> Show a -> ConType -> ShowsPrec a+rconShow cd ra _ p a =+ case cd of++ -- Standard nonfix constructor+ ConDescr name arity [] Nonfix ->+ let hasArgs = arity > 0 in+ -- Don't show parens if constructor has no arguments+ showParen (p > appPrec && hasArgs) $+ showString name .+ showString (if hasArgs then " " else "") .+ showConStep ConStd appPrec a++ -- Standard infix constructor+ ConDescr name _ [] fixity ->+ let conPrec = prec fixity in+ showParen (p > conPrec) $+ showConStep (ConIfx name) conPrec a++ -- Record-style nonfix constructor+ ConDescr name _ labels Nonfix ->+ -- NOTE: Technically, we can use 'recPrec' below, because the precedence+ -- for record construction is higher than function application. However,+ -- since GHC puts parens for 'appRec', we'll put them. That way, we can+ -- compare string output to deriving Show for testing.+ showParen (p > appPrec) $+ showString name .+ showSpace .+ showBraces (selShow ra (ConRec labels)) minPrec a++ -- Record-style infix constructor+ ConDescr name _ labels _ ->+ showParen True (showString name) .+ showSpace .+ showBraces (showConStep (ConRec labels)) p a++ where showConStep ct = selShow ra ct . (+1)++rtypeShow :: EP b a -> Show a -> ConType -> ShowsPrec b+rtypeShow ep ra ct =+ case ct of++ -- Standard constructor+ ConStd ->+ selShowFrom ConStd++ -- Record-style constructor+ ConRec (label:[]) ->+ recEntry False label (selShowFrom ConStd)++ -- No other patterns expected+ _ -> error "Should not reach here!"++ where selShowFrom ct' p = selShow ra ct' p . from ep++instance Generic Show where+ rconstant = Show rconstantShow+ rsum ra rb = Show (rsumShow ra rb)+ rprod ra rb = Show (rprodShow ra rb)+ rcon cd ra = Show (rconShow cd ra)+ rtype ep ra = Show (rtypeShow ep ra)++-----------------------------------------------------------------------------+-- Rep instance declarations+-----------------------------------------------------------------------------++-- | Ad-hoc instance for lists+instance (Rep Show a) => Rep Show [a] where+ rep = Show $ const $ const $ GHC.showList__ $ selShow rep ConStd minPrec++-- | Ad-hoc instance for strings+instance Rep Show String where+ rep = Show $ const P.showsPrec++-- | Ad-hoc instance for @()@+instance Rep Show () where+ rep = Show $ const P.showsPrec++-- | Ad-hoc instance for @(a,b)@+instance (Rep Show a, Rep Show b) => Rep Show (a,b) where+ rep = Show s+ where s _ _ (a,b) =+ showTuple [shows a, shows b]++-- | Ad-hoc instance for @(a,b,c)@+instance (Rep Show a, Rep Show b, Rep Show c)+ => Rep Show (a,b,c) where+ rep = Show s+ where s _ _ (a,b,c) =+ showTuple [shows a, shows b, shows c]++-- | Ad-hoc instance for @(a,b,c,d)@+instance (Rep Show a, Rep Show b, Rep Show c, Rep Show d)+ => Rep Show (a,b,c,d) where+ rep = Show s+ where s _ _ (a,b,c,d) =+ showTuple [shows a, shows b, shows c, shows d]++-- | Ad-hoc instance for @(a,b,c,d,e)@+instance (Rep Show a, Rep Show b, Rep Show c, Rep Show d,+ Rep Show e)+ => Rep Show (a,b,c,d,e) where+ rep = Show s+ where s _ _ (a,b,c,d,e) =+ showTuple [shows a, shows b, shows c, shows d,+ shows e]++-- | Ad-hoc instance for @(a,b,c,d,e,f)@+instance (Rep Show a, Rep Show b, Rep Show c, Rep Show d,+ Rep Show e, Rep Show f)+ => Rep Show (a,b,c,d,e,f) where+ rep = Show s+ where s _ _ (a,b,c,d,e,f) =+ showTuple [shows a, shows b, shows c, shows d,+ shows e, shows f]++-- | Ad-hoc instance for @(a,b,c,d,e,f,h)@+instance (Rep Show a, Rep Show b, Rep Show c, Rep Show d,+ Rep Show e, Rep Show f, Rep Show h)+ => Rep Show (a,b,c,d,e,f,h) where+ rep = Show s+ where s _ _ (a,b,c,d,e,f,h) =+ showTuple [shows a, shows b, shows c, shows d,+ shows e, shows f, shows h]++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Convert a value to a readable string starting with the operator precedence+-- of the enclosing context. All of the remaining functions are derived from+-- 'showsPrec'.+showsPrec ::+ (Rep Show a)+ => Int -- ^ Operator precedence of the enclosing context (a number from 0 to 11).+ -> a -- ^ The value to be converted to a 'String'.+ -> ShowS+showsPrec = selShow rep ConStd++-- | A variant of 'showsPrec' with the minimum precedence (0).+shows :: (Rep Show a) => a -> ShowS+shows = showsPrec 0++-- | A variant of 'shows' that returns a 'String' instead of 'ShowS'.+show :: (Rep Show a) => a -> String+show = flip shows ""+
+ src/Generics/EMGM/Functions/UnzipWith.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.UnzipWith+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic function that applies a (non-generic) function to every+-- element in a value, splitting the element into two. The result are two+-- structurally equivalent values, one with the elements from the first+-- component of the splitting function and the other with the elements from the+-- second component.+--+-- 'unzipWith' can be seen as the dual of the 'zipWith' function. It has no+-- @Prelude@ counterpart.+--+-- See also "Generics.EMGM.Functions.ZipWith".+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.UnzipWith (+ UnzipWith(..),+ unzipWith,+ unzip,+) where++import Prelude hiding (unzip)++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++-- | Type for 'unzipWith'+newtype UnzipWith a b c = UnzipWith { selUnzipWith :: a -> (b, c) }++-----------------------------------------------------------------------------+-- Generic3 instance declaration+-----------------------------------------------------------------------------++rconstantUnzipWith :: a -> (a, a)+rconstantUnzipWith x = (x, x)++runitUnzipWith :: Unit -> (Unit, Unit)+runitUnzipWith _ = (Unit, Unit)++rsumUnzipWith ::+ UnzipWith a1 a2 a3+ -> UnzipWith b1 b2 b3+ -> a1 :+: b1+ -> (a2 :+: b2, a3 :+: b3)+rsumUnzipWith ra _ (L a1) = let (a2, a3) = selUnzipWith ra a1+ in (L a2, L a3)+rsumUnzipWith _ rb (R b1) = let (b2, b3) = selUnzipWith rb b1+ in (R b2, R b3)++rprodUnzipWith ::+ UnzipWith a1 a2 a3+ -> UnzipWith b1 b2 b3+ -> (a1 :*: b1)+ -> (a2 :*: b2, a3 :*: b3)+rprodUnzipWith ra rb (a1 :*: b1) = let (a2, a3) = selUnzipWith ra a1+ (b2, b3) = selUnzipWith rb b1+ in (a2 :*: b2, a3 :*: b3)++rtypeUnzipWith ::+ EP b1 a1+ -> EP b2 a2+ -> EP b3 a3+ -> UnzipWith a1 a2 a3+ -> b1+ -> (b2, b3)+rtypeUnzipWith ep1 ep2 ep3 ra b1 = let (a2, a3) = selUnzipWith ra (from ep1 b1) + in (to ep2 a2, to ep3 a3)++rconUnzipWith :: ConDescr -> UnzipWith a1 a2 a3 -> a1 -> (a2, a3)+rconUnzipWith _ = selUnzipWith++instance Generic3 UnzipWith where+ rconstant3 = UnzipWith rconstantUnzipWith+ runit3 = UnzipWith runitUnzipWith+ rsum3 ra rb = UnzipWith (rsumUnzipWith ra rb)+ rprod3 ra rb = UnzipWith (rprodUnzipWith ra rb)+ rcon3 cd ra = UnzipWith (rconUnzipWith cd ra)+ rtype3 ep1 ep2 ep3 ra = UnzipWith (rtypeUnzipWith ep1 ep2 ep3 ra)++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Splits a container into two structurally equivalent containers by applying+-- a function to every element, which splits it into two corresponding elements.+-- All other functions in this module are derived from 'unzipWith'.+unzipWith ::+ (FRep3 UnzipWith f)+ => (a -> (b, c)) -- ^ Splitting function.+ -> f a -- ^ Container of @a@-values.+ -> (f b, f c) -- ^ Pair of containers.+unzipWith f = selUnzipWith (frep3 (UnzipWith f))++-- | Transforms a container of pairs into a container of first components and a+-- container of second components. This is a generic version of the @Prelude@+-- function of the same name.+unzip :: (FRep3 UnzipWith f) => f (a, b) -> (f a, f b)+unzip = unzipWith id+
+ src/Generics/EMGM/Functions/ZipWith.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module : Generics.EMGM.Functions.ZipWith+-- Copyright : (c) 2008 Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Generic function that applies a (non-generic) function to every+-- pair of corresponding elements in two structurally equivalent polymorphic+-- values to produce a third (also structurally equivalent) value with the+-- result of each application in every element location.+--+-- 'zipWith' is a generic version of the @Prelude@ @zipWith@ function. It works+-- on all supported container datatypes of kind @* -> *@.+--+-- The important concepts for `zipWith` are /structural equivalence/ and+-- /corresponding elements/. A regular, algebraic datatype can be visualized as+-- some sort of tree representing its structure. For 'zipWith' to be successful+-- (and not return 'Nothing'), its two container arguments must have exactly the+-- same tree shape. If the shapes of the arguments differ, then it is unclear+-- what the shape of the result is supposed to be. As a result, 'zipWith'+-- safely returns 'Nothing'.+--+-- Corresponding elements are those elements that are located in the same place+-- in the tree of each argument. If you were to traverse the tree to get to+-- element x in one tree, then its corresponding element y in the other tree+-- should require the exact same path to reach it.+--+-- See also "Generics.EMGM.Functions.UnzipWith".+-----------------------------------------------------------------------------++module Generics.EMGM.Functions.ZipWith (+ ZipWith(..),+ zipWith,+ zip,+) where++import Prelude hiding (zipWith, zip)++import Generics.EMGM.Common++-----------------------------------------------------------------------------+-- Types+-----------------------------------------------------------------------------++-- | Type for 'zipWith'+newtype ZipWith a b c = ZipWith { selZipWith :: a -> b -> Maybe c }++-----------------------------------------------------------------------------+-- Generic3 instance declaration+-----------------------------------------------------------------------------++rconstantZipWith :: (Eq a) => a -> a -> Maybe a+rconstantZipWith x y = if x == y then Just x else Nothing++runitZipWith :: Unit -> Unit -> Maybe Unit+runitZipWith _ _ = Just Unit++rsumZipWith ::+ ZipWith a1 a2 a3+ -> ZipWith b1 b2 b3+ -> a1 :+: b1+ -> a2 :+: b2+ -> Maybe (a3 :+: b3)+rsumZipWith ra _ (L a1) (L a2) = selZipWith ra a1 a2 >>= return . L+rsumZipWith _ rb (R b1) (R b2) = selZipWith rb b1 b2 >>= return . R+rsumZipWith _ _ _ _ = Nothing++rprodZipWith ::+ ZipWith a1 a2 a3+ -> ZipWith b1 b2 b3+ -> (a1 :*: b1)+ -> (a2 :*: b2)+ -> Maybe (a3 :*: b3)+rprodZipWith ra rb (a1 :*: b1) (a2 :*: b2) =+ do a <- selZipWith ra a1 a2+ b <- selZipWith rb b1 b2+ return (a :*: b)++rtypeZipWith ::+ EP b1 a1+ -> EP b2 a2+ -> EP b3 a3+ -> ZipWith a1 a2 a3+ -> b1+ -> b2+ -> Maybe b3+rtypeZipWith ep1 ep2 ep3 ra b1 b2 =+ selZipWith ra (from ep1 b1) (from ep2 b2) >>= return . to ep3++rconZipWith :: ConDescr -> ZipWith a1 a2 a3 -> a1 -> a2 -> Maybe a3+rconZipWith _ = selZipWith++instance Generic3 ZipWith where+ rconstant3 = ZipWith rconstantZipWith+ runit3 = ZipWith runitZipWith+ rsum3 ra rb = ZipWith (rsumZipWith ra rb)+ rprod3 ra rb = ZipWith (rprodZipWith ra rb)+ rcon3 cd ra = ZipWith (rconZipWith cd ra)+ rtype3 ep1 ep2 ep3 ra = ZipWith (rtypeZipWith ep1 ep2 ep3 ra)++-----------------------------------------------------------------------------+-- Exported functions+-----------------------------------------------------------------------------++-- | Combine two structurally equivalent containers into one by applying a+-- function to every corresponding pair of elements. Returns 'Nothing' if @f a@+-- and @f b@ have different shapes. All other functions in this module are+-- derived from 'zipWith'.+zipWith ::+ (FRep3 ZipWith f)+ => (a -> b -> c) -- ^ Binary operator on elements of containers.+ -> f a -- ^ Container of @a@-values.+ -> f b -- ^ Container of @b@-values.+ -> Maybe (f c) -- ^ Container of @c@-values if successful or 'Nothing'+ -- if failed.+zipWith f = selZipWith (frep3 (ZipWith f'))+ where f' a b = Just $ f a b++-- | Combine two containers into a single container with pairs of the original+-- elements. See 'zipWith' for restrictions. This is a generic version of the+-- @Prelude@ function of the same name.+zip :: (FRep3 ZipWith f) => f a -> f b -> Maybe (f (a, b))+zip = zipWith (,)+
+ tests/Main.hs view
@@ -0,0 +1,32 @@++module Main where++import Test.HUnit++import qualified TestQC+import qualified Crush+import qualified ReadShow+import qualified Compare+import qualified Collect+import qualified Enum+import qualified ZipWith+import qualified UnzipWith+import qualified Map++-- Make sure the examples compile:+import Ex00StartHere ()++tests =+ "All" ~: [ Crush.tests+ , ReadShow.tests+ , Compare.tests+ , Collect.tests+ , Enum.tests+ , ZipWith.tests+ , UnzipWith.tests+ , Map.tests+ ]++main = do TestQC.main+ runTestTT tests+