diff --git a/polyplate/Data/Generics/Polyplate/GenInstances.hs b/polyplate/Data/Generics/Polyplate/GenInstances.hs index 9089347..fc50503 100644 --- a/polyplate/Data/Generics/Polyplate/GenInstances.hs +++ b/polyplate/Data/Generics/Polyplate/GenInstances.hs @@ -18,7 +18,7 @@ with this program. If not, see . module Data.Generics.Polyplate.GenInstances (GenOverlappedOption(..), GenClassOption(..), - genHeader, GenInstance, genInstance, genInstances, + GenInstance, genInstance, genInstances, writeInstances, writeInstancesTo) where import Control.Monad.State @@ -35,18 +35,6 @@ data GenOverlappedOption = GenWithOverlapped | GenWithoutOverlapped data GenClassOption = GenClassPerType | GenOneClass | GenSlowDelegate deriving (Eq) --- | Given the first line of the file (first parameter, which may be a directive --- to GHC with some options), a module name (second parameter), generates a list --- of lines that form the header of the module. You can easily just write a similar --- function yourself if you want more control over the comments. -genHeader :: String -> String -> [String] -genHeader firstLine moduleName - = [firstLine - ,"-- | Instances for Polyplate." - ,"-- This library was automatically generated by Data.Generics.Polyplate.GenInstances" - ,"-- and should NOT be edited directly." - ,"module " ++ moduleName ++ " where"] - -- | A type that represents a generator for instances of a set of types. newtype GenInstance = GenInstance (TypeMapM ()) @@ -189,7 +177,7 @@ instancesFrom genOverlapped genClass@GenOneClass boxes w -- A primitive type: just return it. else [" transformM () _ v = return v"]) ++ ["" - , "instance PolyplateM (" ++ wName ++ ") () () m where" + , "instance Monad m => PolyplateM (" ++ wName ++ ") () () m where" , " transformM () () v = return v" ] ++ if genOverlapped == GenWithoutOverlapped then [] else @@ -272,20 +260,19 @@ genInstances op1 op2 insts liftM concat $ sequence [instancesFrom op1 op2 (justBoxes typeMap) w | DataBox w <- justBoxes typeMap] -- | Generates the instances according to the options and writes it to stdout with --- the header for the given first line and module name. -writeInstances :: GenOverlappedOption -> GenClassOption -> [GenInstance] -> String - -> String -> IO () -writeInstances op1 op2 inst firstLine moduleName +-- the given header. +writeInstances :: GenOverlappedOption -> GenClassOption -> [GenInstance] -> [String] -> IO () +writeInstances op1 op2 inst header = do instLines <- genInstances op1 op2 inst - putStr (unlines (genHeader firstLine moduleName ++ instLines)) + putStr (unlines (header ++ instLines)) -- | Generates the instances according to the options and writes it to a file with --- the header and given module name. -writeInstancesTo :: GenOverlappedOption -> GenClassOption -> [GenInstance] -> String - -> String -> FilePath -> IO () -writeInstancesTo op1 op2 inst firstLine moduleName fileName +-- the given header. +writeInstancesTo :: GenOverlappedOption -> GenClassOption -> [GenInstance] -> [String] + -> FilePath -> IO () +writeInstancesTo op1 op2 inst header fileName = do instLines <- genInstances op1 op2 inst - writeFile fileName (unlines (genHeader firstLine moduleName ++ instLines)) + writeFile fileName (unlines (header ++ instLines)) --{{{ Various SYB-based functions that we don't export, for discovering contained types: diff --git a/pregen/GenNavAST.hs b/pregen/GenNavAST.hs index 76f489c..f8970c0 100644 --- a/pregen/GenNavAST.hs +++ b/pregen/GenNavAST.hs @@ -19,16 +19,9 @@ with this program. If not, see . -- | Utilities for metaprogramming. module GenNavAST where -import Data.Char -import Data.Generics -import Data.List -import qualified Data.Set as Set - import Data.Generics.Polyplate.GenInstances import qualified AST -import PregenUtils -import Utils header :: [String] header @@ -156,6 +149,14 @@ main :: IO () main = writeInstances GenWithoutOverlapped GenOneClass [genInstance (undefined :: AST.AST)] - "{-# OPTIONS_GHC -Werror -fwarn-overlapping-patterns -fwarn-unused-matches -fwarn-unused-binds -fwarn-incomplete-patterns #-}" - "NavAST" + ["{-# OPTIONS_GHC -Werror -fwarn-overlapping-patterns -fwarn-unused-matches -fwarn-unused-binds -fwarn-incomplete-patterns #-}" + ,"-- | This module is auto-generated by Polyplate. DO NOT EDIT." + ,"module NavAST where" + ,"" + ,"import Data.Generics.Polyplate" + ,"" + ,"import qualified AST" + ,"import qualified Metadata" + ,"" + ]