DrIFT-cabalized (empty) → 2.2.3.1

raw patch · 22 files changed

+3052/−0 lines, 22 filesdep +basedep +haskell98dep +processsetup-changed

Dependencies added: base, haskell98, process

Files

• AUTHORS +18/−0
• ChangeLog +143/−0
• DrIFT-cabalized.cabal +45/−0
• LICENSE +21/−0
• README +66/−0
• README.old +59/−0
• Setup.hs +6/−0
• code/FunctorM.hs +20/−0
• code/GhcBinary.hs +712/−0
• code/README.txt +3/−0
• docs/drift.info +841/−0
• docs/drift.texi +824/−0
• drift-ghc.hs +29/−0
• example/Artifical.hs +11/−0
• example/BTree.hs +4/−0
• example/Example.hs +42/−0
• example/Foo.lhs +6/−0
• example/README +8/−0
• example/TestTerm.hs +8/−0
• example/TestTerm.out.correct +23/−0
• example/Xref.hs +6/−0
• src/DrIFT.hs +157/−0

@@ -0,0 +1,18 @@+DrIFT was originally created by++	* Noel Winstanley++An updated implementation for Haskell 98 was produced by:++	* Malcolm Wallace++The installation mechanism was improved by:++	* Joost Visser (Joost.Visser@cwi.nl)++The instance derivation rules for Typeable, Term (based on Dynamic),+and other classes were contributed by++	* John Meacham++For details, see the darcs changelog

@@ -0,0 +1,143 @@+DrIFT-2.2.2:+  * redid build model, collect deriving rules automatically.+++DrIFT-2.2.1:++ Mon Aug 14 19:22:26 PDT 2006  John Meacham <john@repetae.net>+  * update autotools to make autoreconf work+  * update README to reflect there no longer being a 'reconf' script+  * get rid of recursive make in docs/ subdirectory++Thu Jan 25 21:04:02 PST 2007  John Meacham <john@repetae.net>+  * add support for Data.Binary, move old Binary to BitsBinary+++DrIFT-2.2.0:++Mon Apr 10 00:39:24 PDT 2006  John Meacham <john@repetae.net>+  * add note about reconf script+  * make the parser handle newtype deriving without bailing out+  * fix bug in Ord deriving rule++Wed Jan 18 03:59:21 PST 2006  David Roundy <droundy@darcs.net>+  * fix typo in src/Makefile.am++Sun Nov 27 02:59:14 PST 2005  Malcolm.Wallace@cs.york.ac.uk+  * Change rule for Haskell2XmlNew into XmlContent, add Parse rule.+  The Haskell2XmlNew class was a temporary staging post on the way to+  developing a new XmlContent class, available in HaXml-1.14 onwards.+  This patch updates the name, and the rule, to match the latest+  developments.  It also adds support for the textual (non-XML) Parse+  class, which is an experimental replacement for the Read class, using+  monadic parser combinators.  This is also currently defined in+  HaXml-1.14.+  * docs should refer to StandardRules.hs, not .lhs+  * fix docs for Hugs usage+  * keep docs of --list option up-to-date++Tue Nov 15 18:09:40 PST 2005  Einar Karttunen <ekarttun@cs.helsinki.fi>+  * Hook Arbitrary into DrIFT proper+  * Add UserRuleArbitrary++Thu Nov  3 02:52:38 PST 2005  John Meacham <john@repetae.net>+  * fix data derving for new versions of ghc++DrIFT-2.1.2:++  * fix rpm building, autoconf and some general make issues+  * fix warnings in generated binary instances+  * fix autoconf warnings++Mon Sep 12 08:11:10 PDT 2005  Malcolm.Wallace@cs.york.ac.uk+  * support for Haskell2XmlNew+  The HaXml library Haskell2Xml has been extended to make secondary parsing+  of the generic XML content tree into a typed value more robust.  An API+  change means that a new version of the class (unimaginatively called+  Haskell2XmlNew) exists, and this patch adds the ability to generate+  parsing code for the new class.+  * doc updates+  Fix some very out-of-date statements in the manual.++Tue May 31 16:17:12 PDT 2005  Samuel Bronson <naesten@gmail.com>+  * avoid problems with hmake by invoking ghc -M directly+  * Default to GHC to avoid NHC's tiny heap++DrIFT-2.1.1:++Tue Apr 19 21:09:13 PDT 2005  John Meacham <john@repetae.net>+  * Be sure to flush handles pointing to files before quitting+  * fix off-by-one line number error+  * Remove reference to genconf+  * Updated GenUtil.hs to fix nhc build+++DrIFT-2.1.0:+ * added 'get' utility which creates foo_g for each label which returns its+   value in a failing monad rather than raising an error.+ * added 'from' utility which creates fromFoo for each constructors+ * no longer an error for DERIVEPATH to not be set+ * added -i to ignore directives in file. useful with -g and -r for testing+ * added 'Query' which creates from, get, has, and is functions, but in a+   class with an instance for the data type. useful for extensible data types+ * added deriving rule for 'Monoid'+ * added code subdirectory with support code++DrIFT-2.0.4:+ * added rule for GhcBinary+ * now allows record syntax with newtype++DrIFT-2.0.3:+ * 'update' functions now pass through values without the specified field+ * drift-ghc script added to be used with ghc by passing -pgmF drift-ghc -F+ * documentation updated.++DrIFT-2.0.2:+ * deriving 'update' works with newer versions of ghc+ * fixed bug in Show and Read instances++DrIFT-2.0.1:+ * fixed many warnings in generated code+ * support for strict fields in constructors+ * support for infix constructors++DrIFT-2.0rc4:+ * added help messages and categorization to rules+ * small isLiterate fix (TODO use nhcs deliterizer)+ * prints debug info in comment in chaseImports+ * code cleanups+ * integrated some changes from Strafunski 1.7+ * autoconf/automake improvements++DrIFT-2.0rc3:+ * fixed version strings in generated files+ * fix dependency generation+ * fixed example test cases++DrIFT-2.0rc2:+ * autoconf/automake added+ * texinfo is installed properly now+ * build system cleanups+ * works with both nhc and ghc again++DrIFT-2.0rc1:+ * new texinfo documentation, based on Noel's original manual.+ * new option '-r' to only emit results and not original source+ * new option '-g' to add new global rules to apply.+ * cleaned up old non haskell98-compliant hacks++jDrIFT-1:+ * proper GetOpt command line handling, allows you to specify an+   output file (-o) as well as list all possible derivations this+   version was compiled with (-l)+ * proper LINE pragmas in generated code+ * smarter error handling in some cases, parser smarter sometimes.+ * can deal with/ignore as appropriate some ghc extensions now+ * rules to derive Typeable used by the Dynamic library.+ * rules to derive Observable from the HOOD object debugger+ * rules to derive Term, a generic term representation for generic+   computation, can be used in a similar fashion to the Strafunski one,+   but has a number of advantages, fully lazy constant time implode/explode+   being the main one. (the external library is compatable with their work.)++

@@ -0,0 +1,45 @@+name:                DrIFT-cabalized+version:             2.2.3.1+synopsis:            Program to derive type class instances+description:         DrIFT is a type sensitive preprocessor for Haskell. It extracts type declarations+                     and directives from modules. The directives cause rules to be fired on the parsed+                     type declarations, generating new code which is then appended to the bottom of the input+                     file. The rules are expressed as Haskell code, and it is intended that the user can add new+                     rules as required.+                     .+                     DrIFT automates instance derivation for classes that aren't supported by the standard compilers.+                     In addition, instances can be produced in seperate modules to that containing the type declaration.+                     This allows instances to be derived for a type after the original module has been compiled.+                     As a bonus, simple utility functions can also be produced from a type.+                     .+                     This package was cabalized by gwern <gwern0@gmail.com>.+category:            Data Structures+license:             BSD3+license-file:        LICENSE+-- For contributors & what they did, see AUTHORS+author:              Noel Winstanley, John Meacham <john@repetae.net>+maintainer:          <gwern0@gmail.com>+homepage:            http://repetae.net/computer/haskell/DrIFT/++Cabal-Version: >= 1.6+build-type:   Simple+data-files:   AUTHORS, ChangeLog, README, README.old, code/README.txt, docs/drift.texi, docs/drift.info,+              example/README, example/TestTerm.out.correct+extra-source-files:+       code/GhcBinary.hs, code/FunctorM.hs, example/TestTerm.hs, example/BTree.hs, example/Foo.lhs,+       example/Xref.hs, example/Artifical.hs, example/Example.hs++source-repository head+  type:     darcs+  location: http://repetae.net/repos/DrIFT++executable DrIFT-cabalized+    build-depends:  base<4, haskell98+    main-is:        DrIFT.hs+    hs-source-dirs: src+    ghc-options:    -Wall++executable DrIFT-cabalized-ghc+    build-depends: base<4, process+    main-is:       drift-ghc.hs+    ghc-options:  -Wall

@@ -0,0 +1,21 @@+Copyright (c) 2002-2007 DrIFT contributors++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+

@@ -0,0 +1,66 @@+------------------------------------------------------------------------------++			     DrIFT++This package contains a source distribution of DrIFT, a tool for automatic+derivation of Haskell class instances. DrIFT was formerly known as Derive.++The current homepage is at:+    <http://repetae.net/john/computer/haskell/DrIFT/>+++------------------------------------------------------------------------------++Contents of this package:++  - src         Directory with the source files of the DrIFT tool+  - example     Directory with examples of using the DrIFT tool+  - docs        Documentation++------------------------------------------------------------------------------+++If you have pulled the source from the darcs repository, you must first build+the autotools scripts by running++ $ autoreconf -i++To configure and install DrIFT from source or from Hackage, you have two options.+++ AUTOTOOLS++You can install through the GNU Autools, like thus:++  $ ./configure --prefix=<dir>+  $ make install++Where <dir> is the directory in which you want to install the tool. Note that+a Haskell compiler (NHC or GHC) must be in your path. Otherwise, supply the+location of a Haskell compiler as follows:++  $ ./configure --prefix=<dir> --with-hc=<Haskell compiler>+  $ make install++ CABAL++You can also install through Cabal, the standard Haskell packaging tool with the usual set of commands:++      $ runhaskell Setup configure # optional --user --prefix=/home/user/bin+      $ runhaskell Setup build+      $ runhaskell Setup install # --user++(Remember, from Darcs requires autoreconf to have been run! If you are installing from Hackage, autoreconf should have already been run in the source tarball.)++------------------------------------------------------------------------------+++You may optionally set the environmental variable $DERIVEPATH to the list of directories you wish to search for modules.++An example:++ DERIVEPATH=/users/grad/nww/share/hugs/lib:/users/grad/nww/share/hugs/lib/hugs+++to run DrIFT, simply pass the Haskell file name as an argument. You may run+'DrIFT --help' to get a summary of the various command line options

@@ -0,0 +1,59 @@+This tar file contains:++Makefile	- to build DrIFT+*.hs,*.lhs	- DrIFT source code+example/	- simple example files to test DrIFT on.+docs/		- documentation in texinfo format++History+-------+Development Taken over by John Meacham (john@foo.net) in April of 2002+  see ChangeLog for changes since 1.1++  (Changes by Malcolm.Wallace@cs.york.ac.uk, 1999)+Updated sources to Haskell 98.  Added derivation of class Binary and+class Haskell2Xml.  Changed Main.main to place results on stdout instead+of overwriting original file.  Have not tried using Makefile recently; I+use hmake instead.+++Building DrIFT+--------------+depending on your system you should type one of the following:+hmake DrIFT +make+++Installation+------------+copy the 'DrIFT' executable to somewhere on your path++set DERIVEPATH to the list of directories you wish to search for  for+modules / interfaces. ++DERIVEPATH is quite fussy about the format the list should take :-+ * each path should be separated by ':'+ * no space inserted anywhere+ * no final '/' on the end of a path++e.g. +good - /users/grad/nww/share/hugs/lib:/users/grad/nww/share/hugs/lib/hugs+bad - /users/grad/nww/share/hugs/lib/:/users/grad/nww/share/hugs/lib/hugs/+++Running DrIFT+--------------+DrIFT foo.drift.hs -o foo.hs+DrIFT foo.hs -r -o foo_derivations.hs++Homepage+--------+http://homer.netmar.com/~john/computer/haskell/DrIFT/+++Authors+-------+Noel Winstanley+Malcolm Wallace+Joost Visser+John Meacham

@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMainWithHooks defaultUserHooks

@@ -0,0 +1,20 @@+module FunctorM where++import Array (array, assocs, bounds, Array(), Ix())++class FunctorM f where+    fmapM :: Monad m => (a -> m b) -> f a -> m (f b)+++instance FunctorM [] where+    fmapM f xs = mapM f xs++instance FunctorM Maybe where+    fmapM _ Nothing = return Nothing+    fmapM f (Just x) = f x >>= return . Just++instance Ix i => FunctorM (Array i) where+    fmapM f a = sequence [ f e >>= return . (,) i | (i,e) <- assocs a] >>= return . array b  where+        b = bounds a++

@@ -0,0 +1,712 @@+{-# OPTIONS -fallow-overlapping-instances #-}+--+-- (c) The University of Glasgow 2002+--+-- Binary I/O library, with special tweaks for GHC+--+-- Based on the nhc98 Binary library, which is copyright+-- (c) Malcolm Wallace and Colin Runciman, University of York, 1998.+-- Under the terms of the license for that software, we must tell you+-- where you can obtain the original version of the Binary library, namely+--     http://www.cs.york.ac.uk/fp/nhc98/++-- arch-tag: 1418e09a-9a18-4dca-a0fc-9262c9d97beb++module Binary+  ( {-type-}  Bin,+    {-class-} Binary(..),+    {-type-}  BinHandle,++   openBinIO, openBinIO_,+   openBinMem,+--   closeBin,++   seekBin,+   tellBin,+   castBin,++   writeBinMem,+   readBinMem,++   isEOFBin,++   -- for writing instances:+   putByte,+   getByte,++   -- lazy Bin I/O+   lazyGet,+   lazyPut,++   -- GHC only:+   ByteArray(..),+   getByteArray,+   putByteArray++   --getBinFileWithDict,	-- :: Binary a => FilePath -> IO a+   --putBinFileWithDict,	-- :: Binary a => FilePath -> ModuleName -> a -> IO ()++  ) where+++--import FastString+import FastMutInt++import Data.Array.IO+import Data.Array+import Data.Bits+import Data.Int+import Data.Word+import Data.IORef+import Data.Char		( ord, chr )+import Data.Array.Base  	( unsafeRead, unsafeWrite )+import Control.Monad		( when )+import Control.Exception	( throwDyn )+import System.IO as IO+import System.IO.Unsafe		( unsafeInterleaveIO )+import System.IO.Error		( mkIOError, eofErrorType )+import GHC.Real			( Ratio(..) )+import GHC.Exts+import GHC.IOBase	 	( IO(..) )+import GHC.Word			( Word8(..) )+import System.IO		( openBinaryFile )+import PackedString+--import Atom+import Time+import Monad+import Data.Array.IArray+import Data.Array.Base+++{-+#if __GLASGOW_HASKELL__ < 503+type BinArray = MutableByteArray RealWorld Int+newArray_ bounds     = stToIO (newCharArray bounds)+unsafeWrite arr ix e = stToIO (writeWord8Array arr ix e)+unsafeRead  arr ix   = stToIO (readWord8Array arr ix)+#if __GLASGOW_HASKELL__ < 411+newByteArray#        = newCharArray#+#endif+hPutArray h arr sz   = hPutBufBAFull h arr sz+hGetArray h sz       = hGetBufBAFull h sz++mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> Exception+mkIOError t location maybe_hdl maybe_filename+  = IOException (IOError maybe_hdl t location ""+#if __GLASGOW_HASKELL__ > 411+		         maybe_filename+#endif+  		)+eofErrorType = EOF+++#ifndef SIZEOF_HSWORD+#define SIZEOF_HSWORD WORD_SIZE_IN_BYTES+#endif++#else+type BinArray = IOUArray Int Word8+#endif+-}++-- #define SIZEOF_HSINT 4++type BinArray = IOUArray Int Word8+---------------------------------------------------------------+--		BinHandle+---------------------------------------------------------------++data BinHandle+  = BinMem {		-- binary data stored in an unboxed array+     off_r :: !FastMutInt,		-- the current offset+     sz_r  :: !FastMutInt,		-- size of the array (cached)+     arr_r :: !(IORef BinArray) 	-- the array (bounds: (0,size-1))+    }+	-- XXX: should really store a "high water mark" for dumping out+	-- the binary data to a file.++  | BinIO {		-- binary data stored in a file+     off_r :: !FastMutInt,		-- the current offset (cached)+     hdl   :: !IO.Handle		-- the file handle (must be seekable)+   }+	-- cache the file ptr in BinIO; using hTell is too expensive+	-- to call repeatedly.  If anyone else is modifying this Handle+	-- at the same time, we'll be screwed.++--getUserData :: BinHandle -> UserData+--getUserData bh = bh_usr bh++--setUserData :: BinHandle -> UserData -> BinHandle+--setUserData bh us = bh { bh_usr = us }+++---------------------------------------------------------------+--		Bin+---------------------------------------------------------------++newtype Bin a = BinPtr Int+  deriving (Eq, Ord, Show, Bounded)++castBin :: Bin a -> Bin b+castBin (BinPtr i) = BinPtr i++---------------------------------------------------------------+--		class Binary+---------------------------------------------------------------++class Binary a where+    put_   :: BinHandle -> a -> IO ()+    put    :: BinHandle -> a -> IO (Bin a)+    get    :: BinHandle -> IO a++    -- define one of put_, put.  Use of put_ is recommended because it+    -- is more likely that tail-calls can kick in, and we rarely need the+    -- position return value.+    put_ bh a = do put bh a; return ()+    put bh a  = do p <- tellBin bh; put_ bh a; return p++putAt  :: Binary a => BinHandle -> Bin a -> a -> IO ()+putAt bh p x = do seekBin bh p; put bh x; return ()++getAt  :: Binary a => BinHandle -> Bin a -> IO a+getAt bh p = do seekBin bh p; get bh++openBinIO_ :: IO.Handle -> IO BinHandle+openBinIO_ h = openBinIO h++openBinIO :: IO.Handle -> IO BinHandle+openBinIO h = do+  r <- newFastMutInt+  writeFastMutInt r 0+  return (BinIO  r h)++openBinMem :: Int -> IO BinHandle+openBinMem size+ | size <= 0 = error "Data.Binary.openBinMem: size must be >= 0"+ | otherwise = do+   arr <- newArray_ (0,size-1)+   arr_r <- newIORef arr+   ix_r <- newFastMutInt+   writeFastMutInt ix_r 0+   sz_r <- newFastMutInt+   writeFastMutInt sz_r size+   return (BinMem ix_r sz_r arr_r)++tellBin :: BinHandle -> IO (Bin a)+tellBin (BinIO   r _)   = do ix <- readFastMutInt r; return (BinPtr ix)+tellBin (BinMem  r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)++seekBin :: BinHandle -> Bin a -> IO ()+seekBin (BinIO  ix_r h) (BinPtr p) = do+  writeFastMutInt ix_r p+  hSeek h AbsoluteSeek (fromIntegral p)+seekBin h@(BinMem  ix_r sz_r a) (BinPtr p) = do+  sz <- readFastMutInt sz_r+  if (p >= sz)+	then do expandBin h p; writeFastMutInt ix_r p+	else writeFastMutInt ix_r p++isEOFBin :: BinHandle -> IO Bool+isEOFBin (BinMem  ix_r sz_r a) = do+  ix <- readFastMutInt ix_r+  sz <- readFastMutInt sz_r+  return (ix >= sz)+isEOFBin (BinIO  ix_r h) = hIsEOF h++writeBinMem :: BinHandle -> FilePath -> IO ()+writeBinMem (BinIO  _ _) _ = error "Data.Binary.writeBinMem: not a memory handle"+writeBinMem (BinMem  ix_r sz_r arr_r) fn = do+  h <- openBinaryFile fn WriteMode+  arr <- readIORef arr_r+  ix  <- readFastMutInt ix_r+  hPutArray h arr ix+  hClose h++readBinMem :: FilePath -> IO BinHandle+-- Return a BinHandle with a totally undefined State+readBinMem filename = do+  h <- openBinaryFile filename ReadMode+  filesize' <- hFileSize h+  let filesize = fromIntegral filesize'+  arr <- newArray_ (0,filesize-1)+  count <- hGetArray h arr filesize+  when (count /= filesize)+        (error ("Binary.readBinMem: only read " ++ show count ++ " bytes"))+  hClose h+  arr_r <- newIORef arr+  ix_r <- newFastMutInt+  writeFastMutInt ix_r 0+  sz_r <- newFastMutInt+  writeFastMutInt sz_r filesize+  return (BinMem ix_r sz_r arr_r)++-- expand the size of the array to include a specified offset+expandBin :: BinHandle -> Int -> IO ()+expandBin (BinMem  ix_r sz_r arr_r) off = do+   sz <- readFastMutInt sz_r+   let sz' = head (dropWhile (<= off) (iterate (* 2) sz))+   arr <- readIORef arr_r+   arr' <- newArray_ (0,sz'-1)+   sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i | i <- [ 0 .. sz-1 ] ]+   writeFastMutInt sz_r sz'+   writeIORef arr_r arr'+   return ()+expandBin (BinIO  _ _) _ = return ()+	-- no need to expand a file, we'll assume they expand by themselves.++-- -----------------------------------------------------------------------------+-- Low-level reading/writing of bytes++putWord8 :: BinHandle -> Word8 -> IO ()+putWord8 h@(BinMem  ix_r sz_r arr_r) w = do+    ix <- readFastMutInt ix_r+    sz <- readFastMutInt sz_r+	-- double the size of the array if it overflows+    if (ix >= sz)+        then do+            expandBin h ix+            putWord8 h w+        else do+            arr <- readIORef arr_r+            unsafeWrite arr ix w+            writeFastMutInt ix_r (ix+1)+            return ()++putWord8 (BinIO  ix_r h) w = do+    ix <- readFastMutInt ix_r+    hPutChar h (chr (fromIntegral w))	-- XXX not really correct+    writeFastMutInt ix_r (ix+1)+    return ()++getWord8 :: BinHandle -> IO Word8+getWord8 (BinMem  ix_r sz_r arr_r) = do+    ix <- readFastMutInt ix_r+    sz <- readFastMutInt sz_r+    when (ix >= sz)  $+	ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)+    arr <- readIORef arr_r+    w <- unsafeRead arr ix+    writeFastMutInt ix_r (ix+1)+    return w+getWord8 (BinIO  ix_r h) = do+    ix <- readFastMutInt ix_r+    c <- hGetChar h+    writeFastMutInt ix_r (ix+1)+    return $! (fromIntegral (ord c))	-- XXX not really correct++{-# INLINE putByte #-}+putByte :: BinHandle -> Word8 -> IO ()+putByte bh w = putWord8 bh w++{-# INLINE getByte #-}+getByte :: BinHandle -> IO Word8+getByte = getWord8++-- -----------------------------------------------------------------------------+-- Primitve Word writes++instance Binary Word8 where+  put_ = putWord8+  get  = getWord8++instance Binary Word16 where+  put_ h w = do -- XXX too slow.. inline putWord8?+    putByte h (fromIntegral (w `shiftR` 8))+    putByte h (fromIntegral (w .&. 0xff))+  get h = do+    w1 <- getWord8 h+    w2 <- getWord8 h+    return $! ((fromIntegral w1 `shiftL` 8) .|. fromIntegral w2)+++instance Binary Word32 where+  put_ h w = do+    putByte h (fromIntegral (w `shiftR` 24))+    putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff))+    putByte h (fromIntegral ((w `shiftR` 8)  .&. 0xff))+    putByte h (fromIntegral (w .&. 0xff))+  get h = do+    w1 <- getWord8 h+    w2 <- getWord8 h+    w3 <- getWord8 h+    w4 <- getWord8 h+    return $! ((fromIntegral w1 `shiftL` 24) .|.+	       (fromIntegral w2 `shiftL` 16) .|.+	       (fromIntegral w3 `shiftL`  8) .|.+	       (fromIntegral w4))+++instance Binary Word64 where+  put_ h w = do+    putByte h (fromIntegral (w `shiftR` 56))+    putByte h (fromIntegral ((w `shiftR` 48) .&. 0xff))+    putByte h (fromIntegral ((w `shiftR` 40) .&. 0xff))+    putByte h (fromIntegral ((w `shiftR` 32) .&. 0xff))+    putByte h (fromIntegral ((w `shiftR` 24) .&. 0xff))+    putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff))+    putByte h (fromIntegral ((w `shiftR`  8) .&. 0xff))+    putByte h (fromIntegral (w .&. 0xff))+  get h = do+    w1 <- getWord8 h+    w2 <- getWord8 h+    w3 <- getWord8 h+    w4 <- getWord8 h+    w5 <- getWord8 h+    w6 <- getWord8 h+    w7 <- getWord8 h+    w8 <- getWord8 h+    return $! ((fromIntegral w1 `shiftL` 56) .|.+	       (fromIntegral w2 `shiftL` 48) .|.+	       (fromIntegral w3 `shiftL` 40) .|.+	       (fromIntegral w4 `shiftL` 32) .|.+	       (fromIntegral w5 `shiftL` 24) .|.+	       (fromIntegral w6 `shiftL` 16) .|.+	       (fromIntegral w7 `shiftL`  8) .|.+	       (fromIntegral w8))++-- -----------------------------------------------------------------------------+-- Primitve Int writes++instance Binary Int8 where+  put_ h w = put_ h (fromIntegral w :: Word8)+  get h    = do w <- get h; return $! (fromIntegral (w::Word8))++instance Binary Int16 where+  put_ h w = put_ h (fromIntegral w :: Word16)+  get h    = do w <- get h; return $! (fromIntegral (w::Word16))++instance Binary Int32 where+  put_ h w = put_ h (fromIntegral w :: Word32)+  get h    = do w <- get h; return $! (fromIntegral (w::Word32))++instance Binary Int64 where+  put_ h w = put_ h (fromIntegral w :: Word64)+  get h    = do w <- get h; return $! (fromIntegral (w::Word64))++-- -----------------------------------------------------------------------------+-- Instances for standard types++instance Binary () where+    put_ bh () = return ()+    get  _     = return ()+--    getF bh p  = case getBitsF bh 0 p of (_,b) -> ((),b)++instance Binary Bool where+    put_ bh b = putByte bh (fromIntegral (fromEnum b))+    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))+--    getF bh p = case getBitsF bh 1 p of (x,b) -> (toEnum x,b)++instance Binary Char where+    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)+    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))+--    getF bh p = case getBitsF bh 8 p of (x,b) -> (toEnum x,b)++instance Binary Int where+-- #if SIZEOF_HSINT == 4+    put_ bh i = put_ bh (fromIntegral i :: Int32)+    get  bh = do+	x <- get bh+	return $! (fromIntegral (x :: Int32))+-- #elif SIZEOF_HSINT == 8+--    put_ bh i = put_ bh (fromIntegral i :: Int64)+--    get  bh = do+--	x <- get bh+--	return $! (fromIntegral (x :: Int64))+-- #else+-- #error "unsupported sizeof(HsInt)"+-- #endif++instance Binary ClockTime where+    put_ bh ct = do+	let t = toUTCTime ct+	put_ bh (ctYear t)+	put_ bh (fromEnum $ ctMonth t)+	put_ bh (ctDay t)+	put_ bh (ctHour t)+	put_ bh (ctMin t)+	put_ bh (ctSec t)+    get bh = do+	year <- get bh+	month <- fmap toEnum $ get bh+	day <- get bh+	hour <- get bh+	min <- get bh+	sec <- get bh+	return $ toClockTime $ (toUTCTime epoch) {ctYear = year, ctDay = day, ctMonth = month, ctHour = hour, ctMin = min, ctSec = sec}+epoch = toClockTime $ CalendarTime { ctYear = 1970, ctMonth = January, ctDay = 0, ctHour = 0, ctMin = 0, ctSec = 0, ctTZ = 0, ctPicosec = 0, ctWDay = undefined, ctYDay = undefined, ctTZName = undefined, ctIsDST = undefined}++instance Binary PackedString where+    put_ bh (PS a) = put_ bh a+    get bh = fmap PS $ get bh++--put_ bh $ (snd $ Data.Array.IArray.bounds a) + 1+--mapM_ (put_ bh) (Data.Array.IArray.elems a)+--sz <- get bh+--x <- sequence $ replicate sz (get bh)+--return $ PS (Data.Array.IArray.listArray (0,sz - 1) x)++--put_ bh ps = put_ bh (unpackPS ps)+--get bh = liftM packString $ get bh+--put_ bh ps = putNList_ bh (unpackPS ps)+--get bh = liftM packString $ getNList bh++-- putNList_ bh xs = do+--     put_ bh (length xs)+--     mapM_ (put_ bh) xs+--+-- getNList bh = do+--     l <- get bh+--     sequence $ replicate l (get bh)++{-+instance Binary [Char] where+    put_ bh cs = put_ bh (packString cs)+    get bh = do+        ps <- get bh+        return $ unpackPS ps+-}++instance Binary a => Binary [a] where+    put_ bh []     = putByte bh 0+    put_ bh (x:xs) = do putByte bh 1; put_ bh x; put_ bh xs+    get bh         = do h <- getWord8 bh+                        case h of+                          0 -> return []+                          _ -> do x  <- get bh+                                  xs <- get bh+                                  return (x:xs)++instance (Binary a, Binary b) => Binary (a,b) where+    put_ bh (a,b) = do put_ bh a; put_ bh b+    get bh        = do a <- get bh+                       b <- get bh+                       return (a,b)++instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where+    put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c+    get bh          = do a <- get bh+                         b <- get bh+                         c <- get bh+                         return (a,b,c)++instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where+    put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d+    get bh          = do a <- get bh+                         b <- get bh+                         c <- get bh+                         d <- get bh+                         return (a,b,c,d)++instance Binary a => Binary (Maybe a) where+    put_ bh Nothing  = putByte bh 0+    put_ bh (Just a) = do putByte bh 1; put_ bh a+    get bh           = do+        h <- getWord8 bh+        case h of+            0 -> return Nothing+            _ -> do+                x <- get bh+                return (Just x)++instance (Binary a, Binary b) => Binary (Either a b) where+    put_ bh (Left  a) = do putByte bh 0; put_ bh a+    put_ bh (Right b) = do putByte bh 1; put_ bh b+    get bh            = do h <- getWord8 bh+                           case h of+                             0 -> do a <- get bh ; return (Left a)+                             _ -> do b <- get bh ; return (Right b)++++-- these flatten the start element. hope that's okay!+instance Binary (UArray Int Word8) where+    put_ bh@(BinIO ix_r h) ua = do+        let sz = rangeSize (Data.Array.IO.bounds ua)+        ix <- readFastMutInt ix_r+        put_ bh sz+        ua <- unsafeThaw ua+        hPutArray h ua sz+        writeFastMutInt ix_r (ix + sz + 4)+    put_ bh (UArray s e ba) = do+        let sz = (rangeSize (s,e))+        put_ bh sz+        case sz of+            I# i -> putByteArray bh ba i+    get bh@(BinIO ix_r h) = do+        ix <- readFastMutInt ix_r+        sz <- get bh+        ba <- newArray_ (0, sz - 1)+        hGetArray h ba sz+        writeFastMutInt ix_r (ix + sz + 4)+        ba <- unsafeFreeze ba+        return ba+    get  bh = do+        sz <- get bh+        BA ba <- getByteArray bh sz+        return $ UArray 0 (sz - 1) ba++ {-++instance (Ix a, Binary a) => Binary (UArray a Word8) where+    put_ bh (UArray s e ba) = do+        put_ bh s+        put_ bh e+        case (rangeSize (s,e)) of+            I# i -> putByteArray bh ba i+    get  bh = do+        s <- get bh+        e <- get bh+        BA ba <- getByteArray bh (rangeSize (s,e))+        return $ UArray s e ba++-}+-- #ifdef __GLASGOW_HASKELL__++instance Binary Integer where+    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)+    put_ bh (J# s# a#) = do+ 	p <- putByte bh 1;+	put_ bh (I# s#)+	let sz# = sizeofByteArray# a#  -- in *bytes*+	put_ bh (I# sz#)  -- in *bytes*+	putByteArray bh a# sz#++    get bh = do+	b <- getByte bh+	case b of+	  0 -> do (I# i#) <- get bh+		  return (S# i#)+	  _ -> do (I# s#) <- get bh+		  sz <- get bh+		  (BA a#) <- getByteArray bh sz+		  return (J# s# a#)++putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()+putByteArray bh a s# = loop 0#+  where loop n#+	   | n# ==# s# = return ()+	   | otherwise = do+	   	putByte bh (indexByteArray a n#)+		loop (n# +# 1#)++getByteArray :: BinHandle -> Int -> IO ByteArray+getByteArray bh (I# sz) = do+  (MBA arr) <- newByteArray sz+  let loop n+	   | n ==# sz = return ()+	   | otherwise = do+		w <- getByte bh+		writeByteArray arr n w+		loop (n +# 1#)+  loop 0#+  freezeByteArray arr+++data ByteArray = BA ByteArray#+data MBA = MBA (MutableByteArray# RealWorld)++newByteArray :: Int# -> IO MBA+newByteArray sz = IO $ \s ->+  case newByteArray# sz s of { (# s, arr #) ->+  (# s, MBA arr #) }++freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray+freezeByteArray arr = IO $ \s ->+  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->+  (# s, BA arr #) }++writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()++writeByteArray arr i (W8# w) = IO $ \s ->+  case writeWord8Array# arr i w s of { s ->+  (# s, () #) }++indexByteArray a# n# = W8# (indexWord8Array# a# n#)++instance (Integral a, Binary a) => Binary (Ratio a) where+    put_ bh (a :% b) = do put_ bh a; put_ bh b+    get bh = do a <- get bh; b <- get bh; return (a :% b)+-- #endif++instance Binary (Bin a) where+  put_ bh (BinPtr i) = put_ bh i+  get bh = do i <- get bh; return (BinPtr i)++-- -----------------------------------------------------------------------------+-- Lazy reading/writing++lazyPut :: Binary a => BinHandle -> a -> IO ()+lazyPut bh a = do+	-- output the obj with a ptr to skip over it:+    pre_a <- tellBin bh+    put_ bh pre_a	-- save a slot for the ptr+    put_ bh a		-- dump the object+    q <- tellBin bh 	-- q = ptr to after object+    putAt bh pre_a q 	-- fill in slot before a with ptr to q+    seekBin bh q	-- finally carry on writing at q++lazyGet :: Binary a => BinHandle -> IO a+lazyGet bh = do+    p <- get bh		-- a BinPtr+    p_a <- tellBin bh+    a <- unsafeInterleaveIO (getAt bh p_a)+    seekBin bh p -- skip over the object for now+    return a+++{-+---------------------------------------------------------+--		Reading and writing FastStrings+---------------------------------------------------------++putFS bh (FastString id l ba) = do+  put_ bh (I# l)+  putByteArray bh ba l+putFS bh s = error ("Binary.put_(FastString): " ++ unpackFS s)+	-- Note: the length of the FastString is *not* the same as+	-- the size of the ByteArray: the latter is rounded up to a+	-- multiple of the word size.++{- -- possible faster version, not quite there yet:+getFS bh@BinMem{} = do+  (I# l) <- get bh+  arr <- readIORef (arr_r bh)+  off <- readFastMutInt (off_r bh)+  return $! (mkFastSubStringBA# arr off l)+-}+getFS bh = do+  (I# l) <- get bh+  (BA ba) <- getByteArray bh (I# l)+  return $! (mkFastSubStringBA# ba 0# l)++{-+instance Binary FastString where+  put_ bh f@(FastString id l ba) =+    case getUserData bh of {+	UserData { ud_next = j_r, ud_map = out_r, ud_dict = dict} -> do+    out <- readIORef out_r+    let uniq = getUnique f+    case lookupUFM out uniq of+	Just (j,f)  -> put_ bh j+	Nothing -> do+	   j <- readIORef j_r+	   put_ bh j+	   writeIORef j_r (j+1)+	   writeIORef out_r (addToUFM out uniq (j,f))+    }+  put_ bh s = error ("Binary.put_(FastString): " ++ show (unpackFS s))++  get bh = do+	j <- get bh+	return $! (ud_dict (getUserData bh) ! j)+-}+-}++{-+instance Binary Atom where+    get bh = do+        ps <- get bh+        a <- fromPackedStringIO ps+        return a+    put_ bh a = put_ bh (toPackedString a)+-}

@@ -0,0 +1,3 @@+This directory contains various modules which are associated with deriving+rules. They may either be used as-is or some may require modification or have a+suitable replacement in the standard libraries already.

@@ -0,0 +1,841 @@+This is docs/drift.info, produced by makeinfo version 4.11 from+./docs/drift.texi.++INFO-DIR-SECTION Haskell Tools+START-INFO-DIR-ENTRY+* DrIFT: (drift). A type sensitive preprocessor for Haskell 98.+END-INFO-DIR-ENTRY+++File: drift.info,  Node: Top,  Next: Introduction,  Prev: (dir),  Up: (dir)++DrIFT+*****++DrIFT is a type-sensitive preprocessor for Haskell.  It is used to+automatically generate code for new defined types.++* Menu:++* Introduction::+* User Guide::+* Standard Rules::+* User-Defined Rules::+* Installation::+* Bugs::+++File: drift.info,  Node: Introduction,  Next: User Guide,  Prev: Top,  Up: Top++1 Introduction+**************++This is a guide to using DrIFT, a type sensitive preprocessor for+Haskell 98.++   DrIFT is a tool which parses a Haskell module for structures (data &+newtype declarations) and commands.  These commands cause rules to be+fired on the parsed data, generating new code which is then appended to+the bottom of the input file, or redirected to another. These rules are+expressed as Haskell code, and it is intended that the user can add new+rules as required.++   DrIFT is written in pure Haskell 98, however code it generates is+free to make use of extensions when appropriate. DrIFT is currently+tested against hugs and ghc.++* Menu:++* What does DrIFT do?::+* Features::+* Motivation::+* An Example::+++File: drift.info,  Node: What does DrIFT do?,  Next: Features,  Prev: Introduction,  Up: Introduction++1.1 So, What Does DrIFT do?+===========================++DrIFT allows derivation of instances for classes that aren't supported+by the standard compilers. In addition, instances can be produced in+separate modules to that containing the type declaration.  This allows+instances to be derived for a type after the original module has been+compiled.  As a bonus, simple utility functions can also be produced+for types.+++File: drift.info,  Node: Features,  Next: Motivation,  Prev: What does DrIFT do?,  Up: Introduction++1.2 Features+============++   * DrIFT comes with a set of rules to produce instances for all+     derivable classes given in the Prelude.  There's a rule to produce+     instances of NFData (the original motivation of all this), and+     rules for utility functions on types also. The DrIFT+     implementation is also regularly updated with rules submitted by+     users.++   * Code is generated using pretty-printing combinators.  This means+     that the output is (fairly) well formatted, and easy on the human+     eye.++   * Effort has been made to make the rule interface as easy to use as+     possible.  This is to allow users to add rules to generate code+     specific to their own projects.  As the rules are written in+     Haskell themselves, the user doesn't have to learn a new language+     syntax, and can use all Haskell's features.++   Currently supported derivations are the following. This list is+obtainable by running `DrIFT -l'.++++Binary:+   Binary            efficient binary encoding of terms+   GhcBinary         byte sized binary encoding of terms+Debugging:+   Observable        HOOD observable+General:+   NFData            provides 'rnf' to reduce to normal form (deepSeq)+   Typeable          derive Typeable for Dynamic+Generics:+   FunctorM          derive reasonable fmapM implementation+   HFoldable         Strafunski hfoldr+   Monoid            derive reasonable Data.Monoid implementation+   RMapM             derive reasonable rmapM implementation+   Term              Strafunski representation via Dynamic+Prelude:+   Bounded+   Enum+   Eq+   Ord+   Read+   Show+Representation:+   ATermConvertible  encode terms in the ATerm format+   Haskell2Xml       encode terms as XML (HaXml<=1.13)+   XmlContent        encode terms as XML (HaXml>=1.14)+Utility:+   Parse             parse values back from standard 'Show'+   Query             provide a QueryFoo class with 'is', 'has',+                       'from', and 'get' routines+   from              provides fromFoo for each constructor+   get               for label 'foo' provide foo_g to get it+   has               hasfoo for record types+   is                provides isFoo for each constructor+   test              output raw data for testing+   un                provides unFoo for unary constructors+   update            for label 'foo' provides 'foo_u' to update it+                       and foo_s to set it+++File: drift.info,  Node: Motivation,  Next: An Example,  Prev: Features,  Up: Introduction++1.3 Why Do We Need DrIFT?+=========================++The original motivation for DrIFT came from reading one of the Glasgow+Parallel Haskell papers on Strategies.  Strategies require producing+instances of a class which reduces to normal form (called NFData). It+was commented that it was a shame that instances of NFData couldn't be+automatically derived; the rules to generate the instances are simple,+and adding instances by hand is  tiresome.  Many classes' instances+follow simple patterns.  This is what makes coding up instances so+tedious: there's no thought involved!++   The idea to extend DrIFT to work on imported types came from a+discussion of the Haskell mailing list, arising from a point made by+Olaf Chitil :++     Why is the automatic derivation of instances for some standard+     classes linked to data and newtype declarations?  It happened+     already several times to me that I needed a standard instance of a+     data type that I imported from a module that did not provide that+     instance and which I did not want to change (a library; GHC, which+     I mainly want to extend by further modules, not spread changes+     over 250 modules).  When declaring a new data type one normally+     avoids deriving (currently) unneeded instances, because it costs+     program code (and maybe one even wants to enable the user of the+     module to define his own instances).++   The third feature of DrIFT, providing utility functions to+manipulate new types, especially records was caused by finding oneself+writing the same sort of code over and over again.  These functions+couldn't be captured in a class, but have a similar form for each type+they are defined on.  A thread on the Haskell mailing list made a+related point: untagging and manipulating newtypes was more cumbersome+than it should be.+++File: drift.info,  Node: An Example,  Prev: Motivation,  Up: Introduction++1.4 An Example+==============++Here's an example of what how DrIFT is used.  This Haskell module+contains commands to the DrIFT preprocessor.  These are annotated with+`{-!  ... !-}'.  After processing with DrIFT the generated code is+glued on the bottom of the file, beneath a marker indicating where the+new code starts.  The machine generated code is quite long, and would+really have been a drudge to type in by hand.++* Menu:++* Source Code::+* After processing with DrIFT::+++File: drift.info,  Node: Source Code,  Next: After processing with DrIFT,  Prev: An Example,  Up: An Example++1.4.1 Source Code+-----------------++     -- example script for DrIFT++     module Example where+     import Foo+     {-!for Foo derive :  Read,NFData !-} -- apply rules to imported type++     {-! global : is !-} -- global to this module+     {-!for Data derive : update,Show,Read!-} -- stand alone comand syntax++     {-!for Maybe derive : NFData !-} -- apply rules to prelude type++     data Data = D {name :: Name,+     			constraints :: [(Class,Var)],+     			vars :: [Var],+     			body :: [(Constructor,[(Name,Type)])],+     			derive :: [Class],+     			statement :: Statement}++     data Statement = DataStmt | NewTypeStmt+             deriving Eq {-!derive : Ord,Show,Read !-} -- abbreviated syntax+++File: drift.info,  Node: After processing with DrIFT,  Prev: Source Code,  Up: An Example++1.4.2 After processing with DrIFT+---------------------------------++     module Example where+     import Foo+     {-!for Foo derive : Read,NFData !-} -- apply rules to imported type++     {-! global : is !-} -- global to this module+     {-!for Data derive : update,Show,Read!-} -- stand alone comand syntax++     {-!for Maybe derive : NFData !-} -- apply rules to prelude type++     data Data = D {name :: Name,+                             constraints :: [(Class,Var)],+                             vars :: [Var],+                             body :: [(Constructor,[(Name,Type)])],+                             derive :: [Class],+                             statement :: Statement}++     data Statement = DataStmt | NewTypeStmt+             deriving Eq {-!derive : Ord,Show,Read !-}++     {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}+     isD (D aa ab ac ad ae af) = True+     isD _ = False++     instance Ord Statement where+         compare DataStmt (DataStmt) = EQ+         compare DataStmt (NewTypeStmt) = LT+         compare NewTypeStmt (DataStmt) = GT+         compare NewTypeStmt (NewTypeStmt) = EQ++     instance Show Statement where+         showsPrec d (DataStmt) = showString "DataStmt"+         showsPrec d (NewTypeStmt) = showString "NewTypeStmt"++     instance Read Statement where+         readsPrec d input =+                   (\ inp -> [((DataStmt) , rest)+                               | ("DataStmt" , rest) <- lex inp])+                   input+                   +++                   (\ inp ->+                    [((NewTypeStmt) , rest)+                       | ("NewTypeStmt" , rest) <- lex inp])+                   input++     isDataStmt (DataStmt) = True+     isDataStmt _ = False+     isNewTypeStmt (NewTypeStmt) = True+     isNewTypeStmt _ = False++     instance (NFData a) => NFData (Maybe a) where+         rnf (Just aa) = rnf aa+         rnf (Nothing) = ()++     body_u f r@D{body} = r{body = f body}+     constraints_u f r@D{constraints} = r{constraints = f constraints}+     derive_u f r@D{derive} = r{derive = f derive}+     name_u f r@D{name} = r{name = f name}+     statement_u f r@D{statement} = r{statement = f statement}+     vars_u f r@D{vars} = r{vars = f vars}+     body_s v =  body_u  (const v)+     constraints_s v =  constraints_u  (const v)+     derive_s v =  derive_u  (const v)+     name_s v =  name_u  (const v)+     statement_s v =  statement_u  (const v)+     vars_s v =  vars_u  (const v)++     instance Show Data where+         showsPrec d (D aa ab ac ad ae af) = showParen (d >= 10)+                   (showString "D" . showChar '{' .+                    showString "name" . showChar '=' . showsPrec 10 aa+                    . showChar ',' .+                    showString "constraints" . showChar '=' . showsPrec 10 ab+                    . showChar ',' .+                    showString "vars" . showChar '=' . showsPrec 10 ac+                    . showChar ',' .+                    showString "body" . showChar '=' . showsPrec 10 ad+                    . showChar ',' .+                    showString "derive" . showChar '=' . showsPrec 10 ae+                    . showChar ',' .+                    showString "statement" . showChar '=' . showsPrec 10 af+                    . showChar '}')++     instance Read Data where+         readsPrec d input =+               readParen (d > 9)+                (\ inp ->+                 [((D aa ab ac ad ae af) , rest) | ("D" , inp) <- lex inp ,+                  ("{" , inp) <- lex inp , ("name" , inp) <- lex inp ,+                  ("=" , inp) <- lex inp , (aa , inp) <- readsPrec 10 inp ,+                  ("," , inp) <- lex inp , ("constraints" , inp) <- lex inp ,+                  ("=" , inp) <- lex inp , (ab , inp) <- readsPrec 10 inp ,+                  ("," , inp) <- lex inp , ("vars" , inp) <- lex inp ,+                  ("=" , inp) <- lex inp , (ac , inp) <- readsPrec 10 inp ,+                  ("," , inp) <- lex inp , ("body" , inp) <- lex inp ,+                  ("=" , inp) <- lex inp , (ad , inp) <- readsPrec 10 inp ,+                  ("," , inp) <- lex inp , ("derive" , inp) <- lex inp ,+                  ("=" , inp) <- lex inp , (ae , inp) <- readsPrec 10 inp ,+                  ("," , inp) <- lex inp , ("statement" , inp) <- lex inp ,+                  ("=" , inp) <- lex inp , (af , inp) <- readsPrec 10 inp ,+                  ("}" , rest) <- lex inp])+                input++     --  Imported from other files :-++     instance Read Foo where+         readsPrec d input =+                   (\ inp -> [((Foo) , rest)+                               | ("Foo" , rest) <- lex inp]) input+                   +++                   (\ inp -> [((Bar) , rest)+                               | ("Bar" , rest) <- lex inp]) input+                   +++                   (\ inp -> [((Bub) , rest)+                               | ("Bub" , rest) <- lex inp]) input++     instance NFData Foo where+         rnf (Foo) = ()+         rnf (Bar) = ()+         rnf (Bub) = ()+++File: drift.info,  Node: User Guide,  Next: Standard Rules,  Prev: Introduction,  Up: Top++2 User Guide+************++This chapter assumes that DrIFT has already been installed and the+environment variables set up. The installation is handled in *note+Installation::.++   Briefly, the way DrIFT works is+  1. parse the input file, looking for commands and data & newtype+     statements.++  2. generate code by executing the commands, which apply rules to+     types.++  3. if any commands remain unexecuted, this means the types aren't+     declared in this module, so DrIFT searches for them in imported+     modules.++  4. append the generated code to the bottom of the file (overwriting+     any previously generated code)++   Rules can be applied to any types defined using a `data' or+`newtype' statement. Rules can't be applied to types defined using+`type', as this only produces a synonym for a type. *Don't try to use+rules on type synonyms.*++* Menu:++* Command Line::+* Command Syntax::+* Emacs DrIFT mode::+++File: drift.info,  Node: Command Line,  Next: Command Syntax,  Prev: User Guide,  Up: User Guide++2.1 The Command Line+====================++DrIFT processes standard Haskell scripts (suffix `.hs') and literate+scripts (suffix `.lhs').  Currently, only literate code using `>' is+accepted: DrIFT doesn't understand the TeX style of literate+programming using `\begin{code}'.++   If you've compiled up an executable from the source code (or are+using Runhugs) to run DrIFT over a file type :-++   `DrIFT FILENAME'++   Alternatively, for Hugs, use :-++   `runhugs DrIFT FILENAME' (run DrIFT over filename)+++File: drift.info,  Node: Command Syntax,  Next: Emacs DrIFT mode,  Prev: Command Line,  Up: User Guide++2.2 Command Syntax+==================++Commands to DrIFT are entered into Haskell code in the form of+_annotations_. DrIFT's annotations start with `{-!' and finish with+`!-}'. (This is so they don't clash with the compiler annotations given+to GHC or HBC).  There are three forms of command.++   * *Stand-Alone Command* (syntax : `{-! for TYPE derive :+     RULE1,RULE2,... !-}') This is the basic form of DrIFT command.  It+     asks DrIFT to apply the listed rules to the specified type.  If+     the type is parameterised, e.g. `Maybe a', just enter the type+     name into the command, omitting any type variables.  DrIFT assumes+     that types given are currently in scope, and will first search the+     current module.  If it fails to find a matching type definition,+     the prelude and any imported modules are also searched.  This is+     the only command which allows code to be generated for a type+     defined in another module.++   * *Abbreviated Command* (syntax : `{-! derive :RULE1,RULE2,... !-}')+     This command is appended to the end of a `data' or `newtype'+     definition, after the deriving clause, if present.  It applies the+     listed rules to the type it is attached to.++   * *Global Command* (syntax : `{-! global :RULE1,RULE2,... !-}' This+     command applies the listed rules to all types defined within the+     module.  Note that this command doesn't cause code to be generated+     for types imported from other modules.++   For an example of these commands in use, *Note An Example::.++2.2.1 Notes on Using Commands+-----------------------------++   * The stand-alone and global commands should be entered on a line by+     themselves, starting in the first column, (as with other top-level+     declarations, such as `infix', `import',`newtype').  It doesn't+     matter what position they occur within the module.++   * In a literate file, all commands should be entered on a `code'+     line (one starting with `>').++   * Commands may be commented out by using `--' and `{- .. -}' in the+     usual way.++   * If two commands apply the same rule to a type, then two sets of+     identical code will be produced.  This will cause a `multiple+     definition' error when the processed module is+     compiled/interpreted.  *Don't do it!*+++File: drift.info,  Node: Emacs DrIFT mode,  Prev: Command Syntax,  Up: User Guide++2.3 Emacs DrIFT mode+====================++For Emacs fans, Hans W Loidl <hwloidl@dcs.gla.ac.uk> has written a+script which allows DrIFT to be run within a buffer.++   The commands available are+   * `M-x hwl-derive', `C-c d d' runs DrIFT over the current buffer,+     and then updates the buffer.++   * `M-x hwl-derive-insert-standalone', `C-c d s' inserts a template+     for a standalone command into the current buffer at the cursor+     position.++   * `M-x hwl-derive-insert-local', `C-c d l' inserts a template for an+     abbreviated command.++   * `M-x hwl-derive-insert-global', `C-c d g' inserts a template for a+     global command+   In `hugs-mode' these functions are also available vie a menu item in+the hugs menu.+++File: drift.info,  Node: Standard Rules,  Next: User-Defined Rules,  Prev: User Guide,  Up: Top++3 Standard Rules+****************++Heres a listing of the rules that come pre-defined with DrIFT.  If you+want a more detailed idea of how they work, their definitions are in the+file `StandardRules.hs', and are (fairly) well documented.  In the+following list the *highlighted* text is the name of the rule, as used+in commands. The naming convention for rules is names starting with a+capital generate an instance for the class of the same name.  Sets of+functions are generated by a name beginning with a lower case letter.++3.1 Prelude Classes+===================++The classes *Eq*, *Ord*, *Enum*, *Show*, *Read* & *Bounded* are+described in the Haskell report as being derivable; DrIFT provides+rules for all these.++3.2 Other Classes+=================++Originally, *NFData* (for Normal Form evaluation strategies) was the+only other class to have a rule.  But now, there are rules for many+more classes from 3rd-party libraries, e.g.  *XmlContent* from HaXml,+*Binary* from nhc98, *Term* from Strafunski, *FunctorM* for Generics,+*Observable* for HOOD debugging, *Typeable* for dynamics, and so on.+For a full list, use the `--list' command-line option.++3.3 Utilities+=============++   * *un* attempts to make newtypes a little nicer to use by providing+     an untagging function.  This rule can only be used on types defined+     using `newtype'.++          For a type `newtype Foo a = F a',++          *un* produces the function `unFoo :: Foo a -> a'.++   * *is* produces predicates that indicate the presence of a+     constructor.  This is only useful for multi-constructor datatypes+     (obviously).++          For a type `data Foo = Bar | Bub', *is* generates++          `isBar :: Foo -> Bool' and `isBub :: Foo -> Bool'.++   * *has* produces predicates that indicate the presence of a label.+     This can only be used with types where at least one of the+     constructors is a labelled record.  Note that labels can be shared+     between constructors of the same type.++          For a type `data Foo a = F{bar :: a,bub :: Int}' *has*+          generates++          `hasbar :: Foo a-> Bool' and `hasbub :: Foo a -> Bool'.++   * *update* produces functions that update fields within a record+     type.  This rule can only be used with a type where at least on of+     the constructors is a labelled record.++          For a type `data Foo a = F{bar :: a, bub ::Int}' *update*+          generates++          `bar_u :: (a -> a) -> Foo a -> Foo a' and++          `bub_u :: (Int -> Int) -> Foo a -> Foo a' which apply a+          function to a field of a record, and then return the updated+          record. If the value does not have the given field then the+          value is returned unchanged.++          `bar_s :: a -> Foo a -> Foo a' and `bub_s ::Int -> Foo a ->+          Foo a' are also generated, and are  used to set the value of+          a field in a record.++   * *test* dumps the parsed representation of a datatype to the+     output.  This is be useful for debugging new rules, as the user+     can see what information is stored about a particular type.++++File: drift.info,  Node: User-Defined Rules,  Next: Installation,  Prev: Standard Rules,  Up: Top++4 Rolling Your Own+******************++Programmers who only wish to use the pre-defined rules in DrIFT don't+need to read or understand the following section.  However, as well as+using the supplied rules, users are encouraged to add their own.  There+is a stub module `UserRules.hs' in the source, to which rules can be+added.++   If a compiled version of DrIFT is being used, the program will then+have to be recompiled before the new rules can be used.  However, if the+Runhugs standalone interpreter is used, this is not necessary.  Due to+the way Runhugs searches for modules to load, a user may have many+copies of the UserRules module. The UserRules module in the current+directory will be loaded first.  If that is not present, then the+`HUGSPATH' environment variable is searched for the module.  So it is+possible to have a default UserRules module, and specialised ones for+particular projects.++* Menu:++* The Basic Idea::+* How is a Type Represented?::+* Pretty Printing  ::+* Utilities::+* Adding a new rule::+++File: drift.info,  Node: The Basic Idea,  Next: How is a Type Represented?,  Prev: User-Defined Rules,  Up: User-Defined Rules++4.1 The Basic Idea+==================++A rule is a tuple containing a string and a function. The string is the+name of the rule, and is used in commands in an input file. The+function maps between the abstract representation of a datatype and text+to be output (A sort of un-parser, if you like). The best way to+understand this is to have a look at the existing rules in+`StandardRules.hs'.  This module is quite well documented.+++File: drift.info,  Node: How is a Type Represented?,  Next: Pretty Printing,  Prev: The Basic Idea,  Up: User-Defined Rules++4.2 How is a Type Represented?+==============================++A type is represented within DrIFT using the following data definition.+     >data Statement = DataStmt | NewTypeStmt deriving (Eq,Show)++     >data Data = D {        name :: Name,           -- type name+     >                       constraints :: [(Class,Var)],+     >                       vars :: [Var],          -- Parameters+     >                       body :: [Body],+     >                       derives :: [Class],     -- derived classes+     >                       statement :: Statement}+     >          | Directive+     >          | TypeName Name deriving (Eq,Show)++     >type Name = String+     >type Var = String+     >type Class = String++   A `Data' type represents one parsed `data' or `newtype' statement.+These are held in a `D' constructor record (the `Directive' and+`TypeName' constructors are just used internally by DrIFT).  We'll now+examine each of the fields in turn.++   * `name' holds the name of the new datatype as a string.++   * `constraints' list the type constraints for the type variables of+     the new type. e.g. for `data (Eq a) => Foo a = F a', the value of+     `constraints' would be `[("Eq","a")]'.++   * `vars' contains a list of the type variables in the type.  For the+     previous example, this would simply be `["a"]' .++   * `body' is a list of the constructors of the type, and the+     information associated with them.  We'll come back to this in a+     moment.++   * `derives' lists the classes that the type an instance of though+     using the `deriving' clause.++   * `statement' indicates whether the type was declared using a+     `newtype' or `data' statement++4.2.1 The Body+--------------++     >data Body = Body { constructor :: Constructor,+     >                   labels :: [Name],+     >                   types :: [Type]} deriving (Eq,Show)++     >type Constructor = String++   The body type holds information about one of the constructors of a+type.  `constructor' is self-explanatory.  `labels' holds the names of+labels of a record.  This will be blank if the constructor isn't a+record.  `types' contains a representation of the type of each value+within the constructor.  The definition of `Type' is as follows.++     >data Type      = Arrow Type Type -- fn+     >               | Apply Type Type -- application+     >               | Var String      -- variable+     >               | Con String      -- constructor+     >               | Tuple [Type]    -- tuple+     >               | List Type	  -- list+     >			deriving (Eq,Show)+   Few of the deriving rules supplied have actually needed to use this+type information, which I found quite surprising.  If you do find you+need to use it, one example is the Haskell2Xml rule.+++File: drift.info,  Node: Pretty Printing,  Next: Utilities,  Prev: How is a Type Represented?,  Up: User-Defined Rules++4.3 Pretty Printing+===================++Instead of producing a string as output, rules produce a value of type+`Doc'.  This type is defined in the Pretty Printing Library implemented+by Simon Peyton-Jones.  The pretty printer ensures that the code is+formatted for readability, and also handles problems such as+indentation.  Constructing output using pretty printing combinators is+easier and more structured than manipulating strings too. For those+unfamiliar with these combinators, have a look at the module+`Pretty.lhs' and the web page `http://www.cse.ogi.edu/~simonpj/' or for+more detail the paper `The Design of a Pretty Printing Library, J.+Hughes'+++File: drift.info,  Node: Utilities,  Next: Adding a new rule,  Prev: Pretty Printing,  Up: User-Defined Rules++4.4 Utilities+=============++Upon the pretty printing library, DrIFT defines some more formatting+functions which make regularly occurring structures of code easier to+write. These structures include simple instances, blocks of code,+lists, etc.  The utilities are in the module `RuleUtils.hs' and should+be self explanatory.+++File: drift.info,  Node: Adding a new rule,  Prev: Utilities,  Up: User-Defined Rules++4.5 Adding a new rule+=====================++A rule has type `type Rule = (String,Data -> Doc)'.  Once you have+written your mapping function and chosen an appropriate name for the+rule, add this tuple to the list `userRules :: [Rule]' in module+`UserRules.hs'. Recompile if necessary.  DrIFT will then call this rule+when its name occurs in a command in an input file.+++File: drift.info,  Node: Installation,  Next: Bugs,  Prev: User-Defined Rules,  Up: Top++5 Installation+**************++DrIFT isn't a large or complicated application, so it shouldn't be too+hard for anyone to get it up and running.  For the platform you want to+install for, read the corresponding section below, then see *note+Environment Variables::++* Menu:++* GHC::+* Hugs::+* Runhugs::+* Environment Variables::+* Installing the Emacs DrIFT Mode::+++File: drift.info,  Node: GHC,  Next: Hugs,  Prev: Installation,  Up: Installation++5.1 GHC+=======++the automake script should automatically detect any ghc or nhc+installation and use that to build and install DrIFT.  First run+`./configure' . To compile, type `make all'.   The executable produced+`DrIFT' can then be installed with `make install'.+++File: drift.info,  Node: Hugs,  Next: Runhugs,  Prev: GHC,  Up: Installation++5.2 Hugs+========++The DrIFT code comes as a set of Haskell modules.  You want to copy all+these to somewhere in your `HUGSPATH', then you can load and run DrIFT+in any directory.+++File: drift.info,  Node: Runhugs,  Next: Environment Variables,  Prev: Hugs,  Up: Installation++5.3 Runhugs+===========++Edit the first line of the the file `DrIFT' to point to your copy of+`runhugs'.  Copy `DrIFT' to somewhere on your `PATH', and the remainder+of the source (`*.hs',`*.lhs') to a directory in your `HUGSPATH'+++File: drift.info,  Node: Environment Variables,  Next: Installing the Emacs DrIFT Mode,  Prev: Runhugs,  Up: Installation++5.4 Environment Variables+=========================++In you environment set `DERIVEPATH' to the list of directories you wish+derive to search for modules / interfaces.++   `DERIVEPATH' is quite fussy about the format the list should take :-++   * each path should be separated by ':'++   * no space inserted anywhere++   * no final '/' on the end of a path++   For instance++   good - `/users/nww/share/hugs/lib:/users/nww/share/hugs/lib/hugs'++   bad - `/users/nww/share/hugs/lib/: /users/nww/share/hugs/lib/hugs/'+++File: drift.info,  Node: Installing the Emacs DrIFT Mode,  Prev: Environment Variables,  Up: Installation++5.5 Installing the Emacs DrIFT Mode+===================================++Edit `derive.el' so that the variable `hwl-derive-cmd' contains your+copy of the DrIFT executable.  Place `derive.el' into a directory on+your `load-path', byte-compile it and put the following command into+your `.emacs' file:++   `(load "derive")'+++File: drift.info,  Node: Bugs,  Prev: Installation,  Up: Top++6 Bugs and Shortcomings+***********************++   * DrIFT doesn't check for commands applying the same rule to a type.++   * No support for TeX-style literate code.+++++Tag Table:+Node: Top220+Node: Introduction541+Node: What does DrIFT do?1355+Node: Features1879+Node: Motivation4392+Node: An Example6314+Node: Source Code6872+Node: After processing with DrIFT7693+Node: User Guide12794+Node: Command Line13817+Node: Command Syntax14423+Node: Emacs DrIFT mode16814+Node: Standard Rules17630+Node: User-Defined Rules20819+Node: The Basic Idea21945+Node: How is a Type Represented?22507+Node: Pretty Printing25404+Node: Utilities26187+Node: Adding a new rule26627+Node: Installation27087+Node: GHC27544+Node: Hugs27897+Node: Runhugs28158+Node: Environment Variables28488+Node: Installing the Emacs DrIFT Mode29130+Node: Bugs29562++End Tag Table

@@ -0,0 +1,824 @@+\input texinfo   @c -*-texinfo-*-++@include version.texi++@c 1. Header+++@setfilename drift.info+@settitle DrIFT User Guide++@c 2. Summary Description and Copyright+@ifinfo++@dircategory Haskell Tools+@direntry+* DrIFT: (drift). A type sensitive preprocessor for Haskell 98.+@end direntry++@end ifinfo++@c 3. Title and Copyright+@titlepage+@title DrIFT User Guide+@subtitle version @value{VERSION}+@subtitle @value{UPDATED}+@author Noel Winstanley+@author @email{nww@@dcs.gla.ac.uk}+@author John Meacham+@author @email{john@@foo.net}+@end titlepage++@c 4. `Top' Node and Master Menu+@ifinfo+@node  Top, Introduction, (dir), (dir)+@top DrIFT++DrIFT is a type-sensitive preprocessor for Haskell.  It is used to+automatically generate code for new defined types.+@end ifinfo++@menu+* Introduction::+* User Guide::+* Standard Rules::+* User-Defined Rules::+* Installation::+* Bugs::+@end menu++@c 5. Body+@node Introduction, User Guide, Top, Top+@chapter Introduction+This is a guide to using DrIFT, a type sensitive+preprocessor for Haskell 98.++DrIFT is a tool which parses a Haskell module for structures (data & newtype+declarations) and commands.  These commands cause rules to be fired on the+parsed data, generating new code which is then appended to the bottom of the+input file, or redirected to another. These rules are expressed as Haskell+code, and it is intended that the user can add new rules as required.++DrIFT is written in pure Haskell 98, however code it generates is free to make+use of extensions when appropriate. DrIFT is currently tested against hugs and ghc.++@menu+* What does DrIFT do?::+* Features::+* Motivation::+* An Example::+@end menu++@node What does DrIFT do?, Features, Introduction, Introduction+@section So, What Does DrIFT do?++DrIFT allows derivation of instances for+classes that aren't supported by the standard compilers. In addition,+instances can be produced in separate modules to that containing the+type declaration.  This allows instances to be derived for a type after+the original module has been compiled.  As a bonus, simple utility+functions can also be produced for types.++@node Features, Motivation, What does DrIFT do?, Introduction+@section Features+@itemize @bullet++@item+DrIFT comes with a set of rules to produce instances for all derivable+classes given in the Prelude.  There's a rule to produce+instances of NFData (the original motivation of all this), and rules for+utility functions on types also. The DrIFT implementation is also regularly+updated with rules submitted by users.++@c @item+@c To find the definition of a type, DrIFT can search through imported+@c modules and the prelude.  In addition to literate and non-literate+@c scripts, derive is able to extract information from+@c interface files generated by the GHC compiler (prior to 5.04).++@item+Code is generated using pretty-printing combinators.  This means that+the output is (fairly) well formatted, and easy on the human eye.++@item+Effort has been made to make the rule interface as easy to use as+possible.  This is to allow users to add rules to generate code specific+to their own projects.  As the rules are written in Haskell themselves,+the user doesn't have to learn a new language syntax, and can use all+Haskell's features.+@end itemize++Currently supported derivations are the following. This list is obtainable by+running @code{DrIFT -l}.++@verbatim++Binary:+   Binary            efficient binary encoding of terms+   GhcBinary         byte sized binary encoding of terms+Debugging:+   Observable        HOOD observable+General:+   NFData            provides 'rnf' to reduce to normal form (deepSeq)+   Typeable          derive Typeable for Dynamic+Generics:+   FunctorM          derive reasonable fmapM implementation+   HFoldable         Strafunski hfoldr+   Monoid            derive reasonable Data.Monoid implementation+   RMapM             derive reasonable rmapM implementation+   Term              Strafunski representation via Dynamic+Prelude:+   Bounded+   Enum+   Eq+   Ord+   Read+   Show+Representation:+   ATermConvertible  encode terms in the ATerm format+   Haskell2Xml       encode terms as XML (HaXml<=1.13)+   XmlContent        encode terms as XML (HaXml>=1.14)+Utility:+   Parse             parse values back from standard 'Show'+   Query             provide a QueryFoo class with 'is', 'has',+                       'from', and 'get' routines+   from              provides fromFoo for each constructor+   get               for label 'foo' provide foo_g to get it+   has               hasfoo for record types+   is                provides isFoo for each constructor+   test              output raw data for testing+   un                provides unFoo for unary constructors+   update            for label 'foo' provides 'foo_u' to update it+                       and foo_s to set it++@end verbatim++@node Motivation, An Example, Features, Introduction+@section Why Do We Need DrIFT?++The original motivation for DrIFT came from reading one of the Glasgow+Parallel Haskell papers on Strategies.  Strategies require producing+instances of a class which reduces to normal form (called NFData). It+was commented that it was a shame that instances of NFData couldn't be+automatically derived; the rules to generate the instances are+simple, and adding instances by hand is  tiresome.  Many classes' instances+follow simple patterns.  This is what+makes coding up instances so tedious: there's no thought involved!++The idea to extend DrIFT to work on imported types came from+a discussion of the Haskell mailing list, arising from a point made by+Olaf Chitil :++@quotation+Why is the automatic derivation of instances for some standard classes+linked to data and newtype declarations?+It happened already several times to me that I needed a standard+instance of a data type that I imported from a module that did not+provide that instance and which I did not want to change (a library;+GHC, which I mainly want to extend by further modules, not spread+changes over 250 modules).+When declaring a new data type one normally avoids deriving (currently)+unneeded instances, because it costs program code (and maybe one even+wants to enable the user of the module to define his own instances).+@end quotation++The third feature of DrIFT, providing utility functions to manipulate new+types, especially records was caused by finding oneself writing the same sort+of code over and over again.  These functions couldn't be captured in a class,+but have a similar form for each type they are defined on.  A thread on the+Haskell mailing list made a related point: untagging and manipulating newtypes+was more cumbersome than it should be.++@node An Example,  , Motivation, Introduction+@section An Example+Here's an example of what how DrIFT is used.  This Haskell module+contains commands to the DrIFT preprocessor.  These are annotated with+@code{@{-!  ... !-@}}.  After processing with DrIFT the generated code+is glued on the bottom of the file, beneath a marker indicating where+the new code starts.  The machine generated code is quite long, and+would really have been a drudge to type in by hand.++@menu+* Source Code::+* After processing with DrIFT::+@end menu++@node Source Code, After processing with DrIFT, An Example, An Example+@subsection Source Code+@example+-- example script for DrIFT++module Example where+import Foo+@{-!for Foo derive :  Read,NFData !-@} -- apply rules to imported type++@{-! global : is !-@} -- global to this module+@{-!for Data derive : update,Show,Read!-@} -- stand alone comand syntax++@{-!for Maybe derive : NFData !-@} -- apply rules to prelude type++data Data = D @{name :: Name,+			constraints :: [(Class,Var)],+			vars :: [Var],+			body :: [(Constructor,[(Name,Type)])],+			derive :: [Class],+			statement :: Statement@}++data Statement = DataStmt | NewTypeStmt+        deriving Eq @{-!derive : Ord,Show,Read !-@} -- abbreviated syntax+@end example++@node After processing with DrIFT,  , Source Code, An Example+@subsection After processing with DrIFT+@example+module Example where+import Foo+@{-!for Foo derive : Read,NFData !-@} -- apply rules to imported type++@{-! global : is !-@} -- global to this module+@{-!for Data derive : update,Show,Read!-@} -- stand alone comand syntax++@{-!for Maybe derive : NFData !-@} -- apply rules to prelude type++data Data = D @{name :: Name,+                        constraints :: [(Class,Var)],+                        vars :: [Var],+                        body :: [(Constructor,[(Name,Type)])],+                        derive :: [Class],+                        statement :: Statement@}++data Statement = DataStmt | NewTypeStmt+        deriving Eq @{-!derive : Ord,Show,Read !-@}++@{-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-@}+isD (D aa ab ac ad ae af) = True+isD _ = False++instance Ord Statement where+    compare DataStmt (DataStmt) = EQ+    compare DataStmt (NewTypeStmt) = LT+    compare NewTypeStmt (DataStmt) = GT+    compare NewTypeStmt (NewTypeStmt) = EQ++instance Show Statement where+    showsPrec d (DataStmt) = showString "DataStmt"+    showsPrec d (NewTypeStmt) = showString "NewTypeStmt"++instance Read Statement where+    readsPrec d input =+              (\ inp -> [((DataStmt) , rest)+                          | ("DataStmt" , rest) <- lex inp])+              input+              +++              (\ inp ->+               [((NewTypeStmt) , rest)+                  | ("NewTypeStmt" , rest) <- lex inp])+              input++isDataStmt (DataStmt) = True+isDataStmt _ = False+isNewTypeStmt (NewTypeStmt) = True+isNewTypeStmt _ = False++instance (NFData a) => NFData (Maybe a) where+    rnf (Just aa) = rnf aa+    rnf (Nothing) = ()++body_u f r@@D@{body@} = r@{body = f body@}+constraints_u f r@@D@{constraints@} = r@{constraints = f constraints@}+derive_u f r@@D@{derive@} = r@{derive = f derive@}+name_u f r@@D@{name@} = r@{name = f name@}+statement_u f r@@D@{statement@} = r@{statement = f statement@}+vars_u f r@@D@{vars@} = r@{vars = f vars@}+body_s v =  body_u  (const v)+constraints_s v =  constraints_u  (const v)+derive_s v =  derive_u  (const v)+name_s v =  name_u  (const v)+statement_s v =  statement_u  (const v)+vars_s v =  vars_u  (const v)++instance Show Data where+    showsPrec d (D aa ab ac ad ae af) = showParen (d >= 10)+              (showString "D" . showChar '@{' .+               showString "name" . showChar '=' . showsPrec 10 aa+               . showChar ',' .+               showString "constraints" . showChar '=' . showsPrec 10 ab+               . showChar ',' .+               showString "vars" . showChar '=' . showsPrec 10 ac+               . showChar ',' .+               showString "body" . showChar '=' . showsPrec 10 ad+               . showChar ',' .+               showString "derive" . showChar '=' . showsPrec 10 ae+               . showChar ',' .+               showString "statement" . showChar '=' . showsPrec 10 af+               . showChar '@}')++instance Read Data where+    readsPrec d input =+          readParen (d > 9)+           (\ inp ->+            [((D aa ab ac ad ae af) , rest) | ("D" , inp) <- lex inp ,+             ("@{" , inp) <- lex inp , ("name" , inp) <- lex inp ,+             ("=" , inp) <- lex inp , (aa , inp) <- readsPrec 10 inp ,+             ("," , inp) <- lex inp , ("constraints" , inp) <- lex inp ,+             ("=" , inp) <- lex inp , (ab , inp) <- readsPrec 10 inp ,+             ("," , inp) <- lex inp , ("vars" , inp) <- lex inp ,+             ("=" , inp) <- lex inp , (ac , inp) <- readsPrec 10 inp ,+             ("," , inp) <- lex inp , ("body" , inp) <- lex inp ,+             ("=" , inp) <- lex inp , (ad , inp) <- readsPrec 10 inp ,+             ("," , inp) <- lex inp , ("derive" , inp) <- lex inp ,+             ("=" , inp) <- lex inp , (ae , inp) <- readsPrec 10 inp ,+             ("," , inp) <- lex inp , ("statement" , inp) <- lex inp ,+             ("=" , inp) <- lex inp , (af , inp) <- readsPrec 10 inp ,+             ("@}" , rest) <- lex inp])+           input++--  Imported from other files :-++instance Read Foo where+    readsPrec d input =+              (\ inp -> [((Foo) , rest)+                          | ("Foo" , rest) <- lex inp]) input+              +++              (\ inp -> [((Bar) , rest)+                          | ("Bar" , rest) <- lex inp]) input+              +++              (\ inp -> [((Bub) , rest)+                          | ("Bub" , rest) <- lex inp]) input++instance NFData Foo where+    rnf (Foo) = ()+    rnf (Bar) = ()+    rnf (Bub) = ()++@end example++@node User Guide, Standard Rules, Introduction, Top+@chapter User Guide+This chapter assumes that DrIFT has already been installed and the+environment variables set up. The installation is handled+in @ref{Installation}.++Briefly, the way DrIFT works is+@enumerate+@item+parse the input file, looking for commands and data & newtype statements.+@item+generate code by executing the commands, which apply rules to types.+@item+if any commands remain unexecuted, this means the types aren't declared in+this module, so DrIFT searches for them in imported modules.+@item+append the generated code to the bottom of the file (overwriting any+previously generated code)+@end enumerate++Rules can be applied to any types defined using a @code{data} or+@code{newtype} statement. Rules can't be applied to types defined using+@code{type}, as this only produces a synonym for a type. @strong{Don't+try to use rules on type synonyms.}++@menu+* Command Line::+* Command Syntax::+* Emacs DrIFT mode::+@end menu++@node Command Line, Command Syntax, User Guide, User Guide+@section The Command Line+DrIFT processes standard Haskell scripts (suffix @file{.hs}) and+literate scripts (suffix @file{.lhs}).  Currently, only literate code+using @code{>} is accepted: DrIFT doesn't understand the @TeX{} style+of literate programming using @code{\begin@{code@}}.++If you've compiled up an executable from the source code (or are using+Runhugs) to run DrIFT over a file type :-++@code{DrIFT @var{filename}}++Alternatively, for Hugs, use :-++@code{runhugs DrIFT @var{filename}} (run DrIFT over filename)++@node Command Syntax, Emacs DrIFT mode, Command Line, User Guide+@section Command Syntax+Commands to DrIFT are entered into Haskell code in the form of+@emph{annotations}. DrIFT's annotations start with @code{@{-!} and finish+with @code{!-@}}. (This is so they don't clash with the compiler annotations+given to GHC or HBC).  There are three forms of command.++@itemize @bullet++@item+@strong{Stand--Alone Command}+(syntax : @code{@{-! for @var{type} derive :+@var{rule1},@var{rule2},@dots{} !-@}})+This is the basic form of DrIFT command.  It asks DrIFT to apply the+listed rules to the specified type.  If the type is parameterised,+e.g. @code{Maybe a}, just enter the type name into the command, omitting+any type variables.  DrIFT assumes that types given are currently in+scope, and will first search the current module.  If it fails to find a+matching type definition, the prelude and any imported modules are also+searched.  This is the only command which allows code to be generated+for a type defined in another module.++@item+@strong{Abbreviated Command}+(syntax : @code{@{-! derive :@var{rule1},@var{rule2},@dots{} !-@}})+This command is appended to the end of a @code{data} or @code{newtype}+definition, after the deriving clause, if present.  It applies the listed+rules to the type it is attached to.++@item+@strong{Global Command}+(syntax : @code{@{-! global :@var{rule1},@var{rule2},@dots{} !-@}}+This command applies the listed rules+to all types defined within the module.  Note that this command doesn't+cause code to be generated for types imported from other modules.+@end itemize++For an example of these commands in use, @xref{An Example}.++@subsection Notes on Using Commands+@itemize @bullet++@item+The stand-alone and global commands should be entered on a line by+themselves, starting in the first column, (as with other top-level+declarations, such as @code{infix}, @code{import},@code{newtype}).  It+doesn't matter what position they occur within the module.++@item+In a+literate file, all commands should be entered on a `code' line (one+starting with @code{>}).++@item+Commands may be commented out by using+@code{--} and @code{@{- .. -@}} in the usual way.++@item+If two commands apply the same rule to a type, then two sets of+identical code+will be produced.  This will cause a `multiple definition' error when+the processed module is compiled/interpreted.  @strong{Don't do it!}+@end itemize++@node Emacs DrIFT mode,  , Command Syntax, User Guide+@section Emacs DrIFT mode+For Emacs fans, Hans W Loidl+@email{hwloidl@@dcs.gla.ac.uk}+has written a script which allows DrIFT to be run within a buffer.++The commands available are+@itemize @bullet++@item+@code{M-x hwl-derive}, @code{C-c d d} runs DrIFT over the current+buffer, and then updates the buffer.++@item+@code{M-x hwl-derive-insert-standalone}, @code{C-c d s} inserts a+template for a standalone command into the current buffer at the+cursor position.++@item+@code{M-x hwl-derive-insert-local}, @code{C-c d l} inserts a template+for an abbreviated command.++@item+@code{M-x hwl-derive-insert-global}, @code{C-c d g} inserts a template+for a global command+@end itemize+In `hugs-mode' these functions are also available vie a menu item in the+hugs menu.++@node Standard Rules, User-Defined Rules, User Guide, Top+@chapter Standard Rules+Heres a listing of the rules that come pre-defined with DrIFT.  If you+want a more detailed idea of how they work, their definitions are in the+file @file{StandardRules.hs}, and are (fairly) well documented.  In the+following list the @strong{highlighted} text is the name of the rule,+as used in commands. The naming convention for rules is names+starting with a capital generate an instance for the class of the same+name.  Sets of functions are generated by a name beginning with a lower+case letter.++@section Prelude Classes+The classes @strong{Eq}, @strong{Ord}, @strong{Enum}, @strong{Show},+@strong{Read} & @strong{Bounded} are described in the+Haskell report as being derivable; DrIFT provides rules for all+these.+@section Other Classes+Originally, @strong{NFData} (for Normal Form evaluation strategies)+was the only other class to have a rule.  But now, there are rules for+many more classes from 3rd-party libraries, e.g.  @strong{XmlContent}+from HaXml, @strong{Binary} from nhc98, @strong{Term} from Strafunski,+@strong{FunctorM} for Generics, @strong{Observable} for HOOD debugging,+@strong{Typeable} for dynamics, and so on.  For a full list, use the+@code{--list} command-line option.++@section Utilities+@itemize @bullet++@item+@strong{un} attempts to make newtypes a little nicer to use by providing+an untagging function.  This rule can only be used on types defined+using @code{newtype}.++@quotation+For a type @code{newtype Foo a = F a},++@strong{un} produces the function @code{unFoo :: Foo a -> a}.+@end quotation++@item+@strong{is} produces predicates that indicate the presence of a+constructor.  This is only useful for multi-constructor datatypes+(obviously).++@quotation+For a type @code{data Foo = Bar | Bub}, @strong{is} generates++@code{isBar :: Foo -> Bool} and @code{isBub :: Foo -> Bool}.+@end quotation++@item+@strong{has} produces predicates that indicate the presence of a label.+This can only be used with types where at least one of the constructors+is a labelled record.  Note that labels can be shared between+constructors of the same type.++@quotation+For a type @code{data Foo a = F@{bar :: a,bub :: Int@}}+@strong{has} generates++@code{hasbar :: Foo a-> Bool} and @code{hasbub :: Foo a -> Bool}.+@end quotation++@item+@strong{update} produces functions that update fields within a+record type.  This rule can only be used with a type where at least on+of the constructors is a labelled record.++@quotation+For a type @code{data Foo a = F@{bar :: a, bub ::Int@}} @strong{update}+generates++@code{bar_u :: (a -> a) -> Foo a -> Foo a} and++@code{bub_u :: (Int -> Int) ->+Foo a -> Foo a} which apply a function to a field of a record, and then return+the updated record. If the value does not have the given field then the value+is returned unchanged.++@code{bar_s :: a -> Foo a ->+Foo a} and @code{bub_s ::Int -> Foo a -> Foo a} are also+generated, and are  used to set the value of a field in a record.+@end quotation++@item+@strong{test} dumps the parsed representation of a datatype to the+output.  This is be useful for debugging new rules, as the user can see+what information is stored about a particular type.++@end itemize+++@node User-Defined Rules, Installation, Standard Rules, Top+@chapter Rolling Your Own+Programmers who only wish to use the pre-defined rules in DrIFT don't need to+read or understand the following section.  However,+as well as using the supplied rules, users are encouraged to add their+own.  There is a stub module @file{UserRules.hs} in the source, to+which rules can be added.++If a compiled version of DrIFT is being used, the program will then+have to be recompiled before the new rules can be used.  However, if the+Runhugs standalone interpreter is used, this is not necessary.  Due to+the way Runhugs searches for modules to load, a user may have many+copies of the UserRules module. The UserRules module in the current+directory will be loaded first.  If that is not present, then the+@code{HUGSPATH} environment variable is searched for the module.  So it is+possible to have a default UserRules module, and specialised ones for+particular projects.++@menu+* The Basic Idea::+* How is a Type Represented?::+* Pretty Printing  ::+* Utilities::+* Adding a new rule::+@end menu++@node The Basic Idea, How is a Type Represented?, User-Defined Rules, User-Defined Rules+@section The Basic Idea++A rule is a tuple containing a string and a function. The string is the+name of the rule, and is used in commands in an input file. The+function maps between the abstract representation of a datatype and text+to be output (A sort of un-parser, if you like). The best way to+understand this is to have a look at the existing rules in+@file{StandardRules.hs}.  This module is quite well documented.++@node How is a Type Represented?, Pretty Printing  , The Basic Idea, User-Defined Rules+@section How is a Type Represented?+A type is represented within DrIFT using the following data+definition.+@example+>data Statement = DataStmt | NewTypeStmt deriving (Eq,Show)++>data Data = D @{        name :: Name,           -- type name+>                       constraints :: [(Class,Var)],+>                       vars :: [Var],          -- Parameters+>                       body :: [Body],+>                       derives :: [Class],     -- derived classes+>                       statement :: Statement@}+>          | Directive+>          | TypeName Name deriving (Eq,Show)++>type Name = String+>type Var = String+>type Class = String+@end example++A @code{Data} type represents one parsed @code{data} or @code{newtype}+statement.  These are held in a @code{D} constructor record (the+@code{Directive} and @code{TypeName} constructors are just used internally by+DrIFT).  We'll now examine each of the fields in turn.++@itemize @bullet++@item+@code{name} holds the name of the new datatype as a string.++@item+@code{constraints} list the type constraints for the type variables of+the new type. e.g. for @code{data (Eq a) => Foo a = F a}, the value of+@code{constraints} would be @code{[("Eq","a")]}.++@item+@code{vars} contains a list of the type variables in the type.  For the+previous example, this would simply be @code{["a"]} .++@item+@code{body} is a list of the constructors of the type, and the+information associated with them.  We'll come back to this in a moment.++@item+@code{derives} lists the classes that the type an instance of though+using the @code{deriving} clause.++@item+@code{statement} indicates whether the type was declared using a+@code{newtype} or @code{data} statement+@end itemize++@subsection The Body+@example+>data Body = Body @{ constructor :: Constructor,+>                   labels :: [Name],+>                   types :: [Type]@} deriving (Eq,Show)++>type Constructor = String+@end example++The body type holds information about one of the constructors of a type.+@code{constructor} is self-explanatory.  @code{labels} holds the names+of labels of a record.  This will be blank if the constructor isn't a+record.  @code{types} contains a representation of the type of each+value within the constructor.  The definition of @code{Type} is as+follows.++@example+>data Type      = Arrow Type Type -- fn+>               | Apply Type Type -- application+>               | Var String      -- variable+>               | Con String      -- constructor+>               | Tuple [Type]    -- tuple+>               | List Type	  -- list+>			deriving (Eq,Show)+@end example+Few of the deriving rules supplied have actually needed to use this type+information, which I found quite surprising.  If you do find you need to+use it, one example is the Haskell2Xml rule.++@node Pretty Printing  , Utilities, How is a Type Represented?, User-Defined Rules+@section Pretty Printing++Instead of producing a string as output, rules produce a value of type+@code{Doc}.  This type is defined in the Pretty Printing Library implemented+by Simon Peyton-Jones.  The pretty printer ensures that the code is+formatted for readability, and also handles problems such as+indentation.  Constructing output using pretty printing combinators is+easier and more structured than manipulating strings too. For those+unfamiliar with these combinators, have a look at the module+@file{Pretty.lhs} and the web page @url{http://www.cse.ogi.edu/~simonpj/}+or for more detail the paper @cite{The Design of a Pretty Printing+Library, J. Hughes}++@node Utilities, Adding a new rule, Pretty Printing  , User-Defined Rules+@section Utilities+Upon the pretty printing library, DrIFT defines some more formatting+functions which make regularly occurring structures of code easier to+write. These structures include simple instances, blocks of code,+lists, etc.  The utilities are in the module @file{RuleUtils.hs} and+should be self explanatory.++@node Adding a new rule,  , Utilities, User-Defined Rules+@section Adding a new rule+A rule has type @code{type Rule = (String,Data -> Doc)}.  Once you have+written your mapping function and chosen an appropriate name for the+rule, add this tuple to the list @code{userRules :: [Rule]}+in module @file{UserRules.hs}. Recompile if necessary.  DrIFT will then call this rule when+its name occurs in a command in an input file.+++@node Installation, Bugs, User-Defined Rules, Top+@chapter Installation+DrIFT isn't a large or complicated application, so it+shouldn't be too hard for anyone to get it up and running.  For the+platform you want to install for, read the corresponding section below,+then see @ref{Environment Variables}++@menu+* GHC::+* Hugs::+* Runhugs::+* Environment Variables::+* Installing the Emacs DrIFT Mode::+@end menu++@node GHC, Hugs, Installation, Installation+@section GHC+the automake script should automatically detect any ghc or nhc installation and+use that to build and install DrIFT.  First run @code{./configure} . To+compile, type @code{make all}.   The executable produced @file{DrIFT} can then+be installed with @code{make install}.+++@node Hugs, Runhugs, GHC, Installation+@section Hugs+The DrIFT code comes as a set of Haskell modules.  You want to copy all+these to somewhere in your @code{HUGSPATH}, then you can load and run+DrIFT in any directory.++@node Runhugs, Environment Variables, Hugs, Installation+@section Runhugs+Edit the first line of the the file @file{DrIFT} to point to your copy+of @code{runhugs}.  Copy @file{DrIFT} to somewhere on your @code{PATH}, and+the remainder of the source (@file{*.hs},@file{*.lhs}) to a directory in your @code{HUGSPATH}++@node Environment Variables, Installing the Emacs DrIFT Mode , Runhugs, Installation+@section Environment Variables+In you environment set @code{DERIVEPATH} to the list of directories you+wish derive to search for modules / interfaces.++@code{DERIVEPATH} is quite fussy about the format the list should take :-++@itemize @bullet++@item+each path should be separated by ':'++@item+no space inserted anywhere++@item+no final '/' on the end of a path+@end itemize++For instance++good - @code{/users/nww/share/hugs/lib:/users/nww/share/hugs/lib/hugs}++bad - @code{/users/nww/share/hugs/lib/: /users/nww/share/hugs/lib/hugs/}++++@node Installing the Emacs DrIFT Mode, , Environment Variables, Installation+@section Installing the Emacs DrIFT Mode++Edit @file{derive.el} so that the variable @code{hwl-derive-cmd} contains your+copy of the DrIFT executable.+Place @file{derive.el} into a directory on your @code{load-path}, byte-compile it and put the following command into your @file{.emacs} file:++@code{(load "derive")}+++@node Bugs,  , Installation, Top+@chapter Bugs and Shortcomings+@itemize @bullet++@item+DrIFT doesn't check for commands applying the same rule to a+type.+@item+No support for @TeX{}-style literate code.+++@end itemize++@contents++@bye

@@ -0,0 +1,29 @@+import Data.List (isInfixOf)+import System.Cmd (rawSystem)+import System.Environment (getArgs)+import System.Exit (ExitCode(ExitSuccess))+import Paths_DrIFT_cabalized  (getBinDir)++main :: IO ExitCode+main = do args <- getArgs+          case args of+            (a:b:c:[]) -> conditional a b c+            _ -> error "This is a driver script allowing DrIFT to be used seamlessly with ghc.\n \+                       \ in order to use it, pass '-pgmF drift-ghc -F' to ghc when compiling your programs."++conditional ::  FilePath -> FilePath -> FilePath -> IO ExitCode+conditional orgnl inf outf = do prefix <- getBinDir+                                infile <- readFile inf+                                if "{-!" `isInfixOf` infile then do putStrLn (prefix ++ "DriFT-cabalized " +++                                                                              inf ++ " -o " ++ outf)+                                                                    rawSystem inf ["-o", outf]+                                 else do writeFile outf ("{-# LINE 1 \"" ++ orgnl ++ " #-}")+                                         readFile inf >>= appendFile outf+                                         return ExitSuccess+{- GHC docs say: "-pgmF cmd+   Use cmd as the pre-processor (with -F only).+Use -pgmF cmd  to select the program to use as the preprocessor.+When invoked, the cmd pre-processor is given at least three arguments on its command-line:+1. the first argument is the name of the original source file,+2. the second is the name of the file holding the input+3. third is the name of the file where cmd should write its output to." -}

@@ -0,0 +1,11 @@+module Example where++import Binary++data MyType a = ConsA Int (U (Int,[a]))+              | ConsB String --a+              | Red+              | Blue Int String {-(MyType a)-} [Int]+              {-!derive : Binary !-}++

@@ -0,0 +1,4 @@+import Binary++data BTree k d = BTree Int [(k,[d])] [BTree k d]+           {-! derive : Binary !-}

@@ -0,0 +1,42 @@+{- example script for derive -}++module Example where+import Foo++{-! global : has,is !-} -- global to this module+{-!for Data derive : update,Show,Read!-} -- stand alone comand syntax +{-!for Foo derive : test, Show,Read !-} -- apply rules to imported type+{-!for Maybe derive : test !-} -- apply rules to prelude type++data Data = D {	name :: Name,		+			constraints :: [(Class,Var)], +			vars :: [Var],	+			body :: [(Constructor,[(Name,Type)])],+			derive :: [Class],+			statement :: Statement}+	   | FnType {	name :: Name,+			constraints :: [(Class,Var)],+			fntype :: Type}+	   | Fn	{	name :: Name,+			vars :: [Var]}	+	   | Directive+		 {-!derive : test!-} -- abbreviated syntax+{-!for Statement derive : Eq,Ord,Enum,Show,Read,Bounded !-}+{-!for Type derive : Eq,Ord,Enum,Bounded,Read !-}+data Statement = DataStmt | NewTypeStmt+type Name = String+type Var = String+type Class = String+type Constructor = String++data Type	= Arrow Type Type -- fn+		| Apply Type Type -- application+		| Var String	  -- variable+		| Con String      -- constructor / type e.g. Int, Char+		| Tuple [Type]	  -- tuple+		| List Type	  -- list+			 deriving Show++data (Eq a) => G a b = F (a->b) b | H a a {-!derive: test !-}+newtype Q = Q Int {-!derive:test!-}+

@@ -0,0 +1,6 @@+>module Foo where+++>data Foo = Foo  | Bar | Bub++

@@ -0,0 +1,8 @@+Run derive over Example.hs to test everything is working properly.+Compare with Example.output.++Try some other example data structures in +  Artifical.hs+  BTree.hs+  Foo.lhs+  Xref.hs

@@ -0,0 +1,8 @@+module TestTerm where++import TermRep+{-! global : Term !-}++data SortA = SortA1 SortB | SortA2+data SortB = SortB Integer SortA+

@@ -0,0 +1,23 @@+{- Generated by DrIFT (Automatic class derivations for Haskell) -}+module TestTerm where++import TermRep+{-! global : Term !-}++data SortA = SortA1 SortB | SortA2+data SortB = SortB Integer SortA++{-* Generated by DrIFT : Look, but Don't Touch. *-}+instance Term SortA where+    explode (x::SortA) = TermRep (toDyn x, f x, g x) where+	f (SortA1 aa) = [explode aa]+	f SortA2 = []+	g (SortA1 _) xs = case TermRep.fArgs xs of [aa] -> toDyn ((SortA1 (TermRep.fDyn aa))::SortA)+	g SortA2 xs = case TermRep.fArgs xs of [] -> toDyn ((SortA2)::SortA)++instance Term SortB where+    explode (x::SortB) = TermRep (toDyn x, f x, g x) where+	f (SortB aa ab) = [explode aa,explode ab]+	g (SortB _ _) xs = case TermRep.fArgs xs of [aa,ab] -> toDyn ((SortB (TermRep.fDyn aa) (TermRep.fDyn ab))::SortB)++--  Imported from other files :-

@@ -0,0 +1,6 @@+import Binary++data Index a = Empty+             | Branch (Index a) string [a] (Index a)+             {-!derive : Binary!-}+

@@ -0,0 +1,157 @@+-- Based on DrIFT 1.0 by Noel Winstanley+--  hacked for Haskell 98 by Malcolm Wallace, University of York, Feb 1999.+--  modified by various people, now maintained by John Meacham+module Main(main) where++import ChaseImports+import DataP+import GenUtil+import GetOpt+import Char+import IO hiding(try)+import List (partition,isSuffixOf,sort, groupBy, sortBy)+import Monad(unless)+import PreludData(preludeData)+import Pretty+import RuleUtils (commentLine,texts)+import RuleUtils(Rule,Tag)+import Version+import qualified Rules(rules)+import qualified System++data Op = OpList | OpDerive | OpVersion++data Env = Env {+    envVerbose :: Bool,+    envOutput :: (Maybe String),+    envOperation :: Op,+    envNoline :: Bool,+    envArgs :: [(String,String)],+    envResultsOnly :: Bool,+    envGlobalRules :: [Tag],+    envIgnoreDirectives :: Bool+    }+++env = Env {+    envVerbose = False,+    envOutput = Nothing,+    envOperation = OpDerive,+    envNoline = False,+    envArgs = [],+    envResultsOnly = False,+    envIgnoreDirectives = False,+    envGlobalRules = []+    }+++getOutput e = maybe (return stdout) (\fn -> openFile fn WriteMode) (envOutput e)++options :: [OptDescr (Env -> Env)]+options =+    [ Option ['v'] ["verbose"] (NoArg (\e->e{envVerbose = True}))       "chatty output on stderr"+    , Option ['V'] ["version"] (NoArg (\e->e{envOperation = OpVersion}))       "show version number"+    , Option ['l'] ["list"] (NoArg (\e->e{envOperation = OpList}))       "list available derivations"+    , Option ['L'] ["noline"] (NoArg (\e->e{envNoline = True}))    "omit line pragmas from output"+    , Option ['o'] ["output"]  (ReqArg (\x e->e{envOutput = (Just x)}) "FILE")  "output FILE"+    , Option ['s'] ["set"]    (ReqArg setArg "name:value")  "set argument to value"+    , Option ['r'] ["resultsonly"] (NoArg (\e->e{envResultsOnly = True}))  "output only results, do not include source file"+    , Option ['g'] ["global"]  (ReqArg addGlobalRule "rule") "addition rules to apply globally"+    , Option ['i'] ["ignore"]  (NoArg (\e->e{envIgnoreDirectives = True})) "ignore directives in file. useful with -g"+    ]++setArg x e = e {envArgs = (n, tail rest):(envArgs e)} where+    (n,rest) = span (/= ':') x+addGlobalRule x e = e {envGlobalRules = x:(envGlobalRules e)}+++categorize :: Ord c => [(c,a)] -> [(c,[a])]+categorize xs = map f $ groupBy fstEq $ sortBy fstOrd xs where+    f ys = (fst (head ys),snds ys)+    fstEq (a,_) (b,_) = a == b+    fstOrd (a,_) (b,_) = compare a b++doList = do+    let rn = categorize [(c,(n,h)) | (n,_,c,h,_) <- Rules.rules]+    putStrLn $ unlines $ buildTableLL $ concat [ (c ++ ":","") : (map (\(a,b) -> ("   " ++ a, b)) $ sort xs)| (c,xs)<- rn]+++header = "Usage: DrIFT [OPTION...] file"+main = do+    argv <- System.getArgs+    (env,n) <- case (getOpt Permute options argv) of+	(as,n,[]) -> return (foldr ($) env as ,n)+	(_,_,errs) -> putErrDie (concat errs ++ usageInfo header options)+    case env of+	Env { envOperation = OpList } -> doList+	Env { envOperation = OpVersion} -> putStr ("Version " ++ fullName ++ "\n")+	_ -> case n of+	    [n] -> derive env n+	    _ -> putErrDie ("single input file must be specified.\n" ++ usageInfo header options)++++derive env fname = do+    let findent xs = f (lines xs) where+            f (x:xs) = let (w,n) = span isSpace x in case n of+                (c:_) | isAlpha c -> length w+                _ -> f xs+            f [] = 0+    file <- readFile fname+    let (body,_) = userCode file+        b = ".lhs" `isSuffixOf` fname+        zz = fromLit b body+        ss = if b then replicate (findent zz) ' ' else ""+    handle <- getOutput env+    hPutStr handle $ ss ++ "{- Generated by " ++ package ++ " (Automatic class derivations for Haskell) -}\n"+    unless (envNoline env) $ hPutStr handle $ ss ++ "{-# LINE 1 \""  ++ fname ++ "\" #-}\n"+    let (docs,dats,todo) = process . addGlobals env  . parser $ zz+    moreDocs <- fmap ((\(x,_,_) -> x) . process) (chaseImports body todo)+    let result = (\r -> codeSeperator ++ '\n':r) .  render . vsep $ (docs ++ sepDoc:moreDocs)+    if (envResultsOnly env) then hPutStr handle result else do+        hPutStr handle zz+        hPutStr handle $ unlines . map (ss ++) . lines $ result++    hFlush handle+++addGlobals env tds    =  (envGlobalRules env,Directive):concatMap f tds where+    f x | not (envIgnoreDirectives env) = [x]+    f (_,Directive)  = []+    f (_,TypeName _)  = []+    f (_,d) = [([],d)]+++rules = map (\(a,b,_,_,_) -> (a,b)) Rules.rules+-- codeRender doc = fullRender PageMode 80 1 doc "" -- now obsolete+vsep = vcat . map ($$ (text ""))+sepDoc = commentLine . text $ " Imported from other files :-"++backup :: FilePath -> FilePath+backup f = (reverse . dropWhile (/= '.') . reverse ) f ++ "bak"++newfile :: FilePath -> FilePath+newfile f = (reverse . dropWhile (/= '.') . reverse ) f ++ "DrIFT"++-- Main Pass - Takes parsed data and rules and combines to create instances...+-- Returns all parsed data, ande commands calling for files to be imported if+-- datatypes aren't located in this module.++process :: ToDo -> ([Doc],[Data],ToDo)+process i = (concatMap g dats ++ concatMap h moreDats,parsedData,imports)+       where+	g (tags,d) = [(find t rules) d | t <- (tags ++ directives)]+	h (tags,d) = [(find t rules) d | t <- tags]+	directives = concatMap fst globals+	(dats,commands) = partition (isData . snd) i+	(globals,fors) = partition (\(_,d) -> d == Directive) commands+	(moreDats,imports) = resolve parsedData fors ([],[])+	parsedData = map snd dats ++ preludeData++find :: Tag -> [Rule] -> (Data -> Doc)+find t r = case filter ((==t) . fst) $ r of+               [] -> const (commentLine warning)+               (x:xs) -> snd x+   where+   warning = hsep . texts $ ["Warning : Rule",t,"not found."]+