emgm 0.3.1 → 0.4

raw patch · 53 files changed

+2114/−4174 lines, 53 filesdep +sybdep −template-haskelldep ~QuickCheckdep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: syb

Dependencies removed: template-haskell

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

Files

• CREDITS.md +42/−0
• LICENSE +1/−1
• README +0/−219
• README.md +47/−0
• Setup.lhs +2/−127
• emgm.cabal +43/−110
• examples/Ex02AddingDatatypeSupport.hs +5/−4
• examples/Ex03DefiningFunctions.hs +0/−1
• src/Generics/EMGM.hs +70/−102
• src/Generics/EMGM/Base.hs +270/−0
• src/Generics/EMGM/Common.hs +0/−27
• src/Generics/EMGM/Common/Base.hs +0/−172
• src/Generics/EMGM/Common/Base2.hs +0/−129
• src/Generics/EMGM/Common/Base3.hs +0/−125
• src/Generics/EMGM/Common/Representation.hs +0/−179
• src/Generics/EMGM/Data/Bool.hs +32/−34
• src/Generics/EMGM/Data/Either.hs +35/−35
• src/Generics/EMGM/Data/List.hs +36/−24
• src/Generics/EMGM/Data/Maybe.hs +35/−35
• src/Generics/EMGM/Data/Ratio.hs +109/−0
• src/Generics/EMGM/Data/TH.hs +0/−71
• src/Generics/EMGM/Data/Tuple.hs +101/−55
• src/Generics/EMGM/Derive.hs +0/−314
• src/Generics/EMGM/Derive/Common.hs +0/−342
• src/Generics/EMGM/Derive/ConDescr.hs +0/−113
• src/Generics/EMGM/Derive/EP.hs +0/−125
• src/Generics/EMGM/Derive/Functions.hs +0/−92
• src/Generics/EMGM/Derive/Instance.hs +0/−266
• src/Generics/EMGM/Derive/Internal.hs +0/−692
• src/Generics/EMGM/Functions.hs +0/−38
• src/Generics/EMGM/Functions/Collect.hs +47/−45
• src/Generics/EMGM/Functions/Compare.hs +15/−15
• src/Generics/EMGM/Functions/Crush.hs +45/−25
• src/Generics/EMGM/Functions/Enum.hs +15/−14
• src/Generics/EMGM/Functions/Everywhere.hs +28/−28
• src/Generics/EMGM/Functions/Map.hs +21/−14
• src/Generics/EMGM/Functions/Meta.hs +147/−0
• src/Generics/EMGM/Functions/Read.hs +62/−142
• src/Generics/EMGM/Functions/Show.hs +75/−92
• src/Generics/EMGM/Functions/Transpose.hs +136/−0
• src/Generics/EMGM/Functions/UnzipWith.hs +81/−54
• src/Generics/EMGM/Functions/ZipWith.hs +67/−61
• src/Generics/EMGM/Representation.hs +188/−0
• tests/A.hs +166/−0
• tests/B.hs +146/−0
• tests/Compare.hs +8/−7
• tests/Derive.hs +0/−170
• tests/Enum.hs +1/−0
• tests/Everywhere.hs +9/−10
• tests/Main.hs +9/−6
• tests/Map.hs +1/−0
• tests/ReadShow.hs +19/−17
• tests/TTree.hs +0/−42

@@ -0,0 +1,42 @@++Credits for EMGM+================++This is a list of those who have contributed to the design and development of+Extensible and Modular Generics for the Masses library.++History+-------++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.++Research+--------++*  Ralf Hinze+*  Bruno C. d. S. Oliveira+*  Andres Löh+*  Alexey Rodriguez++Primary Contributors+--------------------++*  Sean Leather+*  José Pedro Magalhães++Current Maintainer+------------------++*  Sean Leather++Other Contributions+-------------------++*  Johan Jeuring+*  Lambert Meertens+*  Larry Evans+*  Antoine Latter (for Ratio)+

@@ -1,4 +1,4 @@-Copyright (c) 2008, 2009 Universiteit Utrecht+Copyright (c) 2008 - 2011 Universiteit Utrecht All rights reserved.  Redistribution and use in source and binary forms, with or without modification,

@@ -1,219 +0,0 @@--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] version 6.8.1 or later - It has been tested with versions 6.8.3 and 6.10.1.-*  [Cabal] library version 1.2.1 or later - It has been tested with versions 1.2.4.0 and 1.6.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 or later - 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.1 - Required for testing.-*  [HUnit] 1.2 - Required for testing.--[QuickCheck]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/QuickCheck-[HUnit]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HUnit--### 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.-

@@ -0,0 +1,47 @@++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++Examples+--------++You can find examples of using EMGM in the [`examples` directory] of the source+distribution.++[`examples` directory]: https://github.com/spl/emgm/tree/master/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+

@@ -1,7 +1,6 @@ #! /usr/bin/env runhaskell  \begin{code}-{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS -Wall #-}  -----------------------------------------------------------------------------@@ -15,134 +14,10 @@  module Main (main) where -import System.Cmd-  ( system-  )--import System.FilePath-  ( (</>)-  )--import Data.Version-  ( Version(..)-  )--import Distribution.Simple-  ( defaultMainWithHooks-  , simpleUserHooks-  , UserHooks(runTests, haddockHook, buildHook)-  , Args-  )--import Distribution.Simple.LocalBuildInfo-  ( LocalBuildInfo(..)-  )--import Distribution.Simple.Program-  ( userSpecifyArgs-  )--import Distribution.Simple.Setup-  ( HaddockFlags-  , BuildFlags-  )--import Distribution.Package--import Distribution.PackageDescription-  ( PackageDescription(..)-  , BuildInfo(..)-  , Library(..)-  , Executable(..)-  )+import Distribution.Simple (defaultMain)  main :: IO ()-main = defaultMainWithHooks hooks-  where-    hooks = simpleUserHooks-            { runTests    = runTests'-            , haddockHook = haddockHook'-            , buildHook   = buildHook'-            }---- Run a 'test' binary that gets built when configured with '-ftest'.-runTests' :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()-runTests' _ _ _ _ = system cmd >> return ()-  where testdir = "dist" </> "build" </> "test"-        testcmd = "." </> "test"-        cmd = "cd " ++ testdir ++ " && " ++ testcmd---- Define __HADDOCK__ for CPP when running haddock. This is a workaround for--- Haddock not building the documentation due to some issue with Template--- Haskell.-haddockHook' :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()-haddockHook' pkg lbi =-  haddockHook simpleUserHooks pkg (lbi { withPrograms = p })-  where-    p = userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] (withPrograms lbi)---- Insert CPP flag for building with template-haskell versions >= 2.3. This was--- previously done in the .cabal file, but it was not backwards compatible with--- Cabal 1.2. This should work with Cabal from 1.2 to 1.6 at least.-buildHook' :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()-buildHook' pkg lbi hooks flags = do-  buildHook simpleUserHooks pkg (lbi { localPkgDescr = newPkgDescr }) hooks flags-  where--    -- Old local package description-    oldPkgDescr = localPkgDescr lbi--    -- New local package description-    newPkgDescr =-      case thVersion of-        Nothing      ->-          oldPkgDescr-        Just version ->-          if version >= Version [2,3] []-          then-            oldPkgDescr-              { library = addThCppToLibrary (library oldPkgDescr)-              , executables = map addThCppToExec (executables oldPkgDescr)-              }-          else-            oldPkgDescr--    -- Template Haskell package name-    thPackageName = mkPackageName "template-haskell"--    mkPackageName :: (Read a) => String -> a-    mkPackageName nm =-      fst $ head $ reads shownNm ++ reads ("PackageName " ++ shownNm)-      where-        shownNm = show nm--    -- template-haskell version-    thVersion = findThVersion (packageDeps lbi)--    -- CPP options for template-haskell >= 2.3-    thCppOpt = "-DTH_LOC_DERIVEREP"--    -- Find the version of the template-haskell package-    findThVersion []          = Nothing-    findThVersion (PackageIdentifier name version:ps)-      | name == thPackageName = Just version-      | otherwise             = findThVersion ps--    -- Add the template-haskell CPP flag to a BuildInfo-    addThCppToBuildInfo :: BuildInfo -> BuildInfo-    addThCppToBuildInfo bi =-      bi { cppOptions = thCppOpt : cppOptions bi }--    -- Add the template-haskell CPP flag to a library package description-    addThCppToLibrary :: Maybe Library -> Maybe Library-    addThCppToLibrary ml = do-      lib <- ml-      return (lib { libBuildInfo = addThCppToBuildInfo (libBuildInfo lib) })--    -- Add the template-haskell CPP flag to an executable package description-    addThCppToExec :: Executable -> Executable-    addThCppToExec exec =-      exec { buildInfo = addThCppToBuildInfo (buildInfo exec) }+main = defaultMain  \end{code} 

@@ -1,10 +1,10 @@ name:                   emgm-version:                0.3.1+version:                0.4 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.+  EMGM is a general-purpose library for datatype-generic programming.   .   The design is based on the idea of modeling algebraic datatypes as   sum-of-product structures. Many datatypes can be modeled this way, and@@ -13,37 +13,26 @@   .   The primary features of the library are:   .-  * /A platform for building generic functions and adding support for user-defined datatypes./-  .-  EMGM includes an important collection of datatypes (e.g. sum, product, and-  unit) and type classes (e.g. @Generic@ and @Rep@). Everything you need for-  your own generic functions or datatypes can be found here.-  .-  * /Many useful generic functions./-  .-  These provide a wide range of functionality. For example, there is @crush@-  ("Generics.EMGM.Functions.Crush"), a generalization of the foldl/foldr-  functions, that allows you to flexibly extract the elements of a polymorphic-  container. Now, you can do many of the operations with your container that-  were previously only available for lists.-  .-  Different generic functions work with different kinds of types as well. For-  example, @collect@ ("Generics.EMGM.Functions.Collect") works with any fully-  applied type while @bimap@ ("Generics.EMGM.Functions.Map") only works with-  bifunctor types such as @Either@ or @(,)@ (pairs).+  * /A foundation for building generic functions./ EMGM includes a collection of+  datatypes (e.g. sum, product, and unit) and type classes (e.g. @Generic@ and+  @Rep@). Everything you need for defining generic functions and supporting+  datatypes can be found here.   .-  * /Support for standard and user-defined datatypes./+  * /Many useful generic functions./ These provide a wide range of+  functionality. For example, there is @crush@, a generalization of the+  foldl/foldr functions, that allows you to flexibly extract the elements of a+  polymorphic container. Now, you can do many of the operations with your+  container that were previously only available for lists.   .-  EMGM provides full support for standard types such as @[]@ (lists), tuples,-  and @Maybe@ as well as many types you define in your own code. Using the-  Template Haskell functions provided in "Generics.EMGM.Derive", it is very-  simple to add support for using generic functions with your datatype+  * /Support for standard datatypes./ EMGM supports standard types: primitives+  (e.g. @Int@ and @Float@), @Bool@, lists, tuples, @Maybe@, etc.   .-  For more information on EMGM, see-  <http://www.cs.uu.nl/wiki/GenericProgramming/EMGM>+  /NOTE:/ As of version 0.4, this library does not have Template Haskell for+  generating the representation. We are working on another library for a+  solution to this problem.  category:               Generics-copyright:              (c) 2008, 2009 Universiteit Utrecht+copyright:              (c) 2008 - 2011 Universiteit Utrecht license:                BSD3 license-file:           LICENSE author:                 Sean Leather,@@ -52,49 +41,35 @@                         Andres Löh maintainer:             generics@haskell.org stability:              experimental-extra-source-files:     README,+extra-source-files:     README.md,+                        CREDITS.md,                         examples/Ex00StartHere.hs,                         examples/Ex01UsingFunctions.hs,                         examples/Ex02AddingDatatypeSupport.hs,                         examples/Ex03DefiningFunctions.hs,+                        tests/A.hs,+                        tests/B.hs,                         tests/Base.hs,                         tests/Bimap.hs,                         tests/Collect.hs,                         tests/Compare.hs,                         tests/Crush.hs,-                        tests/Derive.hs,                         tests/Enum.hs,                         tests/Everywhere.hs,                         tests/Main.hs,                         tests/Map.hs,                         tests/ReadShow.hs,-                        tests/TTree.hs,                         tests/UnzipWith.hs,                         tests/ZipWith.hs,                         util/hpc.lhs extra-tmp-files:        .hpc-build-type:             Custom-cabal-version:          >= 1.2.1-tested-with:            GHC == 6.8.3, GHC == 6.10.1------------------------------------------------------------------------------------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+build-type:             Simple+cabal-version:          >= 1.9.2+tested-with:            GHC == 7.0.1 -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+Source-Repository head+  type:                 git+  location:             git://github.com/spl/emgm.git  -------------------------------------------------------------------------------- @@ -103,87 +78,45 @@    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+                        -- Foundation+                        Generics.EMGM.Representation+                        Generics.EMGM.Base                          -- Generic functions-                        Generics.EMGM.Functions                         Generics.EMGM.Functions.Collect                         Generics.EMGM.Functions.Compare                         Generics.EMGM.Functions.Crush                         Generics.EMGM.Functions.Enum                         Generics.EMGM.Functions.Everywhere                         Generics.EMGM.Functions.Map+                        Generics.EMGM.Functions.Meta                         Generics.EMGM.Functions.Read                         Generics.EMGM.Functions.Show-                        Generics.EMGM.Functions.ZipWith+                        Generics.EMGM.Functions.Transpose                         Generics.EMGM.Functions.UnzipWith+                        Generics.EMGM.Functions.ZipWith                          -- Supported datatypes                         Generics.EMGM.Data.Bool                         Generics.EMGM.Data.Either                         Generics.EMGM.Data.List                         Generics.EMGM.Data.Maybe+                        Generics.EMGM.Data.Ratio                         Generics.EMGM.Data.Tuple-                        Generics.EMGM.Data.TH -                        -- Deriving-                        Generics.EMGM.Derive--  other-modules:        Generics.EMGM.Derive.Common-                        Generics.EMGM.Derive.ConDescr-                        Generics.EMGM.Derive.EP-                        Generics.EMGM.Derive.Functions-                        Generics.EMGM.Derive.Instance-                        Generics.EMGM.Derive.Internal--  build-depends:        base >= 3.0 && < 4.0,-                        template-haskell >= 2.2 && < 2.4--  extensions:           CPP+  build-depends:        base >= 3.0 && < 5.0    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+  ghc-options:          -O2  -------------------------------------------------------------------------------- -Executable test-  hs-source-dirs:       src, tests, examples-  other-modules:        Generics.EMGM-  extensions:           CPP+Test-Suite test+  type:                 exitcode-stdio-1.0+  hs-source-dirs:       tests, src, examples   main-is:              Main.hs--  build-depends:        base >= 3.0 && < 4.0,-                        template-haskell >= 2.2 && < 2.4--  -- Only enable the build-depends here if configured with "-ftest". This-  -- allows users to use EMGM without having to install QuickCheck.-  if flag(test)-    build-depends:      QuickCheck >= 2.1 && < 2.2,-                        HUnit >= 1.2 && < 1.3-  else-    buildable:          False--  ghc-options:          -Wall -O0 -fno-warn-missing-signatures--  -- Add program coverage if configured with "-fhpc".-  if flag(hpc)-    ghc-options:        -fhpc+  build-depends:        base >= 3.0 && < 5.0,+                        HUnit >= 1.2 && < 1.3,+                        syb >= 0.3 && < 0.4,+                        QuickCheck >= 2.4 && < 2.5 

@@ -25,8 +25,8 @@  module Ex02AddingDatatypeSupport where -import Generics.EMGM.Derive-import qualified Generics.EMGM.Functions as G+import qualified Generics.EMGM as G+import Generics.EMGM.Base  -- Using generic functions on your own datatypes @@ -46,11 +46,12 @@ conLeaf, conBranch :: ConDescr conLeaf = ConDescr {   conName = "Leaf",-  conArity = 1, conLabels = [], conFixity = Nonfix+  conArity = 1, conRecord = False, conFixity = Prefix   }+ conBranch = ConDescr {   conName = "Branch",-  conArity = 2, conLabels = [], conFixity = Nonfix+  conArity = 2, conRecord = False, conFixity = Prefix   }  --    More structural definition:

@@ -28,7 +28,6 @@  -- Instance of Generic instance Generic Empty where-  rconstant      = error "Unreachable"   rint           = Empty 0   rinteger       = Empty 0   rfloat         = Empty 0

@@ -1,5 +1,3 @@-{-# LANGUAGE CPP                    #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM@@ -15,21 +13,13 @@ -- -- This module exports the most commonly used types, classes, and functions. The -- documentation is organized by topic for convenient access.------ For more in-depth documentation, refer to one of the modules in these--- hierarchies:------ * "Generics.EMGM.Common" - Common infrastructure for supporting datatypes and--- defining functions.------ * "Generics.EMGM.Functions" - Generic functions included with EMGM.------ * "Generics.EMGM.Derive" - Generating the EMGM representation for a datatype. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}+ module Generics.EMGM ( -  -- * Common Infrastructure+  -- * Foundation   --   -- | This is the collection of types, classes, and functions used to define   -- generic functions and to build representations for datatypes.@@ -61,15 +51,27 @@   -- information for some generic functions.    ConDescr(..),-  ConType(..),-+  LblDescr(..),   Fixity(..),+  Associativity(..),+  Prec,   prec,-  minPrec,-  maxPrec,-  appPrec,-  recPrec, +  -- ** Generic Function Classes+  --+  -- | Generic functions are instances of these classes. The value-level+  -- structure representation of datatypes is implemented using the members of+  -- these classes. Thus, a generic function is simply a case statement on the+  -- value-level structure.+  --+  -- Note that the numerical suffix represents the number of generic type+  -- variables used in the generic function. No suffix represents 1 generic type+  -- variable.++  Generic(..),+  Generic2(..),+  Generic3(..),+   -- ** Representation Dispatchers   --   -- | Type classes simplify the application of generic functions by providing@@ -104,31 +106,6 @@    BiFRep2(..), -  -- ** Generic Function Definition-  ---  -- | Generic functions are instances of these classes. The value-level-  -- structure representation of datatypes is implemented using the members of-  -- these classes. Thus, a generic function is simply a case statement on the-  -- value-level structure.-  ---  -- Note that the numerical suffix represents the number of generic type-  -- variables used in the generic function. No suffix represents 1 generic type-  -- variable.--  Generic(..),-  Generic2(..),-  Generic3(..),--  -- ** Deriving Representation-  ---  -- | The necessary values and instances for using EMGM with a user-defined-  -- datatype can be generated automatically using Template Haskell. By-  -- necessity, there are a number of exported values for this process that are-  -- unrelated to other uses of the EMGM library. In order to not export these-  -- signatures more than necessary, you should import "Generics.EMGM.Derive"-  -- for deriving the representation. Note that "Generics.EMGM" does not export-  -- anything in "Generics.EMGM.Derive".-   -- * Generic Functions   --   -- | The following collection of functions use the common EMGM infrastructure@@ -139,105 +116,80 @@   --   -- More information for each of these is available in its respective module. -  -- ** Collect Function+  -- ** Collect   --   -- | Function that collects values of one type from values of a possibly   -- different type.   --   -- For more details, see "Generics.EMGM.Functions.Collect". -  Collect(..),-   collect, -  -- ** Compare Functions+  -- ** Compare   --   -- | Functions that compare two values to determine an ordering.   --   -- For more details, see "Generics.EMGM.Functions.Compare". -  Compare(..),-   compare,-   eq,   neq,-   lt,   lteq,-   gt,   gteq,-   min,   max, -  -- ** Crush Functions+  -- ** Crush   --   -- | Functions that crush a polymorphic functor container into an iteration   -- over its elements.   --   -- For more details, see "Generics.EMGM.Functions.Crush". -  Crush(..),   Assoc(..),-   crush,   crushl,   crushr,-   flatten,   flattenl,   flattenr,-   first,   firstl,   firstr,-   and,   or,-   any,   all,-   sum,   product,-   minimum,   maximum,-   elem,   notElem, -  -- ** Enum Functions+  -- ** Enum   --   -- | Functions that enumerate the values of a datatype.   --   -- For more details, see "Generics.EMGM.Functions.Enum". -  Enum(..),-   enum,   enumN,-   empty, -  -- ** Everywhere Functions+  -- ** Everywhere   --   -- | Functions that apply a transformation at every location of one type in a   -- value of a possibly different type.   --   -- For more details, see "Generics.EMGM.Functions.Everywhere". -  Everywhere(..),-   everywhere,--  Everywhere'(..),-   everywhere', -  -- ** Map Functions+  -- ** Map   --   -- | Functions that translate values of one type to values of another. This   -- includes map-like functions that apply non-generic functions to every@@ -246,77 +198,93 @@   --   -- For more details, see "Generics.EMGM.Functions.Map". -  Map(..),-   map,-   replace,-   bimap,-   cast, -  -- ** Read Functions+  -- ** Meta   ---  -- | Functions similar to @deriving 'Prelude.Read'@ that parse a string and return a+  -- | Functions for extracting meta-information about the representation.+  --+  -- For more details, see "Generics.EMGM.Functions.Meta".++  HasEP(..),+  conDescr,+  lblDescrs,++  -- ** Read+  --+  -- | Functions similar to @deriving Prelude.Read@ that parse a string and return a   -- value of a datatype.   --   -- For more details, see "Generics.EMGM.Functions.Read". -  Read(..),-   readPrec,   readP,-   readsPrec,   reads,-   read, -  -- ** Show Functions+  -- ** Show   ---  -- | Functions similar to @deriving 'Prelude.Show'@ that return a string+  -- | Functions similar to @deriving Prelude.Show@ that return a string   -- representation of a value of a datatype.   --   -- For more details, see "Generics.EMGM.Functions.Show". -  Show(..),-   showsPrec,   shows,-   show, -  -- ** UnzipWith Functions+  -- ** Transpose   --+  -- | Functions that transpose polymorphic functor values.+  --+  -- For more details, see "Generics.EMGM.Functions.Transpose".++  transpose,+  transposeE,++  -- ** UnzipWith+  --   -- | Functions that split a polymorphic functor values into two structurally   -- equilvalent values.   --   -- For more details, see "Generics.EMGM.Functions.UnzipWith". -  UnzipWith(..),--  unzip,+  unzipWithM,   unzipWith,+  unzip, -  -- ** ZipWith Functions+  -- ** ZipWith   --   -- | Functions that combine two structurally equilvalent, polymorphic functor   -- values into one.   --   -- For more details, see "Generics.EMGM.Functions.ZipWith". -  ZipWith(..),--  zip,+  zipWithM,   zipWith,+  zip,  ) where -import qualified Prelude+import qualified Prelude () -import Generics.EMGM.Common-import Generics.EMGM.Functions+import Generics.EMGM.Base+import Generics.EMGM.Functions.Collect+import Generics.EMGM.Functions.Compare+import Generics.EMGM.Functions.Crush+import Generics.EMGM.Functions.Enum+import Generics.EMGM.Functions.Everywhere+import Generics.EMGM.Functions.Map+import Generics.EMGM.Functions.Meta+import Generics.EMGM.Functions.Read+import Generics.EMGM.Functions.Show+import Generics.EMGM.Functions.Transpose+import Generics.EMGM.Functions.UnzipWith+import Generics.EMGM.Functions.ZipWith  -- Export the instances from these import Generics.EMGM.Data.Bool()

@@ -0,0 +1,270 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Generics.EMGM.Base+-- Copyright   :  (c) 2008, 2009 Universiteit Utrecht+-- License     :  BSD3+--+-- Maintainer  :  generics@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Summary: Type classes used for generic functions with /one/ generic argument.+--+-- A /generic function/ is defined as an instance of 'Generic', 'Generic2', or+-- 'Generic3'. Each method in the class serves for a case in the datatype+-- representation+--+-- A /representation dispatcher/ simplifies the use of a generic function. There+-- must be an instance of each of the classes 'Rep', 'FRep', 'FRep2', etc. (that+-- apply) for every datatype.+-----------------------------------------------------------------------------++{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE OverlappingInstances  #-}++module Generics.EMGM.Base (++  -- | Re-export the types and related functions for the structure+  -- representation.++  module Generics.EMGM.Representation,++  -- * Classes for Generic Functions++  Generic(..),+  Generic2(..),+  Generic3(..),++  -- * Classes for Representation Dispatchers++  Rep(..),+  FRep(..),+  FRep2(..),+  BiFRep2(..),+  FRep3(..),++) where++import Generics.EMGM.Representation++-- | This class forms the foundation for defining generic functions with a+-- single generic argument. Each method represents a type case. There are cases+-- for primitive types, structural representation types, and for user-defined+-- datatypes.+--+-- The included modules using @Generic@ are:+--+-- * "Generics.EMGM.Functions.Collect"+--+-- * "Generics.EMGM.Functions.Compare"+--+-- * "Generics.EMGM.Functions.Constructor"+--+-- * "Generics.EMGM.Functions.Crush"+--+-- * "Generics.EMGM.Functions.Enum"+--+-- * "Generics.EMGM.Functions.Read"+--+-- * "Generics.EMGM.Functions.Show"++class Generic g where++  -- | Case for the primitive type 'Int'.+  rint      :: g Int++  -- | Case for the primitive type 'Integer'.++  rinteger  :: g Integer++  -- | Case for the primitive type 'Float'.++  rfloat    :: g Float++  -- | Case for the primitive type 'Double'.++  rdouble   :: g Double++  -- | Case for the primitive type 'Char'.++  rchar     :: g Char++  -- | Case for the structural representation type 'Unit'. Represents a+  -- constructor with no arguments.++  runit     :: g Unit++  -- | Case for the structural representation type @:+:@ (sum). Represents+  -- alternative constructors.++  rsum      :: g a -> g b -> g (a :+: b)++  -- | Case for the structural representation type @:*:@ (product). Represents+  -- the fields of a constructor.++  rprod     :: g a -> g b -> g (a :*: b)++  -- | Case for constructors. It is used to hold the meta-information about a+  -- constructor, e.g. name, arity, fixity, etc. This is not needed for many+  -- generic functions, so the default implementation is:+  --+  -- @+  --   rcon = const id+  -- @++  rcon      :: ConDescr -> g a -> g a+  rcon      = const id++  -- | Case for labeled field. Contains the label string. This is not needed for+  -- many generic functions, so the default implementation is:+  --+  -- @+  --   rlbl = const id+  -- @++  rlbl      :: LblDescr -> g a -> g a+  rlbl      = const id++  -- | 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'.++  rtype     :: EP b a -> g a -> g b+++infixr 5 `rsum`+infixr 6 `rprod`++-- | This class forms the foundation for defining generic functions with two+-- generic arguments. See 'Generic' for details.+--+-- The included modules using @Generic2@ are:+--+-- * "Generics.EMGM.Functions.Map"+--+-- * "Generics.EMGM.Functions.Transpose"++class Generic2 g where++  rint2      :: g Int Int+  rinteger2  :: g Integer Integer+  rfloat2    :: g Float Float+  rdouble2   :: g Double Double+  rchar2     :: g Char Char+  runit2     :: g Unit Unit+  rsum2      :: g a1 a2 -> g b1 b2 -> g (a1 :+: b1) (a2 :+: b2)+  rprod2     :: g a1 a2 -> g b1 b2 -> g (a1 :*: b1) (a2 :*: b2)++  rcon2      :: ConDescr -> g a1 a2 -> g a1 a2+  rcon2      = const id++  rlbl2      :: LblDescr -> g a1 a2 -> g a1 a2+  rlbl2      = const id++  -- | See 'rtype'. This case is the primary difference that separates+  -- 'Generic2' from 'Generic'. Since we have two generic type parameters, we+  -- need to have two 'EP' values. Each translates between the Haskell type and+  -- its generic representation.+  rtype2     :: EP a2 a1 -> EP b2 b1 -> g a1 b1 -> g a2 b2+++infixr 5 `rsum2`+infixr 6 `rprod2`++-- | This class forms the foundation for defining generic functions with three+-- generic arguments. See 'Generic' for details.+--+-- The included modules using @Generic3@ are:+--+-- * "Generics.EMGM.Functions.UnzipWith"+--+-- * "Generics.EMGM.Functions.ZipWith"++class Generic3 g where++  rint3      :: g Int Int Int+  rinteger3  :: g Integer Integer Integer+  rfloat3    :: g Float Float Float+  rdouble3   :: g Double Double Double+  rchar3     :: g Char Char Char+  runit3     :: g Unit Unit Unit+  rsum3      :: g a1 a2 a3 -> g b1 b2 b3 -> g (a1 :+: b1) (a2 :+: b2) (a3 :+: b3)+  rprod3     :: g a1 a2 a3 -> g b1 b2 b3 -> g (a1 :*: b1) (a2 :*: b2) (a3 :*: b3)++  rcon3      :: ConDescr -> g a1 a2 a3 -> g a1 a2 a3+  rcon3      = const id++  rlbl3      :: LblDescr -> g a1 a2 a3 -> g a1 a2 a3+  rlbl3      = const id++  -- | See 'rtype'. This case is the primary difference that separates+  -- 'Generic3' from 'Generic'. Since we have three generic type parameters, we+  -- need three 'EP' values. Each translates between the Haskell type and its+  -- generic representation.+  rtype3     :: EP a2 a1 -> EP b2 b1 -> EP c2 c1 -> g a1 b1 c1 -> g a2 b2 c2+++infixr 5 `rsum3`+infixr 6 `rprod3`++-- | Representation dispatcher for monomorphic types (kind @*@) used with+-- 'Generic'. Every structure type and supported datatype should have an+-- instance of 'Rep'.++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++-- | Representation dispatcher for functor types (kind @* -> *@) used with+-- 'Generic'.++class FRep g f where+  frep :: g a -> g (f a)++-- | Representation dispatcher for functor types (kind @* -> *@) used with+-- 'Generic2'.++class FRep2 g f where+  frep2 :: g a b -> g (f a) (f b)++-- | Representation dispatcher for bifunctor types (kind @* -> *@) used with+-- 'Generic2'.++class BiFRep2 g f where+  bifrep2 :: g a1 b1 -> g a2 b2 -> g (f a1 a2) (f b1 b2)++-- | Representation dispatcher for functor types (kind @* -> *@) used with+-- 'Generic3'.++class FRep3 g f where+  frep3 :: g a b c -> g (f a) (f b) (f c)+

@@ -1,27 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Generics.EMGM.Common
--- Copyright   :  (c) 2008, 2009 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
-

@@ -1,172 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE OverlappingInstances  #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Common.Base--- Copyright   :  (c) 2008, 2009 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 @:+:@ (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 @:*:@ (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 functor types (kind @* -> *@),--- sometimes called container types. (No default implementation.)-class FRep g f where-  frep :: g a -> g (f a)-

@@ -1,129 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators         #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Common.Base2--- Copyright   :  (c) 2008, 2009 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(..),-  BiFRep2(..),-) 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 @:+:@ (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 @:*:@ (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 functor types (kind @* -> *@),--- sometimes called container types. (No default implementation.)-class FRep2 g f where-  frep2 :: g a b -> g (f a) (f b)---- | The 'Generic2' representation dispatcher for bifunctor types (kind--- @* -> * -> *@). (No default implementation.)-class BiFRep2 g f where-  bifrep2 :: g a1 b1 -> g a2 b2 -> g (f a1 a2) (f b1 b2)-

@@ -1,125 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators         #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Common.Base3--- Copyright   :  (c) 2008, 2009 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 @:+:@ (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 @:*:@ (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 functor types (kind @* -> *@),--- sometimes called container types. (No default implementation.)-class FRep3 g f where-  frep3 :: g a b c -> g (f a) (f b) (f c)-

@@ -1,179 +0,0 @@---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Common.Representation--- Copyright   :  (c) 2008, 2009 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 unit, sum, and product types form the sum-of-products view for a-  -- Haskell datatype.--  Unit(..),-  (:+:)(..),-  (:*:)(..),--  -- * Embedding-Projection Pair-  ---  -- | A pair of a function and its inverse form the isomorphism between a-  -- datatype and its structure representation.--  EP(..),--  -- * Constructor Description-  ---  -- | A description of the syntax of each constructor provides useful auxiliary-  -- information for some generic functions.--  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,--  ) where--import Text.ParserCombinators.ReadPrec (minPrec, Prec)--infixr 5 :+:-infixr 6 :*:---- | The \"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. An @EP@ value preserves an isomorphism--- (ignoring @_|_@s) between a datatype and its structure representation.-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.------ NOTE: It is important that the 'ConDescr' value accurately describe the--- syntax in a constructor declaration. An incorrect description may lead to--- faulty 'Read' or 'Show' operation.-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 (Eq, 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 (Eq, Show)---- TODO: Need smart constructor(s) for ConDescr, so we can verify things.---- | An identifier's fixity, associativity, and precedence. If not infix--- ('Nonfix'), the associativity and precedence of the identifier is the same as--- function application. If infix, the associativity is indicated by the--- constructor and the precedence is an argument to it.-data Fixity-  = Nonfix      -- ^ Not infix. Associativity and precedence are the same as function application.-  | 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-

@@ -1,13 +1,3 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}-{-# LANGUAGE TypeOperators          #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverlappingInstances   #-}-{-# LANGUAGE UndecidableInstances   #-}-{-# OPTIONS -fno-warn-orphans       #-}-{-  OPTIONS -ddump-splices           -}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Data.Bool@@ -21,8 +11,19 @@ -- Summary: Generic representation and instances for 'Bool'. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE TypeSynonymInstances   #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverlappingInstances   #-}+{-# OPTIONS -fno-warn-orphans       #-}+{-  OPTIONS -ddump-splices           -}+ module Generics.EMGM.Data.Bool (-  epBool,+  BoolS,   conFalse,   conTrue,   repBool,@@ -32,43 +33,42 @@   bifrep2Bool, ) where -import Generics.EMGM.Derive.Internal--#ifndef __HADDOCK__--$(derive ''Bool)+import Control.Applicative (Alternative, pure) -#else--- The following code is used by Haddock to generate documentation. It may be--- useful to keep around for debugging TH, so don't remove it.+import Generics.EMGM.Base+import Generics.EMGM.Functions.Collect+import Generics.EMGM.Functions.Everywhere+import Generics.EMGM.Functions.Meta  ----------------------------------------------------------------------------- -- 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+-- Structure representation type for 'Bool'.+type BoolS = Unit :+: Unit --- | Embedding-projection pair for 'Bool'.-epBool :: EP Bool (Unit :+: Unit)+epBool :: EP Bool BoolS epBool = EP fromBool toBool+  where+    fromBool False = L Unit+    fromBool True  = R Unit+    toBool (L Unit) = False+    toBool (R Unit) = True +instance HasEP Bool BoolS where+  epOf _ = epBool+ ----------------------------------------------------------------------------- -- Representation values -----------------------------------------------------------------------------  -- | Constructor description for 'False'. conFalse :: ConDescr-conFalse = ConDescr "False" 0 [] Nonfix+conFalse = ConDescr "False" 0 False Prefix  -- | Constructor description for 'True'. conTrue :: ConDescr-conTrue = ConDescr "True" 0 [] Nonfix+conTrue = ConDescr "True" 0 False Prefix  -- | Representation of 'Bool' for 'rep'. repBool :: (Generic g) => g Bool@@ -108,14 +108,12 @@ instance (Generic g) => Rep g Bool where   rep = repBool -instance Rep (Collect Bool) Bool where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f Bool) Bool where+  rep = Collect pure  instance Rep (Everywhere Bool) Bool where   rep = Everywhere ($)  instance Rep (Everywhere' Bool) Bool where   rep = Everywhere' ($)--#endif 

@@ -1,13 +1,3 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}-{-# LANGUAGE TypeOperators          #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverlappingInstances   #-}-{-# LANGUAGE UndecidableInstances   #-}-{-# OPTIONS -fno-warn-orphans       #-}-{-  OPTIONS -ddump-splices           -}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Data.Either@@ -21,8 +11,19 @@ -- Summary: Generic representation and instances for 'Either'. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE TypeSynonymInstances   #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverlappingInstances   #-}+{-# OPTIONS -fno-warn-orphans       #-}+{-  OPTIONS -ddump-splices           -}+ module Generics.EMGM.Data.Either (-  epEither,+  EitherS,   conLeft,   conRight,   repEither,@@ -32,43 +33,42 @@   bifrep2Either, ) where -import Generics.EMGM.Derive.Internal--#ifndef __HADDOCK__--$(derive ''Either)+import Control.Applicative (Alternative, pure) -#else--- The following code is used by Haddock to generate documentation. It may be--- useful to keep around for debugging TH, so don't remove it.+import Generics.EMGM.Base+import Generics.EMGM.Functions.Collect+import Generics.EMGM.Functions.Everywhere+import Generics.EMGM.Functions.Meta  ----------------------------------------------------------------------------- -- 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+-- Structure representation type for 'Either'.+type EitherS a b = a :+: b --- | Embedding-projection pair for 'Either'.-epEither :: EP (Either a b) (a :+: b)+epEither :: EP (Either a b) (EitherS a b) epEither = EP fromEither toEither+  where+    fromEither (Left a)  = L a+    fromEither (Right b) = R b+    toEither (L a) = Left a+    toEither (R b) = Right b +instance HasEP (Either a b) (EitherS a b) where+  epOf _ = epEither+ ----------------------------------------------------------------------------- -- Representation values -----------------------------------------------------------------------------  -- | Constructor description for 'Left'. conLeft :: ConDescr-conLeft = ConDescr "Left" 1 [] Nonfix+conLeft = ConDescr "Left" 1 False Prefix  -- | Constructor description for 'Right'. conRight :: ConDescr-conRight = ConDescr "Right" 1 [] Nonfix+conRight = ConDescr "Right" 1 False Prefix  -- | Representation of 'Either' for 'frep'. frepEither :: (Generic g) => g a -> g b -> g (Either a b)@@ -80,7 +80,9 @@ -- | Representation of 'Either' for 'rep'. repEither :: (Generic g, Rep g a, Rep g b) => g (Either a b) repEither =-  frepEither rep rep+  rtype+    epEither+    (rcon conLeft rep `rsum` rcon conRight rep)  -- | Representation of 'Either' for 'frep2'. frep2Either :: (Generic2 g) => g a1 a2 -> g b1 b2 -> g (Either a1 b1) (Either a2 b2)@@ -111,8 +113,8 @@ instance (Generic2 g) => BiFRep2 g Either where   bifrep2 = bifrep2Either -instance Rep (Collect (Either a b)) (Either a b) where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f (Either a b)) (Either a b) where+  rep = Collect pure  instance (Rep (Everywhere (Either a b)) a, Rep (Everywhere (Either a b)) b)          => Rep (Everywhere (Either a b)) (Either a b) where@@ -125,6 +127,4 @@  instance Rep (Everywhere' (Either a b)) (Either a b) where   rep = Everywhere' ($)--#endif 

@@ -1,10 +1,3 @@-{-# LANGUAGE TypeOperators          #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverlappingInstances   #-}-{-# OPTIONS -fno-warn-orphans       #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Data.List@@ -18,8 +11,18 @@ -- Summary: Generic representation and instances for lists. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE TypeSynonymInstances   #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverlappingInstances   #-}+{-# OPTIONS -fno-warn-orphans       #-}+ module Generics.EMGM.Data.List (-  epList,+  ListS,   conNil,   conCons,   repList,@@ -29,35 +32,42 @@   bifrep2List, ) where -import Generics.EMGM.Derive.Internal+import Control.Applicative (Alternative, pure) +import Generics.EMGM.Base+import Generics.EMGM.Functions.Collect+import Generics.EMGM.Functions.Everywhere+import Generics.EMGM.Functions.Meta+ ----------------------------------------------------------------------------- -- 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+-- Structure representation type for lists.+type ListS a = Unit :+: a :*: [a] --- | Embedding-projection pair for lists.-epList :: EP [a] (Unit :+: (a :*: [a]))+epList :: EP [a] (ListS a) epList = EP fromList toList+  where+    fromList []        =  L Unit+    fromList (a : as)  =  R (a :*: as)+    toList (L Unit)        =  []+    toList (R (a :*: as))  =  a : as +instance HasEP [a] (ListS a) where+  epOf _ = epList+ ----------------------------------------------------------------------------- -- Representation values -----------------------------------------------------------------------------  -- | Constructor description for ''nil'': @[]@. conNil :: ConDescr-conNil = ConDescr "[]" 0 [] Nonfix+conNil = ConDescr "[]" 0 False Prefix  -- | Constructor description for ''cons'': @(:)@. conCons :: ConDescr-conCons = ConDescr ":" 2 [] (Infixr 5)+conCons = ConDescr ":" 2 False (Infix RightAssoc 5)  -- | Representation of lists for 'frep'. frepList :: (Generic g) => g a -> g [a]@@ -67,9 +77,11 @@     (rcon conNil runit `rsum` rcon conCons (ra `rprod` frepList ra))  -- | Representation of lists for 'rep'.-repList :: (Generic g, Rep g a) => g [a]+repList :: (Generic g, Rep g a, Rep g [a]) => g [a] repList =-  frepList rep+  rtype+    epList+    (rcon conNil runit `rsum` rcon conCons (rep `rprod` rep))  -- | Representation of lists for 'frep2'. frep2List :: (Generic2 g) => g a b -> g [a] [b]@@ -106,8 +118,8 @@ instance (Generic3 g) => FRep3 g [] where   frep3 = frep3List -instance Rep (Collect [a]) [a] where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f [a]) [a] where+  rep = Collect pure  instance (Rep (Everywhere [a]) a) => Rep (Everywhere [a]) [a] where   rep = Everywhere app

@@ -1,13 +1,3 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}-{-# LANGUAGE TypeOperators          #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverlappingInstances   #-}-{-# LANGUAGE UndecidableInstances   #-}-{-# OPTIONS -fno-warn-orphans       #-}-{-  OPTIONS -ddump-splices           -}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Data.Maybe@@ -21,8 +11,19 @@ -- Summary: Generic representation and instances for 'Maybe'. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE TypeSynonymInstances   #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverlappingInstances   #-}+{-# OPTIONS -fno-warn-orphans       #-}+{-  OPTIONS -ddump-splices           -}+ module Generics.EMGM.Data.Maybe (-  epMaybe,+  MaybeS,   conNothing,   conJust,   repMaybe,@@ -32,43 +33,42 @@   bifrep2Maybe, ) where -import Generics.EMGM.Derive.Internal--#ifndef __HADDOCK__--$(derive ''Maybe)+import Control.Applicative (Alternative, pure) -#else--- The following code is used by Haddock to generate documentation. It may be--- useful to keep around for debugging TH, so don't remove it.+import Generics.EMGM.Base+import Generics.EMGM.Functions.Collect+import Generics.EMGM.Functions.Everywhere+import Generics.EMGM.Functions.Meta  ----------------------------------------------------------------------------- -- 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+-- Structure representation type for 'Maybe'.+type MaybeS a = Unit :+: a --- | Embedding-projection pair for 'Maybe'.-epMaybe :: EP (Maybe a) (Unit :+: a)+epMaybe :: EP (Maybe a) (MaybeS a) epMaybe = EP fromMaybe toMaybe+  where+    fromMaybe Nothing  =  L Unit+    fromMaybe (Just a) =  R a+    toMaybe (L Unit) =  Nothing+    toMaybe (R a)    =  Just a +instance HasEP (Maybe a) (MaybeS a) where+  epOf _ = epMaybe+ ----------------------------------------------------------------------------- -- Representation values -----------------------------------------------------------------------------  -- | Constructor description for 'Nothing'. conNothing :: ConDescr-conNothing = ConDescr "Nothing" 0 [] Nonfix+conNothing = ConDescr "Nothing" 0 False Prefix  -- | Constructor description for 'Just'. conJust :: ConDescr-conJust = ConDescr "Just" 1 [] Nonfix+conJust = ConDescr "Just" 1 False Prefix  -- | Representation of 'Maybe' for 'frep'. frepMaybe :: (Generic g) => g a -> g (Maybe a)@@ -80,7 +80,9 @@ -- | Representation of 'Maybe' for 'rep'. repMaybe :: (Generic g, Rep g a) => g (Maybe a) repMaybe =-  frepMaybe rep+  rtype+    epMaybe+    (rcon conNothing rep `rsum` rcon conJust rep)  -- | Representation of 'Maybe' for 'frep2'. frep2Maybe :: (Generic2 g) => g a b -> g (Maybe a) (Maybe b)@@ -117,8 +119,8 @@ instance (Generic3 g) => FRep3 g Maybe where   frep3 = frep3Maybe -instance Rep (Collect (Maybe a)) (Maybe a) where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f (Maybe a)) (Maybe a) where+  rep = Collect pure  instance (Rep (Everywhere (Maybe a)) a) => Rep (Everywhere (Maybe a)) (Maybe a) where   rep = Everywhere app@@ -130,6 +132,4 @@  instance Rep (Everywhere' (Maybe a)) (Maybe a) where   rep = Everywhere' ($)--#endif 

@@ -0,0 +1,109 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Generics.EMGM.Data.Ratio+-- Copyright   :  (c) 2010 Antoine Latter, Universiteit Utrecht+-- License     :  BSD3+--+-- Maintainer  :  generics@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Summary: Generic representation and instances for 'Ratio'.+-----------------------------------------------------------------------------++{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE TypeSynonymInstances   #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverlappingInstances   #-}+{-# OPTIONS -fno-warn-orphans       #-}++module Generics.EMGM.Data.Ratio (+  RatioS,+  conRatio,+  repRatio,+  frepRatio,+  frep2Ratio,+  frep3Ratio,+  bifrep2Ratio,+) where++import Data.Ratio (Ratio, (%), numerator, denominator)+import Control.Applicative (Alternative, pure)+import Generics.EMGM.Base+import Generics.EMGM.Functions.Collect+import Generics.EMGM.Functions.Everywhere+import Generics.EMGM.Functions.Meta++-----------------------------------------------------------------------------+-- Embedding-projection pair+-----------------------------------------------------------------------------++type RatioS a = a :*: a++epRatio :: (Integral a) => EP (Ratio a) (a :*: a)+epRatio = EP f t+  where+    f r = numerator r :*: denominator r+    t (num :*: det) = num % det++instance (Integral a) => HasEP (Ratio a) (RatioS a) where+  epOf _ = epRatio++-----------------------------------------------------------------------------+-- Representation values+-----------------------------------------------------------------------------++-- | Constructor description for '%'.+conRatio :: ConDescr+conRatio = ConDescr "%" 2 False (Infix LeftAssoc 7)++-- | Representation of 'Ratio' for 'rep'.+repRatio :: (Integral a, Generic g, Rep g a) => g (Ratio a)+repRatio = rtype epRatio (rcon conRatio (rep `rprod` rep))++-- | Representation of 'Ratio' for 'frep'.+frepRatio :: (Integral a, Generic g) => g a -> g (Ratio a)+frepRatio a = rtype epRatio (rcon conRatio (a `rprod` a))++-- | Representation of 'Ratio' for 'frep2'.+frep2Ratio+  :: (Integral a1, Integral a2, Generic2 g)+  => g a1 a2 -> g (Ratio a1) (Ratio a2)+frep2Ratio a = rtype2 epRatio epRatio (rcon2 conRatio (a `rprod2` a))++-- | Representation of 'Ratio' for 'frep3'.+frep3Ratio+  :: (Integral a1, Integral a2, Integral a3, Generic3 g)+  => g a1 a2 a3 -> g (Ratio a1) (Ratio a2) (Ratio a3)+frep3Ratio a = rtype3 epRatio epRatio epRatio (rcon3 conRatio (a `rprod3` a))++-- | Representation of 'Ratio' for 'bifrep2'.+bifrep2Ratio+  :: (Integral a1, Integral a2, Generic2 g)+  => g a1 a2 -> g (Ratio a1) (Ratio a2)+bifrep2Ratio a = rtype2 epRatio epRatio (rcon2 conRatio (a `rprod2` a))++-----------------------------------------------------------------------------+-- Instance declarations+-----------------------------------------------------------------------------++instance (Integral a, Generic g, Rep g a) => Rep g (Ratio a) where+  rep = repRatio++instance (Alternative f) => Rep (Collect f (Ratio a)) (Ratio a) where+  rep = Collect pure++instance (Integral a, Rep (Everywhere (Ratio a)) a)+         => Rep (Everywhere (Ratio a)) (Ratio a) where+  rep = Everywhere app+    where+      app f r = f $+        selEverywhere rep f (numerator r) % selEverywhere rep f (denominator r)++instance Rep (Everywhere' (Ratio a)) (Ratio a) where+  rep = Everywhere' ($)+

@@ -1,71 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}-{-# LANGUAGE TypeOperators          #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverlappingInstances   #-}-{-# LANGUAGE UndecidableInstances   #-}-{-# OPTIONS -fno-warn-orphans       #-}-{-  OPTIONS -ddump-splices           -}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Data.TH--- Copyright   :  (c) 2008, 2009 Universiteit Utrecht--- License     :  BSD3------ Maintainer  :  generics@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ Summary: Generic representation and instances for Template Haskell types.------ The main purpose of this module is to export the instances for the--- representation dispatcher 'Rep'. For the rare cases in which it is needed,--- this module also exports the embedding-projection pair and constructor--- description.------ /NOTE/: The exported values are not explicitly documented, because there is a--- large number and they are all generated with Template Haskell expressions.--- For a detailed look, use the @:browse@ command in GHCi.--------------------------------------------------------------------------------module Generics.EMGM.Data.TH where--import Generics.EMGM.Derive.Internal hiding (conName, conFixity, Fixity)-import Language.Haskell.TH--#ifndef __HADDOCK__--$(deriveMono ''Name)-$(deriveMono ''Dec)-$(deriveMono ''Exp)-$(deriveMono ''Con)-$(deriveMono ''Type)-$(deriveMono ''Match)-$(deriveMono ''Clause)-$(deriveMono ''Body)-$(deriveMono ''Guard)-$(deriveMono ''Stmt)-$(deriveMono ''Range)-$(deriveMono ''Lit)-$(deriveMono ''Pat)-$(deriveMono ''Strict)-$(deriveMono ''Foreign)-$(deriveMono ''Callconv)-$(deriveMono ''Safety)-$(deriveMono ''FunDep)-$(deriveMono ''Info)--#ifdef TH_LOC_DERIVEREP--- This type is only provided in template-haskell-2.3 (included with GHC 6.10)--- and up.-$(deriveMono ''Loc)-#endif--$(deriveMono ''Fixity)-$(deriveMono ''FixityDirection)--#endif-

@@ -1,10 +1,3 @@-{-# LANGUAGE TypeOperators          #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE OverlappingInstances   #-}-{-# OPTIONS -fno-warn-orphans       #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Data.Tuple@@ -19,10 +12,20 @@ -- (''unit'') and 2 to 7. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE TypeSynonymInstances   #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverlappingInstances   #-}+{-# OPTIONS -fno-warn-orphans       #-}+ module Generics.EMGM.Data.Tuple (    -- * Unit: @()@-  epTuple0,+  Tuple0S,   conTuple0,   repTuple0,   frepTuple0,@@ -31,7 +34,7 @@   bifrep2Tuple0,    -- * Pair: @(a,b)@-  epTuple2,+  Tuple2S,   conTuple2,   repTuple2,   frepTuple2,@@ -40,7 +43,7 @@   bifrep2Tuple2,    -- * Triple: @(a,b,c)@-  epTuple3,+  Tuple3S,   conTuple3,   repTuple3,   frepTuple3,@@ -49,7 +52,7 @@   bifrep2Tuple3,    -- * Quadruple: @(a,b,c,d)@-  epTuple4,+  Tuple4S,   conTuple4,   repTuple4,   frepTuple4,@@ -58,7 +61,7 @@   bifrep2Tuple4,    -- * Quintuple: @(a,b,c,d,e)@-  epTuple5,+  Tuple5S,   conTuple5,   repTuple5,   frepTuple5,@@ -67,7 +70,7 @@   bifrep2Tuple5,    -- * Sextuple: @(a,b,c,d,e,f)@-  epTuple6,+  Tuple6S,   conTuple6,   repTuple6,   frepTuple6,@@ -76,7 +79,7 @@   bifrep2Tuple6,    -- * Septuple: @(a,b,c,d,e,f,h)@-  epTuple7,+  Tuple7S,   conTuple7,   repTuple7,   frepTuple7,@@ -86,20 +89,29 @@  ) where -import Generics.EMGM.Derive.Internal+import Control.Applicative (Alternative, pure) +import Generics.EMGM.Base+import Generics.EMGM.Functions.Collect+import Generics.EMGM.Functions.Everywhere+import Generics.EMGM.Functions.Meta+ ----------------------------------------------------------------------------- -- 0: () ----------------------------------------------------------------------------- --- | Embedding-projection pair for @()@.-epTuple0 :: EP () Unit+type Tuple0S = Unit++epTuple0 :: EP () Tuple0S epTuple0 = EP (\() -> Unit)               (\Unit -> ()) +instance HasEP () Tuple0S where+  epOf _ = epTuple0+ -- | Constructor description for @()@. conTuple0 :: ConDescr-conTuple0 = ConDescr "()" 0 [] Nonfix+conTuple0 = ConDescr "()" 0 False Prefix  -- | Representation of @()@ for 'rep'. repTuple0 :: (Generic g) => g ()@@ -136,14 +148,18 @@ -- 2: (a,b) ----------------------------------------------------------------------------- --- | Embedding-projection pair for @(,)@.-epTuple2 :: EP (a,b) (a :*: b)+type Tuple2S a b = a :*: b++epTuple2 :: EP (a,b) (Tuple2S a b) epTuple2 = EP (\(a,b) -> a :*: b)               (\(a :*: b) -> (a,b)) +instance HasEP (a,b) (Tuple2S a b) where+  epOf _ = epTuple2+ -- | Constructor description for @(,)@. conTuple2 :: ConDescr-conTuple2 = ConDescr "(,)" 2 [] Nonfix+conTuple2 = ConDescr "(,)" 2 False Prefix  -- | Representation of @(,)@ for 'frep'. frepTuple2 :: (Generic g) => g a -> g b -> g (a,b)@@ -180,14 +196,18 @@ -- 3: (a,b,c) ----------------------------------------------------------------------------- --- | Embedding-projection pair for @(,,)@.-epTuple3 :: EP (a,b,c) (a :*: b :*: c)+type Tuple3S a b c = a :*: b :*: c++epTuple3 :: EP (a,b,c) (Tuple3S a b c) epTuple3 = EP (\(a,b,c) -> a :*: b :*: c)               (\(a :*: b :*: c) -> (a,b,c)) +instance HasEP (a,b,c) (Tuple3S a b c) where+  epOf _ = epTuple3+ -- | Constructor description for @(,,)@. conTuple3 :: ConDescr-conTuple3 = ConDescr "(,,)" 3 [] Nonfix+conTuple3 = ConDescr "(,,)" 3 False Prefix  -- | Representation of @(,,)@ for 'frep'. frepTuple3 :: (Generic g) => g a -> g b -> g c -> g (a,b,c)@@ -199,7 +219,9 @@ -- | Representation of @(,,)@ for 'rep'. repTuple3 :: (Generic g, Rep g a, Rep g b, Rep g c) => g (a,b,c) repTuple3 =-  frepTuple3 rep rep rep+  rtype+    epTuple3+    (rcon conTuple3 (rep `rprod` rep `rprod` rep))  -- | Representation of @(,,)@ for 'frep2'. frep2Tuple3 :: (Generic2 g) => g a1 a2 -> g b1 b2 -> g c1 c2 -> g (a1,b1,c1) (a2,b2,c2)@@ -224,14 +246,18 @@ -- 4: (a,b,c,d) ----------------------------------------------------------------------------- --- | Embedding-projection pair for @(,,,)@.-epTuple4 :: EP (a,b,c,d) (a :*: b :*: c :*: d)+type Tuple4S a b c d = a :*: b :*: c :*: d++epTuple4 :: EP (a,b,c,d) (Tuple4S a b c d) epTuple4 = EP (\(a,b,c,d) -> a :*: b :*: c :*: d)               (\(a :*: b :*: c :*: d) -> (a,b,c,d)) +instance HasEP (a,b,c,d) (Tuple4S a b c d) where+  epOf _ = epTuple4+ -- | Constructor description for @(,,,)@. conTuple4 :: ConDescr-conTuple4 = ConDescr "(,,,)" 4 [] Nonfix+conTuple4 = ConDescr "(,,,)" 4 False Prefix  -- | Representation of @(,,,)@ for 'frep'. frepTuple4 :: (Generic g) => g a -> g b -> g c -> g d -> g (a,b,c,d)@@ -243,7 +269,9 @@ -- | Representation of @(,,,)@ for 'rep'. repTuple4 :: (Generic g, Rep g a, Rep g b, Rep g c, Rep g d) => g (a,b,c,d) repTuple4 =-  frepTuple4 rep rep rep rep+  rtype+    epTuple4+    (rcon conTuple4 (rep `rprod` rep `rprod` rep `rprod` rep))  -- | Representation of @(,,,)@ for 'frep2'. frep2Tuple4 :: (Generic2 g) => g a1 a2 -> g b1 b2 -> g c1 c2 -> g d1 d2 -> g (a1,b1,c1,d1) (a2,b2,c2,d2)@@ -268,14 +296,18 @@ -- 5: (a,b,c,d,e) ----------------------------------------------------------------------------- --- | Embedding-projection pair for @(,,,,)@.-epTuple5 :: EP (a,b,c,d,e) (a :*: b :*: c :*: d :*: e)+type Tuple5S a b c d e = a :*: b :*: c :*: d :*: e++epTuple5 :: EP (a,b,c,d,e) (Tuple5S 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)) +instance HasEP (a,b,c,d,e) (Tuple5S a b c d e) where+  epOf _ = epTuple5+ -- | Constructor description for @(,,,,)@. conTuple5 :: ConDescr-conTuple5 = ConDescr "(,,,,)" 5 [] Nonfix+conTuple5 = ConDescr "(,,,,)" 5 False Prefix  -- | Representation of @(,,,,)@ for 'frep'. frepTuple5 :: (Generic g) => g a -> g b -> g c -> g d -> g e -> g (a,b,c,d,e)@@ -287,7 +319,9 @@ -- | Representation of @(,,,,)@ for 'rep'. repTuple5 :: (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e) => g (a,b,c,d,e) repTuple5 =-  frepTuple5 rep rep rep rep rep+  rtype+    epTuple5+    (rcon conTuple5 (rep `rprod` rep `rprod` rep `rprod` rep `rprod` rep))  -- | Representation of @(,,,,)@ for 'frep2'. frep2Tuple5 :: (Generic2 g) => g a1 a2 -> g b1 b2 -> g c1 c2 -> g d1 d2 -> g e1 e2 -> g (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2)@@ -312,14 +346,18 @@ -- 6: (a,b,c,d,e,f) ----------------------------------------------------------------------------- --- | Embedding-projection pair for @(,,,,,)@.-epTuple6 :: EP (a,b,c,d,e,f) (a :*: b :*: c :*: d :*: e :*: f)+type Tuple6S a b c d e f = a :*: b :*: c :*: d :*: e :*: f++epTuple6 :: EP (a,b,c,d,e,f) (Tuple6S 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)) +instance HasEP (a,b,c,d,e,f) (Tuple6S a b c d e f) where+  epOf _ = epTuple6+ -- | Constructor description for @(,,,,,)@. conTuple6 :: ConDescr-conTuple6 = ConDescr "(,,,,,)" 6 [] Nonfix+conTuple6 = ConDescr "(,,,,,)" 6 False Prefix  -- | Representation of @(,,,,,)@ for 'frep'. frepTuple6 :: (Generic g) => g a -> g b -> g c -> g d -> g e -> g f -> g (a,b,c,d,e,f)@@ -331,7 +369,9 @@ -- | Representation of @(,,,,,)@ for 'rep'. repTuple6 :: (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e, Rep g f) => g (a,b,c,d,e,f) repTuple6 =-  frepTuple6 rep rep rep rep rep rep+  rtype+    epTuple6+    (rcon conTuple6 (rep `rprod` rep `rprod` rep `rprod` rep `rprod` rep `rprod` rep))  -- | Representation of @(,,,,,)@ for 'frep2'. frep2Tuple6 :: (Generic2 g) => g a1 a2 -> g b1 b2 -> g c1 c2 -> g d1 d2 -> g e1 e2 -> g f1 f2 -> g (a1,b1,c1,d1,e1,f1) (a2,b2,c2,d2,e2,f2)@@ -357,14 +397,18 @@ -- 7: (a,b,c,d,e,f,h) ----------------------------------------------------------------------------- --- | Embedding-projection pair for @(,,,,,,)@.-epTuple7 :: EP (a,b,c,d,e,f,h) (a :*: b :*: c :*: d :*: e :*: f :*: h)+type Tuple7S a b c d e f h = a :*: b :*: c :*: d :*: e :*: f :*: h++epTuple7 :: EP (a,b,c,d,e,f,h) (Tuple7S 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)) +instance HasEP (a,b,c,d,e,f,h) (Tuple7S a b c d e f h) where+  epOf _ = epTuple7+ -- | Constructor description for @(,,,,,,)@. conTuple7 :: ConDescr-conTuple7 = ConDescr "(,,,,,)" 7 [] Nonfix+conTuple7 = ConDescr "(,,,,,)" 7 False Prefix  -- | Representation of @(,,,,,,)@ for 'frep'. frepTuple7 :: (Generic g) => g a -> g b -> g c -> g d -> g e -> g f -> g h -> g (a,b,c,d,e,f,h)@@ -376,7 +420,9 @@ -- | Representation of @(,,,,,,)@ for 'rep'. repTuple7 :: (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e, Rep g f, Rep g h) => g (a,b,c,d,e,f,h) repTuple7 =-  frepTuple7 rep rep rep rep rep rep rep+  rtype+    epTuple7+    (rcon conTuple7 (rep `rprod` rep `rprod` rep `rprod` rep `rprod` rep `rprod` rep `rprod` rep))  -- | Representation of @(,,,,,,)@ for 'frep2'. frep2Tuple7 :: (Generic2 g) => g a1 a2 -> g b1 b2 -> g c1 c2 -> g d1 d2 -> g e1 e2 -> g f1 f2 -> g h1 h2 -> g (a1,b1,c1,d1,e1,f1,h1) (a2,b2,c2,d2,e2,f2,h2)@@ -425,26 +471,26 @@ instance (Generic2 g) => BiFRep2 g (,) where   bifrep2 = frep2Tuple2 -instance Rep (Collect ()) () where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f ()) () where+  rep = Collect pure -instance Rep (Collect (a,b)) (a,b) where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f (a,b)) (a,b) where+  rep = Collect pure -instance Rep (Collect (a,b,c)) (a,b,c) where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f (a,b,c)) (a,b,c) where+  rep = Collect pure -instance Rep (Collect (a,b,c,d)) (a,b,c,d) where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f (a,b,c,d)) (a,b,c,d) where+  rep = Collect pure -instance Rep (Collect (a,b,c,d,e)) (a,b,c,d,e) where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f (a,b,c,d,e)) (a,b,c,d,e) where+  rep = Collect pure -instance Rep (Collect (a,b,c,d,e,f)) (a,b,c,d,e,f) where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f (a,b,c,d,e,h)) (a,b,c,d,e,h) where+  rep = Collect pure -instance Rep (Collect (a,b,c,d,e,f,h)) (a,b,c,d,e,f,h) where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f (a,b,c,d,e,h,i)) (a,b,c,d,e,h,i) where+  rep = Collect pure  instance Rep (Everywhere' ()) () where   rep = Everywhere' ($)

@@ -1,314 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Derive--- Copyright   :  (c) 2008, 2009 Universiteit Utrecht--- License     :  BSD3------ Maintainer  :  generics@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ Summary: Functions for generating the representation for using a datatype--- with EMGM.------ The simplest way to get a representation for a datatype is using 'derive' in--- a Template Haskell declaration, e.g. @$('derive' ''MyType)@. This generates--- all of the appropriate instances, e.g. 'Rep', 'FRep', etc., for the type--- @MyType@.------ Generating datatype support can be done in a fully automatic way using--- 'derive' or 'deriveWith', or it can be done piecemeal using a number of other--- functions. For most needs, the automatic approach is fine. But if you find--- you need more control, use the manual deriving approach.------ Naming conventions:------ * @derive@ - Template Haskell function that generates instance declarations--- (and possibly also value declarations).------ * @declare@ - Template Haskell function that generates only value--- declarations.------ * @ep@ - Embedding-project pair.------ * @con@ - Constructor description.------ * @rep@ - Value representation meant for 'rep'.------ * @frep@ - Value representation meant for 'frep'.------ * @frep2@ - Value representation meant for 'frep2'.------ * @frep3@ - Value representation meant for 'frep3'.------ * @bifrep2@ - Value representation meant for 'bifrep2'.--------------------------------------------------------------------------------module Generics.EMGM.Derive (--  -- * Automatic Instance Deriving-  ---  -- | The functions 'derive' and 'deriveWith' determine which representations-  -- can be supported by your datatype. The indications are as follows for each-  -- class:-  ---  -- ['Rep'] This instance will be generated for every type.-  ---  -- ['FRep', 'FRep2', 'FRep3'] These instances will only be generated for-  -- functor types (kind @* -> *@).-  ---  -- ['BiFRep2'] This instance will only be generated for bifunctor types (kind-  -- @* -> * -> *@).--  derive,-  deriveWith,-  Modifier(..),-  Modifiers,--  deriveMany,-  deriveManyWith,--  deriveMono,-  deriveMonoWith,--  -- * Manual Instance Deriving-  ---  -- | Use the functions in this section for more control over the declarations-  -- and instances that are generated.-  ---  -- Since each function here generates one component needed for the entire-  -- datatype representation, you will most likely need to use multiple TH-  -- declarations. To get the equivalent of the resulting code described in-  -- 'derive', you will need the following:-  ---  -- >   {-# LANGUAGE TemplateHaskell        #-}-  -- >   {-# LANGUAGE MultiParamTypeClasses  #-}-  -- >   {-# LANGUAGE FlexibleContexts       #-}-  -- >   {-# LANGUAGE FlexibleInstances      #-}-  -- >   {-# LANGUAGE OverlappingInstances   #-}-  -- >   {-# LANGUAGE UndecidableInstances   #-}-  ---  -- @-  --   module Example where-  --   import Generics.EMGM.Derive-  --   data T a = C a Int-  -- @-  ---  -- @-  --   $(declareConDescrs ''T)-  --   $(declareEP ''T)-  --   $(declareRepValues ''T)-  --   $(deriveRep ''T)-  --   $(deriveFRep ''T)-  --   $(deriveCollect ''T)-  --   $(deriveEverywhere ''T)-  --   $(deriveEverywhere' ''T)-  -- @--  -- ** Constructor Description Declaration-  ---  -- | Use the following to generate only the 'ConDescr' declarations.--  declareConDescrs,-  declareConDescrsWith,--  -- ** Embedding-Project Pair Declaration-  ---  -- | Use the following to generate only the 'EP' declarations.--  declareEP,-  declareEPWith,--  -- ** Representation Value Declaration-  ---  -- | Use the following to generate only the representation values that are-  -- used in the instances for 'rep', 'frep', etc.--  declareRepValues,-  declareRepValuesWith,--  declareMonoRep,-  declareMonoRepWith,--  -- ** Rep Instance Deriving-  ---  -- | Use the following to generate only the 'Rep' instances.--  deriveRep,-  deriveRepWith,--  -- ** FRep Instance Deriving-  ---  -- | Use the following to generate only the 'FRep', 'FRep2', and 'FRep3'-  -- instances.--  deriveFRep,-  deriveFRepWith,--  -- ** BiFRep Instance Deriving-  ---  -- | Use the following to generate only the 'BiFRep2' instances.--  deriveBiFRep,-  deriveBiFRepWith,--  -- ** Function-Specific Instance Deriving-  ---  -- | Use the following to generate instances specific to certain functions.--  deriveCollect,-  deriveEverywhere,-  deriveEverywhere',--  -- * Datatype Representations-  ---  -- | This is the collection of representation values for datatypes included-  -- with EMGM.--  -- ** 'Bool'--  epBool,-  conFalse,-  conTrue,-  repBool,-  frepBool,-  frep2Bool,-  frep3Bool,-  bifrep2Bool,--  -- ** 'Either'--  epEither,-  conLeft,-  conRight,-  repEither,-  frepEither,-  frep2Either,-  frep3Either,-  bifrep2Either,--  -- ** List--  epList,-  conNil,-  conCons,-  repList,-  frepList,-  frep2List,-  frep3List,-  bifrep2List,--  -- ** 'Maybe'--  epMaybe,-  conNothing,-  conJust,-  repMaybe,-  frepMaybe,-  frep2Maybe,-  frep3Maybe,-  bifrep2Maybe,--  -- ** Tuples--  -- *** Unit: @()@-  epTuple0,-  conTuple0,-  repTuple0,-  frepTuple0,-  frep2Tuple0,-  frep3Tuple0,-  bifrep2Tuple0,--  -- *** Pair: @(a,b)@-  epTuple2,-  conTuple2,-  repTuple2,-  frepTuple2,-  frep2Tuple2,-  frep3Tuple2,-  bifrep2Tuple2,--  -- *** Triple: @(a,b,c)@-  epTuple3,-  conTuple3,-  repTuple3,-  frepTuple3,-  frep2Tuple3,-  frep3Tuple3,-  bifrep2Tuple3,--  -- *** Quadruple: @(a,b,c,d)@-  epTuple4,-  conTuple4,-  repTuple4,-  frepTuple4,-  frep2Tuple4,-  frep3Tuple4,-  bifrep2Tuple4,--  -- *** Quintuple: @(a,b,c,d,e)@-  epTuple5,-  conTuple5,-  repTuple5,-  frepTuple5,-  frep2Tuple5,-  frep3Tuple5,-  bifrep2Tuple5,--  -- *** Sextuple: @(a,b,c,d,e,f)@-  epTuple6,-  conTuple6,-  repTuple6,-  frepTuple6,-  frep2Tuple6,-  frep3Tuple6,-  bifrep2Tuple6,--  -- *** Septuple: @(a,b,c,d,e,f,h)@-  epTuple7,-  conTuple7,-  repTuple7,-  frepTuple7,-  frep2Tuple7,-  frep3Tuple7,-  bifrep2Tuple7,--  -- ** Template Haskell-  ---  -- | For using the representation of Template Haskell, import-  -- "Generics.EMGM.Data.TH". We don't export it here, because it exports-  -- names that conflict with EMGM names.--  -- ** Derived Generic Functions-  ---  -- | These @newtype@s are exported for generating their 'Rep' instances.--  Collect(..),-  Everywhere(..),-  Everywhere'(..),--  -- * Exported Modules-  ---  -- | Re-export these modules for generated code.--  module Generics.EMGM.Common,--) where---------------------------------------------------------------------------------- Imports--------------------------------------------------------------------------------import Generics.EMGM.Common-import Generics.EMGM.Derive.Internal--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-

@@ -1,342 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell            #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Derive--- Copyright   :  (c) 2008, 2009 Universiteit Utrecht--- License     :  BSD3------ Maintainer  :  generics@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ Summary: Common types and functions used in the deriving code.--------------------------------------------------------------------------------module Generics.EMGM.Derive.Common where---------------------------------------------------------------------------------- Imports--------------------------------------------------------------------------------import Data.List (nub)--import Language.Haskell.TH-import Data.Maybe (fromMaybe)--import Generics.EMGM.Common.Representation-import Generics.EMGM.Common.Base-import Generics.EMGM.Common.Base2-import Generics.EMGM.Common.Base3---------------------------------------------------------------------------------- Types---------------------------------------------------------------------------------- | Normalized form of a datatype declaration (@data@ and @newtype@)-data DT-  = DT-  { tname :: Name       -- Type name-  , tvars :: [Name]     -- Type variables-  , dcons :: [Con]      -- Data constructors-  , ncons :: [NCon]     -- Normalized data constructors-  } deriving Show---- | Normalized form of a constructor-data NCon-  = NCon-  { cname :: Name       -- Constructor name-  , cdescr :: Name      -- 'ConDescr' declaration name-  , cargtypes :: [Type] -- Constructor argument types-  , cvars :: [Name]     -- Generated constructor variable names-  } deriving Show-------------------------------------------------------------------------------------- | Modify the action taken for a given name.-data Modifier-  = ChangeTo String     -- ^ Change the syntactic name (of a type or-                        --   constructor) to the argument in the generated 'EP'-                        --   or 'ConDescr' value. This results in a value named-                        --   @epX@ or @conX@ if the argument is @\"X\"@.-  | DefinedAs String    -- ^ Use this for the name of a user-defined constructor-                        --   description instead of a generated one. The-                        --   generated code assumes the existance of @conX ::-                        --   'ConDescr'@ (in scope) if the argument is @\"X\"@.-  deriving Eq--instance Show Modifier where-  show (DefinedAs s) = s-  show (ChangeTo s)  = s---- | List of pairs mapping a (type or constructor) name to a modifier action.-type Modifiers = [(String, Modifier)]------------------------------------------------------------------------------------data RepOpt = OptRep | OptFRep | OptFRep2 | OptFRep3 | OptBiFRep2-  deriving (Eq, Show)--data RepNames-  = RepNames-  { genericCN'  :: Name -- ^ One of the 'Generic' classes-  , rintN'      :: Name -- ^ Method from 'Generic'-  , rintegerN'  :: Name -- ^ Method from 'Generic'-  , rfloatN'    :: Name -- ^ Method from 'Generic'-  , rdoubleN'   :: Name -- ^ Method from 'Generic'-  , rcharN'     :: Name -- ^ Method from 'Generic'-  , runitN'     :: Name -- ^ Method from 'Generic'-  , rsumN'      :: Name -- ^ Method from 'Generic'-  , rprodN'     :: Name -- ^ Method from 'Generic'-  , rconN'      :: Name -- ^ Method from 'Generic'-  , rtypeN'     :: Name -- ^ Method from 'Generic'-  , repCN'      :: Name -- ^ One of the 'Rep' classes-  , repN'       :: Name -- ^ Method from 'Rep'-  }--data RepFunNames-  = RepFunNames-  { repFunN     :: Name-  , frepFunN    :: Name-  , frep2FunN   :: Name-  , frep3FunN   :: Name-  , bifrep2FunN :: Name-  }---------------------------------------------------------------------------------- General functions--------------------------------------------------------------------------------toMaybeString :: Maybe Modifier -> Maybe String-toMaybeString mm = mm >>= return . show---- | Select the i-th field in an n-tuple-sel :: Int -> Int -> Q Exp-sel i _ | i < 0  = reportError $ "sel: Error! i (= " ++ show i ++ ") is not >= 0."-sel i n | i >= n = reportError $ "sel: Error! i (= " ++ show i ++ ") is not < n (= " ++ show n ++ ")."-sel i n          =-  do x <- newName "x"-     let firsts = replicate i wildP-         lasts = replicate (n - i - 1) wildP-         vars = firsts ++ varP x : lasts-         pats = [tupP vars]-         body = varE x-     lamE pats body-------------------------------------------------------------------------------------- | i: initial type, f: final type, s: sum element, p: product element-mkSop-  :: (i -> [s])-  -> (s -> [p])-  -> (p -> f)-  -> f-  -> (f -> f -> f)-  -> (f -> f -> f)-  -> (s -> f -> f)-  -> i-  -> f-mkSop toSumList toProdList inject unit mkSum mkProd wrapProd =-  listCase3 (error "zero") id more . map toProd . toSumList-  where-    more = foldNested mkSum-    toProd x = wrapProd x . productize unit inject mkProd $ toProdList x--mkSopDT-  :: (Type -> f)-  -> f-  -> (f -> f -> f)-  -> (f -> f -> f)-  -> (NCon -> f -> f)-  -> DT-  -> f-mkSopDT = mkSop ncons cargtypes--foldNested :: (a -> a -> a) -> a -> [a] -> a-foldNested f = go-  where-    go b []     = b-    go b (x:xs) = f b (go x xs)---- | Apply a function to each of 3 cases of a list: 0, 1, or > 1 elements-listCase3 :: b -> (a -> b) -> (a -> [a] -> b) -> [a] -> b-listCase3 zero one more ls =-  case ls of-    []   -> zero        -- 0 elements-    [x]  -> one x       -- 1 element-    x:xs -> more x xs   -- > 1 element---- | Given a unit value, an injection function, and a product operator, create a--- product form out of a list.-productize :: b -> (a -> b) -> (b -> b -> b) -> [a] -> b-productize unit inj prod = go-  where-    go = listCase3 unit inj more-    more x xs = prod (inj x) (go xs)-------------------------------------------------------------------------------------- | Given a prefix string, a possible string for the type name, a name, and a--- suffix string, create a function that appends either the type string name (if--- it exists) or the base of the type name to the prefix.-mkFunName :: String -> Maybe String -> Name -> String -> Name-mkFunName prefix maybeMiddle name suffix = result-  where-    middle = fromMaybe (nameBase name) maybeMiddle-    result = mkName $ showString prefix . showString middle $ suffix---- | Report an error message and fail-reportError :: String -> Q a-reportError msg = report True msg >> fail ""-------------------------------------------------------------------------------------- | Case the representation on the kind of the type.-caseKind :: RepOpt -> a -> a -> a -> a-caseKind opt k0 k1 k2 =-  case opt of-    OptRep     -> k0-    OptFRep    -> k1-    OptFRep2   -> k1-    OptFRep3   -> k1-    OptBiFRep2 -> k2---- | Case the representation on the 'Generic' class it relies on.-caseGen :: RepOpt -> a -> a -> a -> a-caseGen opt g g2 g3 =-  case opt of-    OptRep     -> g-    OptFRep    -> g-    OptFRep2   -> g2-    OptFRep3   -> g3-    OptBiFRep2 -> g2---- | Case the 'Rep' option or the others.-caseRep :: RepOpt -> a -> a -> a-caseRep opt r o =-  case opt of-    OptRep -> r-    _      -> o---- | Get the collection of names for a certain option. This allows the code to--- be generic across different instance definitions. For example, we use the--- same code to write the instances of 'Rep' as we do for 'BiFRep2'. Some of the--- differences are these names.-repNames :: RepOpt -> RepNames-repNames OptRep      = RepNames ''Generic  'rep   'rep       'rep     'rep      'rep    'runit  'rsum  'rprod  'rcon  'rtype  ''Rep     'rep-repNames OptFRep     = RepNames ''Generic  'rint  'rinteger  'rfloat  'rdouble  'rchar  'runit  'rsum  'rprod  'rcon  'rtype  ''FRep    'frep-repNames OptFRep2    = RepNames ''Generic2 'rint2 'rinteger2 'rfloat2 'rdouble2 'rchar2 'runit2 'rsum2 'rprod2 'rcon2 'rtype2 ''FRep2   'frep2-repNames OptFRep3    = RepNames ''Generic3 'rint3 'rinteger3 'rfloat3 'rdouble3 'rchar3 'runit3 'rsum3 'rprod3 'rcon3 'rtype3 ''FRep3   'frep3-repNames OptBiFRep2  = RepNames ''Generic2 'rint2 'rinteger2 'rfloat2 'rdouble2 'rchar2 'runit2 'rsum2 'rprod2 'rcon2 'rtype2 ''BiFRep2 'bifrep2--funName :: RepOpt -> RepFunNames -> Name-funName OptRep      = repFunN-funName OptFRep     = frepFunN-funName OptFRep2    = frep2FunN-funName OptFRep3    = frep3FunN-funName OptBiFRep2  = bifrep2FunN---- | Get the actual name that is analogous to each of these function names. This--- allows the code to be generic across different instance definitions.-genericCN, rintN, rintegerN, rfloatN, rdoubleN, rcharN, runitN, rsumN, rprodN, rconN, rtypeN, repCN, repN :: RepOpt -> Name-genericCN = genericCN' . repNames-rintN     = rintN'     . repNames-rintegerN = rintegerN' . repNames-rfloatN   = rfloatN'   . repNames-rdoubleN  = rdoubleN'  . repNames-rcharN    = rcharN'    . repNames-runitN    = runitN'    . repNames-rsumN     = rsumN'     . repNames-rprodN    = rprodN'    . repNames-rconN     = rconN'     . repNames-rtypeN    = rtypeN'    . repNames-repCN     = repCN'     . repNames-repN      = repN'      . repNames-------------------------------------------------------------------------------------- | Make a type as applied to its type variables from the type name and list of--- parameters.-mkAppliedType' :: Name -> [Name] -> Q Type-mkAppliedType' typ vars =-  foldl appT (conT typ) (map varT vars)---- | Make a type as applied to its type variables (if any) from a DT-mkAppliedType :: RepOpt -> DT -> Q Type-mkAppliedType opt dt =-  appTypeCon varTypes-  where-    varTypes = map varT (tvars dt)-    appTypeCon = foldl appT (conT (tname dt)) . dropLast arity-    len = length varTypes-    dropLast n xs = if len > n then take (len - n) xs else []-    arity = caseKind opt 0 1 2--mkAppliedFun :: Name -> [Name] -> Q Exp-mkAppliedFun fun vars =-  foldl appE (varE fun) (map varE vars)------------------------------------------------------------------------------------mkRepT :: RepOpt -> Q Type -> Q Type -> Q Type-mkRepT opt funType = appT (appT (conT (repCN opt)) funType)--mkGenericT :: RepOpt -> Q Type -> Q Type-mkGenericT opt = appT (conT (genericCN opt))---- | Make the rep instance context-mkRepInstCxt :: RepOpt -> Q Type -> DT -> Q Cxt-mkRepInstCxt opt funType dt = do--  -- Build a list of the 'Rep' class constraints-  repConstraints <--    case opt of-      OptRep -> do-        -- List of types from all the fields of the all the constructors-        let fieldTypes = concatMap cargtypes (ncons dt)-        fieldConstraints <- mapM (mkRepT opt funType . return) fieldTypes-        -- List of type variables-        varConstraints <- mapM (mkRepT opt funType . varT) (tvars dt)-        -- Final list of 'Rep' constraints with duplicates removed-        return $ nub (varConstraints ++ fieldConstraints)-      _ ->-        return []--  -- Build the 'Generic' class constraint-  genConstraint <- mkGenericT opt funType--  -- Combine the 'Generic' and 'Rep' constraints-  return (genConstraint : repConstraints)---- | Make the rep instance type-mkRepInstT :: RepOpt -> DT -> Q Type -> Q Type-mkRepInstT opt dt funType = mkRepT opt funType (mkAppliedType opt dt)------------------------------------------------------------------------------------unitE :: Exp-unitE = ConE 'Unit--prodE :: Exp -> Exp -> Exp-prodE a b = (InfixE (Just a) (ConE '(:*:)) (Just b))--sumE :: Name -> Exp -> Exp-sumE name x = AppE (ConE name) x--unitP :: Pat-unitP = ConP 'Unit []--prodP :: Pat -> Pat -> Pat-prodP a b = (InfixP a '(:*:) b)--sumP :: Name -> Pat -> Pat-sumP name x = ConP name [x]--dataE :: (Exp -> Exp) -> NCon -> Exp-dataE f (NCon name _ _ vars) =-  foldl (\e -> AppE e . f . VarE) (ConE name) vars--dataP :: NCon -> Pat-dataP (NCon name _ _ vars) = ConP name (map VarP vars)-

@@ -1,113 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Derive.ConDescr--- Copyright   :  (c) 2008, 2009 Universiteit Utrecht--- License     :  BSD3------ Maintainer  :  generics@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ Summary: Code for generating a value of 'ConDescr' in TH.--------------------------------------------------------------------------------module Generics.EMGM.Derive.ConDescr (-#ifndef __HADDOCK__-  mkConDescr,-#endif-) where--#ifndef __HADDOCK__---------------------------------------------------------------------------------- Imports--------------------------------------------------------------------------------import Language.Haskell.TH--import qualified Generics.EMGM.Common.Representation as ER -- EMGM Rep-import Generics.EMGM.Derive.Common---------------------------------------------------------------------------------- General functions--------------------------------------------------------------------------------conFixity :: Name -> Q Fixity-conFixity name =-  do info <- reify name-     case info of-       DataConI _ _ _ fixity ->-         return fixity-       _ ->-         reportError $ showString "Unexpected name \""-                     . showString (nameBase name)-                     $ "\" when looking for an infix data constructor."----- | Build an expression for a value of EMGM's Fixity type-fixityE :: Maybe Fixity -> Exp-fixityE Nothing             = ConE 'ER.Nonfix-fixityE (Just (Fixity p d)) =-  case d of-    InfixL -> mkE 'ER.Infixl-    InfixR -> mkE 'ER.Infixr-    InfixN -> mkE 'ER.Infix-  where-    mkE :: Name -> Exp-    mkE name = AppE (ConE name) (LitE (IntegerL $ fromIntegral p))---- | Build a 'ConDescr' expression-mkConDescrE :: String -> Int -> [String] -> Maybe Fixity -> Exp-mkConDescrE name arity labels fixity =-  foldl AppE (ConE 'ER.ConDescr)-    [ LitE (StringL name)-    , LitE (IntegerL $ fromIntegral arity)-    , ListE $ map (LitE . StringL) labels-    , fixityE fixity ]---- | Make a 'ConDescr' expression and return a pair of the stringified--- constructor name and AST expression value.-conDescrE :: Con -> Q (String,Exp)-conDescrE c =-  case c of-    NormalC name args ->-      do let nb = nameBase name-         return (nb, mkConDescrE nb (length args) [] Nothing)-    RecC name args ->-      do let nb = nameBase name-             labels = map (nameBase . $(sel 0 3)) args-         return (nb, mkConDescrE nb (length args) labels Nothing)-    InfixC _ name _ ->-      do let nb = nameBase name-         fixity <- conFixity name-         return (nb, mkConDescrE nb 2 [] (Just fixity))-    other ->-      -- Should never reach-      reportError $ "conDescrE: Unsupported constructor: '" ++ show other ++ "'"--cdDecs :: Name -> Exp -> [Dec]-cdDecs n e = [SigD n (ConT ''ER.ConDescr), ValD (VarP n) (NormalB e) []]---- | Make a 'ConDescr' declaration and return a pair of the declaration name--- and AST value.-mkConDescr :: Maybe Modifier -> Con -> Q (Name, Maybe [Dec])-mkConDescr maybeCdName c =-  do (cstr, e) <- conDescrE c-     let mkPair s isDeclared =-           let name = mkName ("con" ++ s)-               dec = if isDeclared then Just (cdDecs name e) else Nothing-           in (name, dec)-     let pair =-           case maybeCdName of-             Nothing  -> mkPair cstr True-             Just m   ->-               case m of-                 DefinedAs s -> mkPair s False-                 ChangeTo s  -> mkPair s True-     return pair--#endif-

@@ -1,125 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Derive.EP--- Copyright   :  (c) 2008, 2009 Universiteit Utrecht--- License     :  BSD3------ Maintainer  :  generics@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ Summary: Code for generating the 'EP' value in TH.--------------------------------------------------------------------------------module Generics.EMGM.Derive.EP (-#ifndef __HADDOCK__-  mkEP,-#endif-) where--#ifndef __HADDOCK__---------------------------------------------------------------------------------- Imports--------------------------------------------------------------------------------import Language.Haskell.TH---- TODO: List imports--import Generics.EMGM.Common.Representation-import Generics.EMGM.Derive.Common---------------------------------------------------------------------------------- General functions---------------------------------------------------------------------------------- | Apply an inductive function @fn@ recursively @n@ times. Then, apply a base--- function @fz@. Restriction: @n >= 0@.-appN :: (a -> b) -> (b -> b) -> Int -> a -> b-appN fz _  0 x = fz x-appN fz fn n x = fn (appN fz fn (n - 1) x)-------------------------------------------------------------------------------------- | Create a product representation from a single constructor-conProd :: a -> (a -> a -> a) -> (Name -> a) -> NCon -> a-conProd unit prod var = namesRep . cvars-  where-    namesRep = productize unit id prod . map var---- | Change a list of product representations to a list of sums of products.--- For example, the list of reps  A, B, and C becomes L A, R (L B), and R (R C).-repsSums :: (Name -> a -> a) -> [a] -> [a]-repsSums mkSum = listCase3 [] (:[]) more-  where-    inL = mkSum 'L-    inR = mkSum 'R--    -- Apply inR and inL the appropriate number of times to inject the product-    -- rep into the correct sum rep value.-    more x xs = inL x : appLR 1 xs--    appLR n (y:[]) = [appN inR inR (n - 1) y]-    appLR n (y:ys) = appN inL inR n y : appLR (n + 1) ys-    appLR _ _      = error "repsSums: Should not be here!"---- | Translate constructors to syntax elements for sum-of-product representation-consReps :: a -> (a -> a -> a) -> (Name -> a) -> (Name -> a -> a) -> [NCon] -> [a]-consReps unit prod var sum_ = repsSums sum_ . prods-  where-    prods = map (conProd unit prod var)-------------------------------------------------------------------------------------- | Create a list of clauses from a list of constructors-consClauses :: (a -> [Pat]) -> (a -> [Exp]) -> a -> [Clause]-consClauses mkPats mkExps cons = zipWith mkClause (mkPats cons) (mkExps cons)-  where-    mkClause p e = Clause [p] (NormalB e) []---- | Given the constructors of a datatype, create a pair of the direction and--- the clause for each component of the embedding-projection pair.-fromClauses, toClauses :: [NCon] -> [Clause]-fromClauses = consClauses (map dataP) (consReps unitE prodE VarE sumE)-toClauses   = consClauses (consReps unitP prodP VarP sumP) (map (dataE id))---- | Given a function that translates constructors to clause (plus direction), a--- possible type string name, and a type name, make a function declaration.-mkFunD :: ([NCon] -> [Clause]) -> DT -> Name -> Dec-mkFunD mkClauses dt funNm = FunD funNm (mkClauses (ncons dt))------------------------------------------------------------------------------------mkEpSig :: DT -> Name -> Dec-mkEpSig dt ep = SigD ep typ-  where-    vars = tvars dt-    typ = ForallT vars [] (AppT (AppT (ConT ''EP) rtyp) styp)-    rtyp = foldl AppT (ConT (tname dt)) . map VarT $ vars-    mkSum = AppT . AppT (ConT ''(:+:))-    mkProd = AppT . AppT (ConT ''(:*:))-    unit = ConT ''Unit-    styp = mkSopDT id unit mkSum mkProd (flip const) dt-------------------------------------------------------------------------------------- | Given a possible type string name and a type name, declare the--- embedding-projection pair for a datatype.-mkEP :: Modifiers -> DT -> Name -> Name -> (Name, [Dec])-mkEP mods dt fromName toName = (epName, [epSig, epDec])-  where-    typeName = tname dt-    maybeTypeStr = toMaybeString $ lookup (nameBase typeName) mods-    epName = mkFunName "ep" maybeTypeStr typeName ""-    fromDec = mkFunD fromClauses dt fromName-    toDec = mkFunD toClauses dt toName-    body = AppE (AppE (ConE 'EP) (VarE fromName)) (VarE toName)-    epSig = mkEpSig dt epName-    epDec = ValD (VarP epName) (NormalB body) [fromDec, toDec]--#endif-

@@ -1,92 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Derive.Functions--- Copyright   :  (c) 2008, 2009 Universiteit Utrecht--- License     :  BSD3------ Maintainer  :  generics@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ Summary: Code for generating function-specific instances in TH.--------------------------------------------------------------------------------module Generics.EMGM.Derive.Functions (-#ifndef __HADDOCK__-  mkRepCollectInst,-  mkRepEverywhereInst,-  mkRepEverywhereInst',-#endif-) where--#ifndef __HADDOCK__---------------------------------------------------------------------------------- Imports--------------------------------------------------------------------------------import Language.Haskell.TH--import Generics.EMGM.Common.Base-import Generics.EMGM.Derive.Common--import Generics.EMGM.Functions.Collect-import Generics.EMGM.Functions.Everywhere-------------------------------------------------------------------------------------- | Make the instance for a function-specific Rep instance-mkRepFunctionInst :: DT -> Name -> Q Cxt -> Q Exp -> Q Dec-mkRepFunctionInst dt newtypeName ctx bodyExp = do-  let t = mkAppliedType OptRep dt-  let typ = mkRepInstT OptRep dt (appT (conT newtypeName) t)-  let dec = valD (varP 'rep) (normalB bodyExp) []-  instanceD ctx typ [dec]-------------------------------------------------------------------------------------- | Make the instance for a Rep Collect T (where T is the type)-mkRepCollectInst :: DT -> Q Dec-mkRepCollectInst dt = do-  mkRepFunctionInst dt ''Collect (return []) [|Collect (\x -> [x])|]------------------------------------------------------------------------------------mkEverywhereFunE :: DT -> Q Exp-mkEverywhereFunE dt = lamE [fpat, xpat] caseExp-  where-    f = mkName "f"-    x = mkName "x"-    xpat = varP x-    fpat = varP f-    appSel = AppE (AppE (AppE (VarE 'selEverywhere) (VarE 'rep)) (VarE f))-    appF = appE (varE f)-    caseExp = caseE (varE x) matches-    matches = zipWith mkMatch pats exps-    mkMatch p e = match (return p) (normalB (appF (return e))) []-    ncs = ncons dt-    pats = map dataP ncs-    exps = map (dataE appSel) ncs---- | Make the instance for a Rep Everywhere T (where T is the type)-mkRepEverywhereInst :: DT -> Q Dec-mkRepEverywhereInst dt = do-  let dtyp = mkAppliedType OptRep dt-  let typ = appT (conT ''Everywhere) dtyp-  let bodyExp = appE (conE 'Everywhere) (mkEverywhereFunE dt)-  repCtx <- mkRepInstCxt OptRep typ dt-  let ctx = return (tail repCtx)-  mkRepFunctionInst dt ''Everywhere ctx bodyExp-------------------------------------------------------------------------------------- | Make the instance for a Rep Everywhere' T (where T is the type)-mkRepEverywhereInst' :: DT -> Q Dec-mkRepEverywhereInst' dt =-  mkRepFunctionInst dt ''Everywhere' (return []) [|Everywhere' (\f x -> f x)|]--#endif-

@@ -1,266 +0,0 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE MultiParamTypeClasses      #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Derive--- Copyright   :  (c) 2008, 2009 Universiteit Utrecht--- License     :  BSD3------ Maintainer  :  generics@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ Summary: Code for generating the representation dispatcher class instances in--- TH.--------------------------------------------------------------------------------module Generics.EMGM.Derive.Instance (-#ifndef __HADDOCK__-  RepOpt(..),-  RepFunNames(..),-  mkRepFun,-  mkRepInst,-#endif-) where--#ifndef __HADDOCK__---------------------------------------------------------------------------------- Imports--------------------------------------------------------------------------------import Data.List (transpose)--import Language.Haskell.TH--import Generics.EMGM.Derive.Common---------------------------------------------------------------------------------- Types---------------------------------------------------------------------------------------------------------------------------------------------------------------- General functions--------------------------------------------------------------------------------repStr :: RepOpt -> String-repStr OptRep      = "rep"-repStr OptFRep     = "frep"-repStr OptFRep2    = "frep2"-repStr OptFRep3    = "frep3"-repStr OptBiFRep2  = "bifrep2"---- | Handle the renaming of the functions for the built-in symbol types.-symbolMods :: Modifiers-symbolMods =-  [ ("[]",ChangeTo "List")-  , ("()",ChangeTo "Tuple0")-  , ("(,)",ChangeTo "Tuple2")-  , ("(,,)",ChangeTo "Tuple3")-  , ("(,,,)",ChangeTo "Tuple4")-  , ("(,,,,)",ChangeTo "Tuple5")-  , ("(,,,,,)",ChangeTo "Tuple6")-  , ("(,,,,,,)",ChangeTo "Tuple7")-  ]--toFunName :: Modifiers -> RepOpt -> Name -> Name-toFunName mods opt nm =-  mkName (repStr opt ++ result)-  where-    str = nameBase nm-    result =-      case toMaybeString (lookup str (mods ++ symbolMods)) of-        Nothing     -> str-        Just newStr -> newStr--primRepName :: Name -> RepOpt -> Maybe Name-primRepName typ opt =-  case nameBase typ of-    "Int"     -> Just (rintN opt)-    "Integer" -> Just (rintegerN opt)-    "Float"   -> Just (rfloatN opt)-    "Double"  -> Just (rdoubleN opt)-    "Char"    -> Just (rcharN opt)-    _         -> Nothing--typSyn :: Name -> Q (Maybe Type)-typSyn typ = do-  info <- reify typ-  case info of-    TyConI dec ->-      case dec of-        TySynD _ _ unSynTyp ->-          return (Just unSynTyp)-        _ ->-          return Nothing-    _ ->-      return Nothing--typeUnknownError :: Int -> RepOpt -> Type -> Q a-typeUnknownError i opt t = do-  error $ "Error #" ++ show i ++ ": Unsupported type for " ++ show opt ++ ": " ++ show t---- | Produce the variable expression for the appropriate 'rep', 'frep', etc.-varRepExp :: Modifiers -> RepOpt -> DT -> Type -> Q Exp-varRepExp mods opt dt =-  caseRep opt (varE (repN opt)) . go-  where-    typE nm = varE (toFunName mods opt nm)--    appFun t = foldl appE (typE t) . map go--    go t =-      case t of--        VarT v ->-          if v `elem` tvars dt then varE v else typeUnknownError 34 opt t--        ConT typ ->-          case primRepName typ opt of-            Just nm ->-              varE nm-            Nothing -> do-              mts <- typSyn typ-              case mts of-                Just ts  -> go ts-                Nothing -> varE (toFunName mods opt typ)--        AppT (ConT typ) a ->-          appFun typ [a]--        AppT (AppT (ConT typ) a1) a2 ->-          appFun typ [a1,a2]--        AppT (AppT (AppT (ConT typ) a1) a2) a3 ->-          appFun typ [a1,a2,a3]--        AppT (AppT (AppT (AppT (ConT typ) a1) a2) a3) a4 ->-          appFun typ [a1,a2,a3,a4]--        AppT (AppT (AppT (AppT (AppT (ConT typ) a1) a2) a3) a4) a5 ->-          appFun typ [a1,a2,a3,a4,a5]--        AppT (AppT (AppT (AppT (AppT (AppT (ConT typ) a1) a2) a3) a4) a5) a6 ->-          appFun typ [a1,a2,a3,a4,a5,a6]--        AppT (AppT (AppT (AppT (AppT (AppT (AppT (ConT typ) a1) a2) a3) a4) a5) a6) a7 ->-          appFun typ [a1,a2,a3,a4,a5,a6,a7]--        _ ->-          typeUnknownError 50 opt t---- | Construct the expression for the appropriate 'rtype', 'rtype2', etc.-rtypeE :: RepOpt -> Name -> Q Exp -> Q Exp-rtypeE opt epName sopE =-  caseGen opt (appToSop ep1) (appToSop ep2) (appToSop ep3)-  where-    appToEp e = appE e (varE epName)-    appToSop eps = appE eps sopE-    ep1 = appToEp (varE (rtypeN opt))-    ep2 = appToEp ep1-    ep3 = appToEp ep2-------------------------------------------------------------------------------------- | Construct the sum-of-product expression for the appropriate 'rep', 'frep',--- 'frep2', etc.-repSopE :: Modifiers -> RepOpt -> DT -> Q Exp-repSopE mods opt dt =-  mkSopDT inject unit mkSum mkProd wrapProd dt-  where-    inject = varRepExp mods opt dt-    mkSum = appE . appE (varE (rsumN opt))-    mkProd = appE . appE (varE (rprodN opt))-    unit = varE (runitN opt)-    wrapProd ncon = appE (appE (varE (rconN opt)) (varE (cdescr ncon)))---- | The number of generic type variables in the representation.-genTypeVars :: RepOpt -> Int-genTypeVars opt = caseGen opt 1 2 3---- | Make the signature return type given a @g@ type variable, a type name, and--- a list of list of parameters. The list of parameters is arranged in the order--- for the function arguments, so it must be transposed.-mkSigReturnT :: RepOpt -> Q Type -> Name -> [[Name]] -> Q Type-mkSigReturnT opt gvar typ =-  foldl appT gvar . map (mkAppliedType' typ) . fillNil . transpose-  where-    fillNil [] = replicate (genTypeVars opt) []-    fillNil xs = xs---- | Make the representation function signature.-mkRepFunSigT :: RepOpt -> DT -> Q Type-mkRepFunSigT opt dt = do-  -- The Generic class parameter-  let gname = mkName "g"-  let gvar = varT gname--  -- Build a list of lists of type variable names. Each sublist is the set of-  -- parameters to each 'g' type in the function arguments. For 'rep', we keep-  -- the original type variable list, because it's also used in the context.-  let mkVarNameList _ c = map (\i -> mkName (c:show i)) [1..genTypeVars opt]-  let varNameLists =-        caseRep opt-          (map (:[]) (tvars dt))-          (zipWith mkVarNameList (tvars dt) ['a'..])--  -- Type variables for this function signature-  let vars = gname : concat varNameLists--  -- Build a list of argument types using the variable name list of lists from-  -- above.-  let mkArrArgs as = appT arrowT (foldl appT gvar (map varT as))-  let args = caseRep opt [] (map mkArrArgs varNameLists)--  -- The return type-  let retTyp = mkSigReturnT opt gvar (tname dt) varNameLists--  -- Combine the return type with the argument types to get the final signature.-  let typ = foldr appT retTyp args--  -- Context with class constraints-  let ctx = mkRepInstCxt opt gvar dt--  -- Done!-  forallT vars ctx typ---- | Make the representation functions, e.g. 'repMaybe', 'frepMaybe',--- 'frep2Maybe', 'frep3Maybe', and 'bifrep2Maybe'-mkRepFun :: Modifiers -> RepOpt -> DT -> Name -> Q (Name, [Dec])-mkRepFun mods opt dt ep = do--  -- Name of function-  let nm = toFunName mods opt (tname dt)--  -- Signature of function-  sig <- sigD nm (mkRepFunSigT opt dt)--  -- Value of function-  let bodyExp = rtypeE opt ep (repSopE mods opt dt)-  let args = caseRep opt [] (map varP (tvars dt))-  fun <- funD nm [clause args (normalB bodyExp) []]--  return (nm, [sig, fun])-  --return (nm, [])---------------------------------------------------------------------------------- Exported Functions---------------------------------------------------------------------------------- | Make the instance for a representation type class-mkRepInst :: RepOpt -> RepFunNames -> Name -> DT -> Q [Dec]-mkRepInst opt funs g dt = do-  let body = varE (funName opt funs)-  let dec = valD (varP (repN opt)) (normalB body) []-  let gvar = varT g-  let ctx = mkRepInstCxt opt gvar dt-  let typ = mkRepInstT opt dt gvar-  inst <- instanceD ctx typ [dec]-  return [inst]--#endif-

@@ -1,692 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE TemplateHaskell        #-}---------------------------------------------------------------------------------- |--- Module      :  Generics.EMGM.Derive.Internal--- Copyright   :  (c) 2008, 2009 Universiteit Utrecht--- License     :  BSD3------ Maintainer  :  generics@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ Summary: Internal module with implementation of deriving code. Other EMGM--- modules should import this instead of the higher-level Derive modules.--------------------------------------------------------------------------------module Generics.EMGM.Derive.Internal (--  derive,-  deriveWith,-  Modifier(..),-  Modifiers,--  deriveMany,-  deriveManyWith,--  deriveMono,-  deriveMonoWith,--  declareConDescrs,-  declareConDescrsWith,--  declareEP,-  declareEPWith,--  declareRepValues,-  declareRepValuesWith,--  declareMonoRep,-  declareMonoRepWith,--  deriveRep,-  deriveRepWith,--  deriveFRep,-  deriveFRepWith,--  deriveBiFRep,-  deriveBiFRepWith,--  deriveCollect,-  deriveEverywhere,-  deriveEverywhere',--  module Generics.EMGM.Common,-  module Generics.EMGM.Functions.Collect,-  module Generics.EMGM.Functions.Everywhere,--) where---------------------------------------------------------------------------------- Imports--------------------------------------------------------------------------------import Prelude--import Language.Haskell.TH-import Data.Maybe (catMaybes)--import Generics.EMGM.Derive.Common-import Generics.EMGM.Derive.Functions---- We ignore these imports for Haddock, because Haddock does not like Template--- Haskell expressions in many places.------ See http://code.google.com/p/emgm/issues/detail?id=21----#ifndef __HADDOCK__-import Generics.EMGM.Derive.ConDescr (mkConDescr)-import Generics.EMGM.Derive.EP (mkEP)-import Generics.EMGM.Derive.Instance-#endif--import Generics.EMGM.Common--import Generics.EMGM.Functions.Collect-import Generics.EMGM.Functions.Everywhere---------------------------------------------------------------------------------- General functions--------------------------------------------------------------------------------#ifndef __HADDOCK__---- | Make the DT and constructor descriptions-declareConDescrsBase :: Modifiers -> Name -> Q (DT, [Dec])-declareConDescrsBase mods typeName = do-  info <- reify typeName-  case info of-    TyConI d ->-      case d of-        DataD    _ name vars cons _ -> mkDT name vars cons-        NewtypeD _ name vars con  _ -> mkDT name vars [con]-        _                             -> err-    _ -> err-  where-    mkDT name vars cons =-     do pairs <- mapM (normalizeCon mods) cons-        let (ncons', cdDecs) = unzip pairs-        return (DT name vars cons ncons', concat . catMaybes $ cdDecs)-    err = reportError $ showString "Unsupported name \""-                      . shows typeName-                      $ "\". Must be data or newtype."---- | Normalize constructor variants-normalizeCon :: Modifiers -> Con -> Q (NCon, Maybe [Dec])-normalizeCon mods c =-  case c of-    NormalC name args     -> mkNCon name (map snd args)-    RecC name args        -> mkNCon name (map $(sel 2 3) args)-    InfixC argL name argR -> mkNCon name [snd argL, snd argR]-    ForallC _ _ con       ->-      -- It appears that this ForallC may never be reached, because non-Haskell-98-      -- constructors can't be reified according to an error received when trying.-      do (NCon name _ _ _, _) <- normalizeCon mods con-         reportError $ showString "Existential data constructors such as \""-                     . showString (nameBase name)-                     $ "\" are not supported."-  where-    mkNCon name args =-      do let maybeCdMod = lookup (nameBase name) mods-         (cdName, cdDecs) <- mkConDescr maybeCdMod c-         let names = newVarNames args-         return (NCon name cdName args names, cdDecs)---- | For each element in a list, make a new variable name using the character--- 'v' (arbitrary) and a number.-newVarNames :: [a] -> [Name]-newVarNames = map newVarName . zipWith const [1..]-  where-    newVarName :: Int -> Name-    newVarName = mkName . (:) 'v' . show------------------------------------------------------------------------------------declareEPBase :: Modifiers -> DT -> Q (Name, [Dec])-declareEPBase mods dt = do-  fromName <- newName "from"-  toName <- newName "to"-  return (mkEP mods dt fromName toName)--declareRepFunsBase :: Modifiers -> DT -> Name -> Q (RepFunNames, [Dec])-declareRepFunsBase mods dt ep = do-  (repFunName,     repFunDecs)     <- mkRepFun mods OptRep      dt ep-  (frepFunName,    frepFunDecs)    <- mkRepFun mods OptFRep     dt ep-  (frep2FunName,   frep2FunDecs)   <- mkRepFun mods OptFRep2    dt ep-  (frep3FunName,   frep3FunDecs)   <- mkRepFun mods OptFRep3    dt ep-  (bifrep2FunName, bifrep2FunDecs) <- mkRepFun mods OptBiFRep2  dt ep-  return-    ( RepFunNames repFunName frepFunName frep2FunName frep3FunName bifrep2FunName-    , repFunDecs ++ frepFunDecs ++ frep2FunDecs ++ frep3FunDecs ++ bifrep2FunDecs-    )--deriveRepBase :: DT -> RepFunNames -> Name -> Q [Dec]-deriveRepBase dt funs g =-  mkRepInst OptRep funs g dt--deriveFRepBase :: DT -> RepFunNames -> Name -> Q [Dec]-deriveFRepBase dt funs g = do-  frepInstDec <- mkRepInst OptFRep funs g dt-  frep2InstDec <- mkRepInst OptFRep2 funs g dt-  frep3InstDec <- mkRepInst OptFRep3 funs g dt-  return (frepInstDec ++ frep2InstDec ++ frep3InstDec)--deriveBiFRepBase :: DT -> RepFunNames -> Name -> Q [Dec]-deriveBiFRepBase dt funs g =-  mkRepInst OptBiFRep2 funs g dt--#endif---------------------------------------------------------------------------------- Exported functions---------------------------------------------------------------------------------- | Same as 'derive' except that you can pass a list of name modifications to--- the deriving mechanism.------ Use @deriveWith@ if:------  (1) You want to use the generated constructor descriptions or---  embedding-projection pairs /and/ one of your constructors or types is an---  infix symbol. In other words, if you have a constructor @:*@, you cannot---  refer to the (invalid) generated name for its description, @con:*@. It---  appears that GHC has no problem with that name internally, so this is only---  if you want access to it.------  (2) You want to define your own constructor description. This allows you to---  give a precise implementation different from the one generated for you.------ For option 1, use 'ChangeTo' as in this example:------ @---   data U = Int :* Char---   $(deriveWith [(\":*\", ChangeTo \"Star\")] ''U)---   x = ... conStar ...--- @------ For option 2, use 'DefinedAs' as in this example:------ @---   data V = (:=) { i :: Int, j :: Char }---   $(deriveWith [(\":=\", DefinedAs \"Equals\")] ''V)---   conEquals = 'ConDescr' \":=\" 2 [] ('Infix' 4)--- @------ Using the example for option 2 with "Generics.EMGM.Functions.Show" will print--- values of @V@ as infix instead of the default record syntax.------ Note that only the first pair with its first field matching the type or--- constructor name in the 'Modifiers' list will be used. Any other matches will--- be ignored.-deriveWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--deriveWith mods typeName = do-  (dt, conDescrDecs) <- declareConDescrsBase mods typeName-  (epName, epDecs) <- declareEPBase mods dt-  (funNames, funDecs) <- declareRepFunsBase mods dt epName--  g <- newName "g"-  repInstDecs <- deriveRepBase dt funNames g--  higherOrderRepInstDecs <--    case length (tvars dt) of-      1 -> deriveFRepBase dt funNames g-      2 -> deriveBiFRepBase dt funNames g-      _ -> return []--  collectInstDec <- mkRepCollectInst dt-  everywhereInstDec <- mkRepEverywhereInst dt-  everywhereInstDec' <- mkRepEverywhereInst' dt--  return $-    conDescrDecs           ++-    epDecs                 ++-    funDecs                ++-    repInstDecs            ++-    higherOrderRepInstDecs ++-    [collectInstDec-    ,everywhereInstDec-    ,everywhereInstDec'-    ]--#else--deriveWith = undefined--#endif---- | Derive all appropriate instances for using EMGM with a datatype.------ Here is an example module that shows how to use @derive@:------ >   {-# LANGUAGE TemplateHaskell       #-}--- >   {-# LANGUAGE MultiParamTypeClasses #-}--- >   {-# LANGUAGE FlexibleContexts      #-}--- >   {-# LANGUAGE FlexibleInstances     #-}--- >   {-# LANGUAGE OverlappingInstances  #-}--- >   {-# LANGUAGE UndecidableInstances  #-}------ @---   module Example where---   import "Generics.EMGM.Derive"---   data T a = C a 'Int'--- @------ @---   $(derive ''T)--- @------ The Template Haskell @derive@ declaration in the above example generates the--- following (annotated) code:------ @---   -- (1) Constructor description declarations--- @------ @---   conC :: 'ConDescr'---   conC = 'ConDescr' \"C\" 2 [] 'Nonfix'--- @------ @---   -- (2) Embedding-projection pair declaration--- @------ @---   epT :: 'EP' (T a) (a :*: 'Int')---   epT = 'EP' fromT toT---     where fromT (C v1 v2) = v1 :*: v2---           toT (v1 :*: v2) = C v1 v2--- @------ @---   -- (3) Representation values--- @------ @---   repT :: ('Generic' g, 'Rep' g a, 'Rep' g 'Int') => g (T a)---   repT = 'rtype' epT ('rcon' conC ('rprod' 'rep' 'rep'))--- @------ @---   frepT :: ('Generic' g) => g a1 -> g (T a1)---   frepT a = 'rtype' epT ('rcon' conC ('rprod' a 'rint'))--- @------ @---   frep2T :: ('Generic2' g) => g a1 a2 -> g (T a1) (T a2)---   frep2T a = 'rtype2' epT epT ('rcon2' conC ('rprod2' a 'rint2'))--- @------ @---   frep3T :: ('Generic3' g) => g a1 a2 a3 -> g (T a1) (T a2) (T a3)---   frep3T a = 'rtype3' epT epT epT ('rcon3' conC ('rprod3' a 'rint3'))--- @------ @---   bifrep2T :: ('Generic2' g) => g a1 a2 -> g (T a1) (T a2)---   bifrep2T a = 'rtype2' epT epT ('rcon2' conC ('rprod2' a 'rint2'))--- @------ @---   -- (4) Representation instances--- @------ @---   instance ('Generic' g, 'Rep' g a, 'Rep' g 'Int') => 'Rep' g (T a) where---     'rep' = repT--- @------ @---   instance ('Generic' g) => 'FRep' g T where---     'frep' = frepT--- @------ @---   instance ('Generic2' g) => 'FRep2' g T where---     'frep2' = frep2T--- @------ @---   instance ('Generic3' g) => 'FRep3' g T where---     'frep3' = frep3T--- @------ @---   -- In this case, no instances for 'BiFRep2' is generated, because T is not---   -- a bifunctor type; however, the bifrep2T value is always generated in---   -- case T is used in a bifunctor type.--- @------ @---   -- (5) Generic function-specific instances--- @------ @---   instance 'Rep' ('Collect' (T a)) (T a) where---     'rep' = 'Collect' (\\x -> [x])--- @------ @---   instance ('Rep' ('Everywhere' (T a)) a, 'Rep' ('Everywhere' (T a)) 'Int')---            => 'Rep' ('Everywhere' (T a)) (T a) where---     'rep' = 'Everywhere' (\\f x ->---       case x of---         C v1 v2 -> f (C ('selEverywhere' 'rep' f v1) ('selEverywhere' 'rep' f v2))--- @------ @---   instance 'Rep' ('Everywhere'' (T a)) (T a) where---     'rep' = 'Everywhere'' (\\f x -> f x)--- @------ Note that all the values are top-level. This allows them to be shared between--- multiple instances. For example, if you have two mutually recursive functor--- datatypes, you may need to have each other's derived code in scope.--derive :: Name -> Q [Dec]-derive = deriveWith []-------------------------------------------------------------------------------------- | Same as 'deriveWith' for a list of type names. It may be necessary to use--- @deriveMany@ for a collection of mutually recursive datatypes.-deriveManyWith :: Modifiers -> [Name] -> Q [Dec]-deriveManyWith mods names = do-  decLists <- mapM (deriveWith mods) names-  return (concat decLists)---- | Same as 'derive' for a list of type names. It may be necessary to use--- @deriveMany@ for a collection of mutually recursive datatypes.-deriveMany :: [Name] -> Q [Dec]-deriveMany = deriveManyWith []-------------------------------------------------------------------------------------- | Same as 'declareConDescrs' except that you can pass a list of name--- modifications to the deriving mechanism. See 'deriveWith' for an example.-declareConDescrsWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--declareConDescrsWith mods typeName = do-  (_, conDescrDecs) <- declareConDescrsBase mods typeName-  return conDescrDecs--#else--declareConDescrsWith = undefined--#endif---- | Generate declarations of 'ConDescr' values for all constructors in a type.--- See 'derive' for an example.-declareConDescrs :: Name -> Q [Dec]-declareConDescrs = declareConDescrsWith []-------------------------------------------------------------------------------------- | Same as 'declareEP' except that you can pass a list of name modifications--- to the deriving mechanism. See 'deriveWith' for an example.-declareEPWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--declareEPWith mods typeName = do-  (dt, _) <- declareConDescrsBase mods typeName-  (_, epDecs) <- declareEPBase mods dt-  return epDecs--#else--declareEPWith = undefined--#endif---- | Generate declarations of 'EP' values for a type. See 'derive' for an--- example.-declareEP :: Name -> Q [Dec]-declareEP = declareEPWith []-------------------------------------------------------------------------------------- | Same as 'declareMonoRep' except that you can pass a list of name--- modifications to the deriving mechanism. See 'deriveWith' for an example.-declareMonoRepWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--declareMonoRepWith mods typeName = do-  (dt, _) <- declareConDescrsBase mods typeName-  (ep, _) <- declareEPBase mods dt-  (_, repFunDecs) <- mkRepFun mods OptRep dt ep-  return repFunDecs--#else--declareMonoRepWith = undefined--#endif---- | Generate the declaration of a monomorphic representation value for a type.--- This is the value used for 'rep' in an instance of 'Rep'. The difference with--- 'declareRepValues' is that 'declareRepValues' generates generates all--- representation values (including 'frep', 'frep2', etc.). See 'derive' for an--- example.-declareMonoRep :: Name -> Q [Dec]-declareMonoRep = declareMonoRepWith []-------------------------------------------------------------------------------------- | Same as 'declareRepValues' except that you can pass a list of name--- modifications to the deriving mechanism. See 'deriveWith' for an example.-declareRepValuesWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--declareRepValuesWith mods typeName = do-  (dt, _) <- declareConDescrsBase mods typeName-  (ep, _) <- declareEPBase mods dt-  (_, funDecs) <- declareRepFunsBase mods dt ep-  return funDecs--#else--declareRepValuesWith = undefined--#endif---- | Generate declarations of all representation values for a type. These--- functions are used in 'rep', 'frep', ..., 'bifrep2'.-declareRepValues :: Name -> Q [Dec]-declareRepValues = declareRepValuesWith []-------------------------------------------------------------------------------------- | Same as 'deriveRep' except that you can pass a list of name modifications--- to the deriving mechanism. See 'deriveWith' for an example.-deriveRepWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--deriveRepWith mods typeName = do-  (dt, _) <- declareConDescrsBase mods typeName-  (ep, _) <- declareEPBase mods dt-  (funNames, _) <- declareRepFunsBase mods dt ep-  g <- newName "g"-  repInstDecs <- deriveRepBase dt funNames g-  return repInstDecs--#else--deriveRepWith = undefined--#endif---- | Generate 'Rep' instance declarations for a type. See 'derive' for an--- example.-deriveRep :: Name -> Q [Dec]-deriveRep = deriveRepWith []-------------------------------------------------------------------------------------- | Same as 'deriveMono' except that you can pass a list of name--- modifications to the deriving mechanism. See 'deriveWith' for an example.-deriveMonoWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--deriveMonoWith mods typeName = do-  (dt, conDescrDecs) <- declareConDescrsBase mods typeName-  (epName, epDecs) <- declareEPBase mods dt-  (repFunName, repFunDecs) <- mkRepFun mods OptRep dt epName-  let funNames = RepFunNames repFunName undefined undefined undefined undefined--  g <- newName "g"-  repInstDecs <- deriveRepBase dt funNames g--  collectInstDec <- mkRepCollectInst dt--  return $-    conDescrDecs           ++-    epDecs                 ++-    repFunDecs             ++-    repInstDecs            ++-    [collectInstDec]--#else--deriveMonoWith = undefined--#endif---- | Same as 'derive' except that only the monomorphic 'Rep' representation--- value and instance are generated. This is a convenience function that can be--- used instead of the following declarations:------ @---   $(declareConDescrs ''T)---   $(declareEP ''T)---   $(declareMonoRep ''T)---   $(deriveRep ''T)---   $(deriveFRep ''T)---   $(deriveCollect ''T)--- @-deriveMono :: Name -> Q [Dec]-deriveMono = deriveMonoWith []--------------------------------------------------------------------------------------- | Same as 'deriveFRep' except that you can pass a list of name modifications--- to the deriving mechanism. See 'deriveWith' for an example.-deriveFRepWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--deriveFRepWith mods typeName = do-  (dt, _) <- declareConDescrsBase mods typeName-  (epName, _) <- declareEPBase mods dt-  (funNames, _) <- declareRepFunsBase mods dt epName-  g <- newName "g"-  frepInstDecs <- deriveFRepBase dt funNames g-  return frepInstDecs--#else--deriveFRepWith = undefined--#endif---- | Generate 'FRep', 'FRep2', and 'FRep3' instance declarations for a type. See--- 'derive' for an example.-deriveFRep :: Name -> Q [Dec]-deriveFRep = deriveFRepWith []-------------------------------------------------------------------------------------- | Same as 'deriveBiFRep' except that you can pass a list of name--- modifications to the deriving mechanism. See 'deriveWith' for an example.-deriveBiFRepWith :: Modifiers -> Name -> Q [Dec]--#ifndef __HADDOCK__--deriveBiFRepWith mods typeName = do-  (dt, _) <- declareConDescrsBase mods typeName-  (epName, _) <- declareEPBase mods dt-  (funNames, _) <- declareRepFunsBase mods dt epName-  g <- newName "g"-  bifrepInstDecs <- deriveBiFRepBase dt funNames g-  return bifrepInstDecs--#else--deriveBiFRepWith = undefined--#endif---- | Generate 'BiFRep2' instance declarations for a type. See 'derive' for an--- example.-deriveBiFRep :: Name -> Q [Dec]-deriveBiFRep = deriveBiFRepWith []-------------------------------------------------------------------------------------- | Generate a @'Rep' 'Collect' T@ instance declaration for a type @T@. See--- 'derive' for an example.-deriveCollect :: Name -> Q [Dec]--#ifndef __HADDOCK__--deriveCollect typeName = do-  (dt, _) <- declareConDescrsBase [] typeName-  collectInstDec <- mkRepCollectInst dt-  return [collectInstDec]--#else--deriveCollect = undefined--#endif-------------------------------------------------------------------------------------- | Generate a @'Rep' 'Everywhere' T@ instance declaration for a type @T@. See--- 'derive' for an example.-deriveEverywhere :: Name -> Q [Dec]--#ifndef __HADDOCK__--deriveEverywhere typeName = do-  (dt, _) <- declareConDescrsBase [] typeName-  everywhereInstDec <- mkRepEverywhereInst dt-  return [everywhereInstDec]--#else--deriveEverywhere = undefined--#endif---- | Generate a @'Rep' 'Everywhere'' T@ instance declaration for a type @T@. See--- 'derive' for an example.-deriveEverywhere' :: Name -> Q [Dec]--#ifndef __HADDOCK__--deriveEverywhere' typeName = do-  (dt, _) <- declareConDescrsBase [] typeName-  everywhereInstDec' <- mkRepEverywhereInst' dt-  return [everywhereInstDec']--#else--deriveEverywhere' = undefined--#endif--

@@ -1,38 +0,0 @@------------------------------------------------------------------------------
--- |
--- Module      :  Generics.EMGM.Functions
--- Copyright   :  (c) 2008, 2009 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.Everywhere,
-  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.Everywhere
-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

@@ -1,9 +1,3 @@-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE OverlappingInstances       #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.Collect@@ -14,25 +8,34 @@ -- Stability   :  experimental -- Portability :  non-portable ----- Summary: Generic function that collects all values of a specified type from a+-- Summary: Generic function that collects values of a specified type from a -- generic value. -- ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverlappingInstances       #-}+ module Generics.EMGM.Functions.Collect (   Collect(..),   collect, ) where -import Generics.EMGM.Common.Base-import Generics.EMGM.Common.Representation+import Control.Applicative (Alternative, empty, pure, (<|>)) +import Generics.EMGM.Base+ ----------------------------------------------------------------------------- -- Types -----------------------------------------------------------------------------  -- | The type of a generic function that takes a value of one type and returns a--- list of values of another type.+-- collection of values of another type. -- -- For datatypes to work with Collect, a special instance must be given. This -- instance is trivial to write. Given a type @T@, the 'Rep' instance looks like@@ -42,66 +45,65 @@ -- > -- >  data T = ... -- >--- >  instance Rep (Collect T) T where--- >    rep = Collect (:[])+-- >  instance (Alternative f) => Rep (Collect f T) T where+-- >    rep = Collect pure ----- (Note the requirement of overlapping instances.) This instance triggers when--- the result type (the first @T@) matches some value type (the second @T@)--- contained within the argument to 'collect'. See the source of this module for--- more examples.-newtype Collect b a = Collect { selCollect :: a -> [b] }+-- (Note that overlapping instances are required.) This instance triggers when+-- the result type (the @T@ in @Collect f T@) matches the value type (the second+-- @T@) contained within the argument to 'collect'. See the source of this+-- module for more examples. +newtype Collect f b a = Collect { selCollect :: a -> f b }+ ----------------------------------------------------------------------------- -- Generic instance declaration ----------------------------------------------------------------------------- -rconstantCollect :: a -> [b]-rconstantCollect _ = []--rsumCollect :: Collect c a -> Collect c b -> a :+: b -> [c]+rsumCollect :: Collect f c a -> Collect f c b -> a :+: b -> f 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+rprodCollect :: (Alternative f) => Collect f c a -> Collect f c b -> a :*: b -> f c+rprodCollect ra rb (a :*: b) = selCollect ra a <|> selCollect rb b -rtypeCollect :: EP b a -> Collect c a -> b -> [c]+rtypeCollect :: EP b a -> Collect f c a -> b -> f 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)+instance (Alternative f) => Generic (Collect f b) where+  rint           = Collect $ const empty+  rinteger       = Collect $ const empty+  rfloat         = Collect $ const empty+  rdouble        = Collect $ const empty+  rchar          = Collect $ const empty+  runit          = Collect $ const empty+  rsum     ra rb = Collect $ rsumCollect ra rb+  rprod    ra rb = Collect $ rprodCollect ra rb+  rtype ep ra    = Collect $ rtypeCollect ep ra  ----------------------------------------------------------------------------- -- Rep instance declarations ----------------------------------------------------------------------------- -instance Rep (Collect Int) Int where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f Int) Int where+  rep = Collect pure -instance Rep (Collect Integer) Integer where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f Integer) Integer where+  rep = Collect pure -instance Rep (Collect Float) Float where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f Float) Float where+  rep = Collect pure -instance Rep (Collect Double) Double where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f Double) Double where+  rep = Collect pure -instance Rep (Collect Char) Char where-  rep = Collect (:[])+instance (Alternative f) => Rep (Collect f Char) Char where+  rep = Collect pure  ----------------------------------------------------------------------------- -- Exported functions ----------------------------------------------------------------------------- --- | Collect values of type @b@ from some value of type @a@. An empty list means+-- | Collect values of type @b@ from some value of type @a@. An 'empty' 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.@@ -127,6 +129,6 @@ -- -- @collect@ only works if there is an instance for the return type as described -- in the @newtype 'Collect'@.-collect :: (Rep (Collect b) a) => a -> [b]+collect :: (Alternative f, Rep (Collect f b) a) => a -> f b collect = selCollect rep 

@@ -1,6 +1,3 @@-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE FlexibleContexts           #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.Compare@@ -27,6 +24,11 @@ -- most of the functionality is handled generically. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE FlexibleContexts           #-}+ module Generics.EMGM.Functions.Compare (    -- * Compare@@ -59,7 +61,7 @@ import Prelude hiding (compare, min, max) import qualified Prelude as P (compare) -import Generics.EMGM.Common+import Generics.EMGM.Base  ----------------------------------------------------------------------------- -- Types@@ -73,9 +75,6 @@ -- 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@@ -88,18 +87,19 @@     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)+  rint           = Compare $ P.compare+  rinteger       = Compare $ P.compare+  rfloat         = Compare $ P.compare+  rdouble        = Compare $ P.compare+  rchar          = Compare $ P.compare+  runit          = Compare $ P.compare+  rsum     ra rb = Compare $ rsumCompare ra rb+  rprod    ra rb = Compare $ rprodCompare ra rb+  rtype ep ra    = Compare $ rtypeCompare ep ra  ----------------------------------------------------------------------------- -- Exported functions

@@ -1,6 +1,3 @@-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE FlexibleContexts           #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.Crush@@ -34,6 +31,11 @@ -- 'flattenr' and 'firstr'. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE FlexibleContexts           #-}+ module Generics.EMGM.Functions.Crush (    -- * Crush functions@@ -76,8 +78,7 @@  import Prelude hiding (and, or, any, all, elem, notElem, sum, product, max, min, maximum, minimum) -import Generics.EMGM.Common.Base-import Generics.EMGM.Common.Representation+import Generics.EMGM.Base import Generics.EMGM.Functions.Compare  -----------------------------------------------------------------------------@@ -85,20 +86,19 @@ -----------------------------------------------------------------------------  -- | Associativity of the binary operator used for 'crush'+ data Assoc = AssocLeft  -- ^ Left-associative            | AssocRight -- ^ Right-associative  -- | The type of a generic function that takes an associativity and two -- arguments of different types and returns a value of the type of the second.+ 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@@ -107,18 +107,19 @@ 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)+  rint           = Crush $ \_ _ -> id+  rinteger       = Crush $ \_ _ -> id+  rfloat         = Crush $ \_ _ -> id+  rdouble        = Crush $ \_ _ -> id+  rchar          = Crush $ \_ _ -> id+  runit          = Crush $ \_ _ -> id+  rsum     ra rb = Crush $ rsumCrush ra rb+  rprod    ra rb = Crush $ rprodCrush ra rb+  rtype ep ra    = Crush $ rtypeCrush ep ra  ----------------------------------------------------------------------------- -- Exported functions@@ -129,6 +130,7 @@ -- -- 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).@@ -141,10 +143,12 @@   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 @@ -152,66 +156,77 @@ -- -- 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@.+-- | Extract the first element of a container. 'fail' if the container is empty. ----- 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+-- This is the most general form in which you must specify the associativity and+-- the 'Monad' instance. You may prefer to use the more convenient 'firstr' or+-- 'firstl'.++first :: (Monad m, FRep (Crush [a]) f) => Assoc -> f a -> m a first asc as = case flatten asc as of-                 []  -> Nothing-                 a:_ -> Just a+                 []  -> fail "first: argument is empty"+                 a:_ -> return a --- | A right-associative variant of 'first'.+-- | A right-associative 'Maybe' 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'.+-- | A left-associative 'Maybe' 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 :: (Rep Compare a, FRep (Crush Bool) f) => a -> f a -> Bool elem x = any (eq 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 :: (Rep Compare a, FRep (Crush Bool) f) => a -> f a -> Bool notElem x = all (neq 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 :: (Rep Compare a, FRep (Crush (Maybe a)) f) => f a -> Maybe a maximum = crushr f Nothing   where f x Nothing  = Just x@@ -220,6 +235,7 @@ -- | 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 :: (Rep Compare a, FRep (Crush (Maybe a)) f) => f a -> Maybe a minimum = crushr f Nothing   where f x Nothing  = Just x@@ -227,21 +243,25 @@  -- | 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 

@@ -1,6 +1,3 @@-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE FlexibleContexts           #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.Enum@@ -28,6 +25,11 @@ -- these may overflow, because they are unbounded. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE FlexibleContexts           #-}+ module Generics.EMGM.Functions.Enum (   Enum(..),   enum,@@ -39,7 +41,7 @@ import qualified Prelude as P (Enum) import Data.List (genericTake) -import Generics.EMGM.Common+import Generics.EMGM.Base  ----------------------------------------------------------------------------- -- Types@@ -116,16 +118,15 @@ 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)+  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

@@ -1,10 +1,3 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE OverlappingInstances       #-}- -------------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.Everywhere@@ -31,7 +24,7 @@ -- -- @ --   -- SYB---   everywhere :: (forall a. 'Data' a => a -> a) -> forall a. 'Data' a => a -> a+--   everywhere :: (forall a. Data a => a -> a) -> forall a. Data a => a -> a -- @ -- -- @@@ -40,6 +33,14 @@ -- @ -------------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverlappingInstances       #-}+ module Generics.EMGM.Functions.Everywhere (   Everywhere(..),   everywhere,@@ -47,12 +48,7 @@   everywhere', ) where -import Generics.EMGM.Common.Base-import Generics.EMGM.Common.Representation--#ifdef __HADDOCK__-import Data.Generics (Data)-#endif+import Generics.EMGM.Base  -------------------------------------------------------------------------------- -- Types@@ -93,9 +89,6 @@ -- Generic instance declaration -------------------------------------------------------------------------------- -rconstantEverywhere :: (a -> a) -> b -> b-rconstantEverywhere _ = id- rsumEverywhere :: Everywhere a b1 -> Everywhere a b2 -> (a -> a) -> (b1 :+: b2) -> b1 :+: b2 rsumEverywhere ra _  f (L a) = L (selEverywhere ra f a) rsumEverywhere _  rb f (R b) = R (selEverywhere rb f b)@@ -107,10 +100,15 @@ rtypeEverywhere ep ra f = to ep . selEverywhere ra f . from ep  instance Generic (Everywhere a) where-  rconstant      = Everywhere rconstantEverywhere-  rsum     ra rb = Everywhere (rsumEverywhere ra rb)-  rprod    ra rb = Everywhere (rprodEverywhere ra rb)-  rtype ep ra    = Everywhere (rtypeEverywhere ep ra)+  rint           = Everywhere $ const id+  rinteger       = Everywhere $ const id+  rfloat         = Everywhere $ const id+  rdouble        = Everywhere $ const id+  rchar          = Everywhere $ const id+  runit          = Everywhere $ const id+  rsum     ra rb = Everywhere $ rsumEverywhere ra rb+  rprod    ra rb = Everywhere $ rprodEverywhere ra rb+  rtype ep ra    = Everywhere $ rtypeEverywhere ep ra  -------------------------------------------------------------------------------- -- Rep instance declarations@@ -201,9 +199,6 @@ -- Generic instance declaration -------------------------------------------------------------------------------- -rconstantEverywhere' :: (a -> a) -> b -> b-rconstantEverywhere' _ = id- rsumEverywhere' :: Everywhere' a b1 -> Everywhere' a b2 -> (a -> a) -> (b1 :+: b2) -> b1 :+: b2 rsumEverywhere' ra _  f (L a) = L (selEverywhere' ra f a) rsumEverywhere' _  rb f (R b) = R (selEverywhere' rb f b)@@ -215,10 +210,15 @@ rtypeEverywhere' ep ra f = to ep . selEverywhere' ra f . from ep  instance Generic (Everywhere' a) where-  rconstant      = Everywhere' rconstantEverywhere'-  rsum     ra rb = Everywhere' (rsumEverywhere' ra rb)-  rprod    ra rb = Everywhere' (rprodEverywhere' ra rb)-  rtype ep ra    = Everywhere' (rtypeEverywhere' ep ra)+  rint           = Everywhere' $ const id+  rinteger       = Everywhere' $ const id+  rfloat         = Everywhere' $ const id+  rdouble        = Everywhere' $ const id+  rchar          = Everywhere' $ const id+  runit          = Everywhere' $ const id+  rsum     ra rb = Everywhere' $ rsumEverywhere' ra rb+  rprod    ra rb = Everywhere' $ rprodEverywhere' ra rb+  rtype ep ra    = Everywhere' $ rtypeEverywhere' ep ra  -------------------------------------------------------------------------------- -- Rep instance declarations

@@ -1,6 +1,3 @@-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE FlexibleContexts           #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.Map@@ -22,6 +19,11 @@ -- type into a value of another using instances provided by the programmer. ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE FlexibleContexts           #-}+ module Generics.EMGM.Functions.Map (   Map(..),   map,@@ -32,7 +34,7 @@  import Prelude hiding (map) -import Generics.EMGM.Common+import Generics.EMGM.Base  ----------------------------------------------------------------------------- -- Types@@ -46,9 +48,6 @@ -- 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)@@ -60,21 +59,29 @@ 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)+  rint2                = Map $ id+  rinteger2            = Map $ id+  rfloat2              = Map $ id+  rdouble2             = Map $ id+  rchar2               = Map $ id+  runit2               = Map $ id+  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@. This is a convenience function for--- the implementation @'map' ('const' b) as@.+-- | Replace all @a@-values in @f a@ with @b@. Defined as:+-- @+--   replace as b = map (const b) as+-- @ replace :: (FRep2 Map f) => f a -> b -> f b replace as b = map (const b) as @@ -115,7 +122,7 @@ -- @ -- -- There are no pre-defined instances, and a call to @cast@ will not compile if--- no instances for the input and output type pair is found, so you must define+-- no instances for the input and output type pair are found, so you must define -- instances in order to use @cast@. cast :: (Rep (Map a) b) => a -> b cast = selMap rep

@@ -0,0 +1,147 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Generics.EMGM.Functions.Meta+-- Copyright   :  (c) 2008 - 2010 Universiteit Utrecht+-- License     :  BSD3+--+-- Maintainer  :  generics@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Summary: Functions for extracting meta-information about the representation.+--------------------------------------------------------------------------------++{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE FunctionalDependencies     #-}++module Generics.EMGM.Functions.Meta (++  -- * Embedding-Projection Pair+  HasEP(..),++  -- * Constructor Description+  Con(..),+  conDescr,++  -- * Label Descriptions+  Lbls(..),+  lblDescrs++) where++import Generics.EMGM.Base++--------------------------------------------------------------------------------+-- HasEP class+--------------------------------------------------------------------------------++-- | A class to reveal the embedding-projection pair for a given datatype and+-- its isomorphic representation type.++class HasEP a b | a -> b where+  -- | The parameter is never evaluated, so @undefined@ is acceptable.+  epOf :: a -> EP a b++--------------------------------------------------------------------------------+-- Type+--------------------------------------------------------------------------------++-- | The type of a generic function that takes one value and returns an optional+-- constructor description.++newtype Con a = Con { selConstructor :: a -> Maybe ConDescr }++--------------------------------------------------------------------------------+-- Generic instance declaration+--------------------------------------------------------------------------------++rsumConstructor :: Con a -> Con b -> a :+: b -> Maybe ConDescr+rsumConstructor ra _  (L a) = selConstructor ra a+rsumConstructor _  rb (R b) = selConstructor rb b++instance Generic Con where+  rint            = Con $ const Nothing+  rinteger        = Con $ const Nothing+  rfloat          = Con $ const Nothing+  rdouble         = Con $ const Nothing+  rchar           = Con $ const Nothing+  runit           = Con $ const Nothing+  rsum      ra rb = Con $ rsumConstructor ra rb+  rprod     _  _  = Con $ const Nothing+  rcon   cd _     = Con $ const $ Just cd+  rlbl   _  _     = Con $ const Nothing+  rtype  ep ra    = Con $ selConstructor ra . from ep++--------------------------------------------------------------------------------+-- Exported function+--------------------------------------------------------------------------------++-- | Returns a constructor description if the value is not a primitive. The+-- argument is not evaluated and may be @undefined@.++conDescr :: (Rep Con a) => a -> Maybe ConDescr+conDescr = selConstructor rep++--------------------------------------------------------------------------------+-- Type+--------------------------------------------------------------------------------++-- | The type of a generic function that takes a boolean to limit recursion and+-- a value and returns a list of label descriptions for that constructor.++newtype Lbls a = Lbls { selLabels :: Bool -> a -> [LblDescr] }++--------------------------------------------------------------------------------+-- Generic instance declaration+--------------------------------------------------------------------------------++rsumLabels :: Lbls a -> Lbls b -> Bool -> a :+: b -> [LblDescr]+rsumLabels ra _  down (L a) = selLabels ra down a+rsumLabels _  rb down (R b) = selLabels rb down b++rprodLabels :: Lbls a -> Lbls b -> Bool -> a :*: b -> [LblDescr]+rprodLabels ra rb down (a :*: b) = selLabels ra down a ++ selLabels rb down b++check :: (a -> [b]) -> Bool -> a -> [b]+check act down val = if down then act val else []++rconLabels :: ConDescr -> Lbls a -> Bool -> a -> [LblDescr]+rconLabels _ ra = check $ selLabels ra False++rtypeLabels :: EP b a -> Lbls a -> Bool -> b -> [LblDescr]+rtypeLabels ep ra = check $ selLabels ra True . from ep++none :: a -> b -> [c]+none _ _ = []++one :: c -> a -> b -> [c]+one c _ _ = [c]++instance Generic Lbls where+  rint            = Lbls $ none+  rinteger        = Lbls $ none+  rfloat          = Lbls $ none+  rdouble         = Lbls $ none+  rchar           = Lbls $ none+  runit           = Lbls $ none+  rsum      ra rb = Lbls $ rsumLabels ra rb+  rprod     ra rb = Lbls $ rprodLabels ra rb+  rcon   cd ra    = Lbls $ rconLabels cd ra+  rlbl   ld _     = Lbls $ one ld+  rtype  ep ra    = Lbls $ rtypeLabels ep ra++--------------------------------------------------------------------------------+-- Exported function+--------------------------------------------------------------------------------++-- | Returns a list of descriptions for all labels in the head constructor. Does+-- not recurse into the children. The argument is not evaluated and may be+-- @undefined@.++lblDescrs :: (Rep Lbls a) => a -> [LblDescr]+lblDescrs = selLabels rep True+

@@ -1,10 +1,3 @@-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE TypeSynonymInstances  #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverlappingInstances  #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.Read@@ -34,6 +27,15 @@ -- See also "Generics.EMGM.Functions.Show". ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances  #-}+ module Generics.EMGM.Functions.Read (   Read(..),   readPrec,@@ -44,13 +46,10 @@ ) 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)+                                        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)@@ -59,7 +58,7 @@  import qualified GHC.Read as GHC (list) -import Generics.EMGM.Common+import Generics.EMGM.Base  ----------------------------------------------------------------------------- -- Types@@ -67,21 +66,13 @@  -- | The type of a generic function that takes a constructor-type argument and -- returns a parser combinator for some type.+ 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 ()@@ -127,173 +118,102 @@  -- | @(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"+braces p = do Punc "{" <- lexP               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+        then return ()+        else pfail  ----------------------------------------------------------------------------- -- 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)+  (fmap L $ selRead ra UnknownC) +++ (fmap R $ selRead rb UnknownC)  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)+    NormalC ->+      do a <- step (selRead ra NormalC)+         b <- step (selRead rb NormalC)          return (a :*: b)      -- Standard infix constructor-    ConIfx symbol ->-      do ltraceme "ConIfx (a)"-         a <- step (selRead ra ConStd)+    InfixC symbol ->+      do a <- step (selRead ra NormalC)          lexT symbol-         ltraceme "ConIfx (b)"-         b <- step (selRead rb ConStd)+         b <- step (selRead rb NormalC)          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))+    RecordC ->+      do a <- step $ selRead ra RecordC+         comma+         b <- step $ selRead rb RecordC          return (a :*: b)      -- No other patterns expected     _ ->-      do ltraceme "FAIL"-         pfail--  where-    ltraceme s = ltrace $ "rprodRead: " ++ show ct ++ " " ++ s+      pfail  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+      -- Normal prefix+      ConDescr name _ False Prefix ->+        do lexT name+           step $ selRead ra NormalC -      -- Standard infix constructor-      ConDescr name _ [] fixity ->-        do ltraceme "ConIfx"-           let p = prec fixity-           RP.prec p $ step $ selRead ra $ ConIfx name+      -- Infix without record syntax+      ConDescr name _ False fixity ->+        do let p = prec fixity+           RP.prec p $ step $ selRead ra $ InfixC name -      -- Record-style nonfix constructor-      ConDescr name _ labels Nonfix ->-        do ltraceme "ConRec (a)"-           lexT name-           braces $ step $ selRead ra $ ConRec labels+      -- Record-style prefix+      ConDescr name _ True Prefix ->+        do lexT name+           braces $ step $ selRead ra RecordC -      -- Record-style infix constructor-      ConDescr name _ labels _ ->-        do ltraceme "ConRec (b)"-           paren (lexT name)-           braces $ step $ selRead ra $ ConRec labels+      -- Record-style infix: We don't actually use the fixity info here. We just+      -- need to wrap the symbol name in parens.+      ConDescr name _ True _ ->+        do paren (lexT name)+           braces $ step $ selRead ra RecordC -  where ltraceme s = ltrace $ "rconRead: " ++ show cd ++ " " ++ s+rlblRead :: LblDescr -> Read a -> ConType -> ReadPrec a+rlblRead (LblDescr label) ra _ =+  do lexT label+     equals+     selRead ra UnknownC  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+rtypeRead ep ra = fmap (to ep) . selRead ra  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)+  rint            = Read $ const TR.readPrec+  rinteger        = Read $ const TR.readPrec+  rfloat          = Read $ const TR.readPrec+  rdouble         = Read $ const TR.readPrec+  rchar           = Read $ const TR.readPrec+  runit           = Read $ const $ return Unit+  rsum      ra rb = Read $ rsumRead ra rb+  rprod     ra rb = Read $ rprodRead ra rb+  rcon  cd  ra    = Read $ rconRead cd ra+  rlbl  ld  ra    = Read $ rlblRead ld ra+  rtype ep  ra    = Read $ rtypeRead ep ra  ----------------------------------------------------------------------------- -- Rep instance declarations@@ -366,7 +286,7 @@ -- "Text.ParserCombinators.ReadPrec" and should be similar to a derived -- implementation of 'Text.Read.readPrec'. readPrec :: (Rep Read a) => ReadPrec a-readPrec = selRead rep ConStd+readPrec = selRead rep UnknownC  -- | Attempt to parse a value from the front of the string using the given -- precedence. 'readsPrec' returns a list of (parsed value, remaining string)

@@ -1,10 +1,3 @@-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE TypeSynonymInstances  #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverlappingInstances  #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.Show@@ -33,6 +26,15 @@ -- See also "Generics.EMGM.Functions.Read". ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances  #-}+ module Generics.EMGM.Functions.Show (   Show(..),   showsPrec,@@ -45,7 +47,7 @@  import qualified GHC.Show as GHC (showList__) -import Generics.EMGM.Common+import Generics.EMGM.Base  ----------------------------------------------------------------------------- -- Types@@ -55,15 +57,15 @@  -- | The type of a generic function that takes a constructor-type argument, a -- number (precedence), and a value and returns a 'ShowS' function.+ newtype Show a = Show { selShow :: ConType -> Int -> a -> ShowS }--- NOTE: Use full type here instead of 'ShowsPrec' for Haddock.  ----------------------------------------------------------------------------- -- Utility functions ----------------------------------------------------------------------------- -showSpace :: ShowS-showSpace = showChar ' '+showSpace :: Bool -> ShowS+showSpace c = if c then showChar ' ' else id  showBraces :: ShowsPrec a -> ShowsPrec a showBraces showsPrec' p x =@@ -75,58 +77,38 @@ 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-    other ->-      error $ "rconstantShow: Unexpected constructor: '" ++ P.show other ++ "'"- 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+rsumShow ra _  _ p (L a) = selShow ra UnknownC p a+rsumShow _  rb _ p (R b) = selShow rb UnknownC 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+    -- Normal prefix+    NormalC ->+      selShowStep ra NormalC p a .+      showSpace True .+      selShowStep rb NormalC p b -    -- Standard infix constructor-    ConIfx symbol ->-      selShowStep ra ConStd p a .-      showSpace .+    -- Infix without record syntax+    InfixC symbol ->+      selShowStep ra NormalC p a .+      showSpace True .       showString symbol .-      showSpace .-      selShowStep rb ConStd p b+      showSpace True .+      selShowStep rb NormalC p b -    -- Record-style constructor-    ConRec (label:labels) ->+    -- Record-style+    RecordC ->       let p' = p + 1 in-      recEntry True label (selShowStep ra ConStd) p' a .-      selShowStep rb (ConRec (labels)) p' b+      selShowStep ra RecordC p' a .+      showString ", " .+      selShowStep rb RecordC p' b      -- No other patterns expected     other ->@@ -138,64 +120,65 @@ rconShow cd ra _ p a =   case cd of -    -- Standard nonfix constructor-    ConDescr name arity [] Nonfix ->+    -- Normal prefix+    ConDescr name arity False Prefix ->       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+      showSpace hasArgs .+      step NormalC appPrec a -    -- Standard infix constructor-    ConDescr name _ [] fixity ->+    -- Infix without record syntax+    ConDescr name _ False fixity ->       let conPrec = prec fixity in       showParen (p > conPrec) $-      showConStep (ConIfx name) conPrec a+      step (InfixC 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.+    -- Record-style prefix+    ConDescr name _ True Prefix ->++      -- NOTE: Technically, we can use 'recPrec' instead of 'appRec' here. The+      -- precedence for record construction is higher than function application.+      -- However, since GHC puts parens for application, we'll put them, too.+      -- That way, we can test the output with a derived Show instance.+       showParen (p > appPrec) $       showString name .-      showSpace .-      showBraces (selShow ra (ConRec labels)) minPrec a+      showSpace True .+      showBraces (selShow ra RecordC) minPrec a -    -- Record-style infix constructor-    ConDescr name _ labels _ ->+    -- Record-style infix: We don't actually use the fixity info here. We just+    -- need to wrap the symbol name in parens.+    ConDescr name _ True _ ->       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+      showSpace True .+      showBraces (step RecordC) p a -    -- Record-style constructor-    ConRec (label:[]) ->-      recEntry False label (selShowFrom ConStd)+  where+    step ct = selShow ra ct . (+1) -    -- No other patterns expected-    other ->-      error $ "rtypeShow: Unexpected constructor: '" ++ P.show other ++ "'"+rlblShow :: LblDescr -> Show a -> ConType -> ShowsPrec a+rlblShow (LblDescr label) ra _ _ a =+  showString label .+  showString " = " .+  selShow ra UnknownC minPrec a  -- Reset precedence in the field -  where selShowFrom ct' p = selShow ra ct' p . from ep+rtypeShow :: EP b a -> Show a -> ConType -> ShowsPrec b+rtypeShow ep ra 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)+  rint            = Show $ const P.showsPrec+  rinteger        = Show $ const P.showsPrec+  rfloat          = Show $ const P.showsPrec+  rdouble         = Show $ const P.showsPrec+  rchar           = Show $ const P.showsPrec+  runit           = Show $ \_ _ _ -> id+  rsum      ra rb = Show $ rsumShow ra rb+  rprod     ra rb = Show $ rprodShow ra rb+  rcon   cd ra    = Show $ rconShow cd ra+  rlbl   ld ra    = Show $ rlblShow ld ra+  rtype  ep ra    = Show $ rtypeShow ep ra  ----------------------------------------------------------------------------- -- Rep instance declarations@@ -203,7 +186,7 @@  -- | Ad-hoc instance for lists instance (Rep Show a) => Rep Show [a] where-  rep = Show $ const $ const $ GHC.showList__ $ selShow rep ConStd minPrec+  rep = Show $ const $ const $ GHC.showList__ $ selShow rep UnknownC minPrec  -- | Ad-hoc instance for strings instance Rep Show String where@@ -271,7 +254,7 @@   => 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+showsPrec = selShow rep UnknownC  -- | A variant of 'showsPrec' with the minimum precedence (0). shows :: (Rep Show a) => a -> ShowS

@@ -0,0 +1,136 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Generics.EMGM.Functions.Transpose+-- Copyright   :  (c) 2008 - 2010 Universiteit Utrecht+-- License     :  BSD3+--+-- Maintainer  :  generics@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Summary: Generic function thats transposes a value @f (g a)@ to @g (f a)@.+--+-- This is an interesting generic function since it uses multiple other generic+-- functions: 'Crush', 'Enum', 'Map', and 'ZipWith'. Notably, 'Map' and+-- 'ZipWith' are required for definining the sum and product cases of the+-- generic function. The others make the generic function easy to use.+--+-- NOTE: Be aware of the special case for empty values noted in the+-- documentation of 'tranpose'.+--------------------------------------------------------------------------------++{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE FlexibleContexts      #-}++module Generics.EMGM.Functions.Transpose (+  Transpose(..),+  transpose,+  transposeE,+) where++import Prelude hiding (map, Enum)+import Control.Monad (liftM)+import Data.Maybe (fromMaybe)++import Generics.EMGM.Base+import Generics.EMGM.Functions.Crush+import Generics.EMGM.Functions.Enum+import Generics.EMGM.Functions.Map+import Generics.EMGM.Functions.ZipWith++--------------------------------------------------------------------------------+-- Types+--------------------------------------------------------------------------------++-- | The type of a generic function that takes a generic value and non-generic+-- container and returns the container filled with other generic values.++newtype (Monad m) => Transpose m f c b a =+  Transpose { selTranspose :: a -> f c -> m (f b) }++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++lift :: (Monad m) => (a -> b -> c) -> a -> b -> m c+lift f x y = return $ f x y++replaceM :: (Monad m, FRep2 Map f) => a -> f b -> m (f a)+replaceM = lift (flip replace)++--------------------------------------------------------------------------------+-- Generic instance declaration+--------------------------------------------------------------------------------++rsumTranspose+  :: (Monad m, FRep2 Map f)+  => Transpose m f c a2 a1+  -> Transpose m f c b2 b1+  -> (a1 :+: b1)+  -> f c+  -> m (f (a2 :+: b2))+rsumTranspose ra _  (L a) = liftM (map L) . selTranspose ra a+rsumTranspose _  rb (R b) = liftM (map R) . selTranspose rb b++rprodTranspose+  :: (Monad m, FRep3 (ZipWith m) f)+  => Transpose m f c a2 a1+  -> Transpose m f c b2 b1+  -> (a1 :*: b1)+  -> f c+  -> m (f (a2 :*: b2))+rprodTranspose ra rb (a :*: b) x = do+  a' <- selTranspose ra a x+  b' <- selTranspose rb b x+  zipWithM (lift (:*:)) a' b'++rtypeTranspose+  :: (Monad m, FRep2 Map f)+  => EP b2 a2 -> EP b1 a1+  -> Transpose m f c a2 a1+  -> b1+  -> f c+  -> m (f b2)+rtypeTranspose ep1 ep2 ra b x = do+  v <- selTranspose ra (from ep2 b) x+  return (map (to ep1) v)++instance (Monad m, FRep2 Map f, FRep3 (ZipWith m) f)+         => Generic2 (Transpose m f c) where+  rint2                = Transpose $ replaceM+  rinteger2            = Transpose $ replaceM+  rfloat2              = Transpose $ replaceM+  rdouble2             = Transpose $ replaceM+  rchar2               = Transpose $ replaceM+  runit2               = Transpose $ replaceM+  rsum2          ra rb = Transpose $ rsumTranspose ra rb+  rprod2         ra rb = Transpose $ rprodTranspose ra rb+  rtype2 ep1 ep2 ra    = Transpose $ rtypeTranspose ep1 ep2 ra++--------------------------------------------------------------------------------+-- Exported functions+--------------------------------------------------------------------------------++-- | Transposes the structure of nested containers (types @f@ and @g@). 'fail'+-- if the outermost container is empty, because there is no generic way to+-- guarantee that both have unit constructors or, if they do, decide which one+-- to choose. See 'transposeE' for an alternative approach.++transpose+  :: (Monad m, FRep (Crush [g a]) f, FRep2 (Transpose m g a) f)+  => f (g a)+  -> m (g (f a))+transpose xs =+  first AssocRight xs >>= selTranspose (frep2 (Transpose (const . return))) xs++-- | A convenient version of 'transpose' that returns the 'empty' value on+-- failure.++transposeE+  :: (Rep Enum (g (f a)), FRep (Crush [g a]) f, FRep2 (Transpose Maybe g a) f)+  => f (g a)+  -> g (f a)+transposeE = fromMaybe empty . transpose+

@@ -1,6 +1,3 @@-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE FlexibleContexts           #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Generics.EMGM.Functions.UnzipWith@@ -12,26 +9,32 @@ -- 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+-- element in a value, splitting the element into two. The result is a pair of -- 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.+-- 'UnzipWith' can be seen as the dual of 'ZipWith', though it has no direct+-- @Prelude@ counterpart. Only 'unzip' has a @Prelude@ analog. -- -- See also "Generics.EMGM.Functions.ZipWith". ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE FlexibleContexts           #-}+ module Generics.EMGM.Functions.UnzipWith (   UnzipWith(..),+  unzipWithM,   unzipWith,   unzip, ) where  import Prelude hiding (unzip) -import Generics.EMGM.Common+import Generics.EMGM.Base  ----------------------------------------------------------------------------- -- Types@@ -39,74 +42,98 @@  -- | The type of a generic function that takes an argument of one type and -- returns a pair of values with two different types.-newtype UnzipWith a b c = UnzipWith { selUnzipWith :: a -> (b, c) }+newtype UnzipWith m a b c = UnzipWith { selUnzipWith :: a -> m (b, c) }  ----------------------------------------------------------------------------- -- Generic3 instance declaration ----------------------------------------------------------------------------- -rconstantUnzipWith :: a -> (a, a)-rconstantUnzipWith x = (x, x)--runitUnzipWith :: Unit -> (Unit, Unit)-runitUnzipWith _ = (Unit, Unit)+pair :: (Monad m) => a -> m (a, a)+pair x = return (x, x) -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)+rsumUnzipWith+  :: (Monad m)+  => UnzipWith m a1 a2 a3+  -> UnzipWith m b1 b2 b3+  -> (a1 :+: b1)+  -> m (a2 :+: b2, a3 :+: b3)+rsumUnzipWith ra _  (L a) = selUnzipWith ra a >>= \(x, y) -> return (L x, L y)+rsumUnzipWith _  rb (R b) = selUnzipWith rb b >>= \(x, y) -> return (R x, R y) -rprodUnzipWith ::-     UnzipWith a1 a2 a3-  -> UnzipWith b1 b2 b3+rprodUnzipWith+  :: (Monad m)+  => UnzipWith m a1 a2 a3+  -> UnzipWith m 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)+  -> m (a2 :*: b2, a3 :*: b3)+rprodUnzipWith ra rb (a1 :*: b1) = do+  (a2, a3) <- selUnzipWith ra a1+  (b2, b3) <- selUnzipWith rb b1+  return (a2 :*: b2, a3 :*: b3) -rtypeUnzipWith ::-     EP b1 a1+rtypeUnzipWith+  :: (Monad m)+  => EP b1 a1   -> EP b2 a2   -> EP b3 a3-  -> UnzipWith a1 a2 a3+  -> UnzipWith m 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)+  -> m (b2, b3)+rtypeUnzipWith ep1 ep2 ep3 ra b1 = do+  (a2, a3) <- selUnzipWith ra (from ep1 b1) +  return (to ep2 a2, to ep3 a3) -rconUnzipWith :: ConDescr -> UnzipWith a1 a2 a3 -> a1 -> (a2, a3)-rconUnzipWith _ = selUnzipWith+instance (Monad m) => Generic3 (UnzipWith m) where+  rint3                    = UnzipWith $ pair+  rinteger3                = UnzipWith $ pair+  rfloat3                  = UnzipWith $ pair+  rdouble3                 = UnzipWith $ pair+  rchar3                   = UnzipWith $ pair+  runit3                   = UnzipWith $ pair+  rsum3              ra rb = UnzipWith $ rsumUnzipWith ra rb+  rprod3             ra rb = UnzipWith $ rprodUnzipWith ra rb+  rtype3 ep1 ep2 ep3 ra    = UnzipWith $ rtypeUnzipWith ep1 ep2 ep3 ra -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)+-----------------------------------------------------------------------------+-- Identity Monad+----------------------------------------------------------------------------- +-- We introduce our own identity monad, so we don't have to import+-- Control.Monad.Identity and thus depend on the mtl package.++-- Since the use of 'Id' is completely obscured from the user except as a type+-- in the constraints of 'unzipWith' and 'unzip', we do not export it.++newtype Id a = Id { runId :: a }++instance Monad Id where+  return a = Id a+  m >>= k  = k (runId m)+ ----------------------------------------------------------------------------- -- Exported functions -----------------------------------------------------------------------------  -- | Splits a container into two structurally equivalent containers by applying -- a function to every element, which splits it into two corresponding elements.-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))+-- Fails if the spliting function fails --- | 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)+unzipWithM+  :: (Monad m, FRep3 (UnzipWith m) f)+  => (a -> m (b, c))  -- ^ Splitting function.+  -> f a              -- ^ Container of @a@-values.+  -> m (f b, f c)     -- ^ Pair of containers.+unzipWithM f = selUnzipWith (frep3 (UnzipWith f))++-- | A specialized version of 'unzipWithM' using the identity monad and a+-- splitting function that does not fail.++unzipWith :: (FRep3 (UnzipWith Id) f) => (a -> (b, c)) -> f a -> (f b, f c)+unzipWith f = runId . unzipWithM (\x -> Id (f x))++-- | A specialized version of 'unzipWith' for pairs. Generic version of+-- @Prelude.unzip@.++unzip :: (FRep3 (UnzipWith Id) f) => f (b, c) -> (f b, f c) unzip = unzipWith id