This patch seems to work. But I haven't done serious testing yet. It passes my own test. The test is in multipleextensiontest and contains the files multiple_extension/ setup.hs ( contains the test preprocessors) src_executable/Multipleextensiontest.1.2.3.a.b module Main where main = do print "start" -- P1 -- P2 -- P3 -- Pa -- Pb -- Pc print "end" multipleextensiontest.cabal The preprocessors 0,1,2,a,b,c (c not used) will each replace -- Px by print "x" and add another print line to get the reversed order of run preprocessors. The diff is made relative to darcs/haskell.org/cabal/cabal-1.1.7 Isaac told me that cabal-install is newer .. You can also get the whole repository with changes here (http://mawercer.de/marcweber/haskell/cabal-1.1.7-my/ ) Greetings Marc diff -rN old-cabal-1.1.7-my/Cabal.cabal new-cabal-1.1.7-my/Cabal.cabal 7c7 < Build-Depends: base ---

Build-Depends: base, mtl diff -rN old-cabal-1.1.7-my/Distribution/PreProcess.hs new-cabal-1.1.7-my/Distribution/PreProcess.hs 64c64 < moduleToFilePath, die, dieWithLocation)

moduleToFilePath, die, dieWithLocation, on)

70c70,71 < import System.Directory (removeFile, getModificationTime) ---

import System.Directory (removeFile, getModificationTime, doesFileExist) import Data.Bits ((.|.)) 73c74,76 < (splitFileExt, joinFileName, joinFileExt)

(splitFileName, splitFilePath, splitFileExt, joinFileName, joinFileExt) import Control.Monad import Debug.Trace 76c79 < -- external program, but need not be. The arguments are the name of

-- /xternal program, but need not be. The arguments are the name of 144,163c147,177 < preprocessModule searchLoc modu verbose builtinSuffixes handlers = do < bsrcFiles <- moduleToFilePath searchLoc modu builtinSuffixes < psrcFiles <- moduleToFilePath searchLoc modu (map fst handlers) < case psrcFiles of < [] -> case bsrcFiles of < [] -> die ("can't find source for " ++ modu ++ " in " ++ show searchLoc) < _ -> return ExitSuccess < (psrcFile:_) -> do < let (srcStem, ext) = splitFileExt psrcFile < pp = fromMaybe (error "Internal error in preProcess module: Just expected") < (lookup ext handlers) < recomp <- case bsrcFiles of < [] -> return True < (bsrcFile:_) -> do < btime <- getModificationTime bsrcFile < ptime <- getModificationTime psrcFile < return (btime < ptime) < if recomp < then pp psrcFile (srcStem `joinFileExt` "hs") verbose < else return ExitSuccess

preprocessModule searchLoc modu verbose builtinSuffixes handlers = let hslhs = zip builtinSuffixes $ repeat (\_ _ _ -> return ExitSuccess) -- .hs,.lhs or .gc using hmake with nhc : do nothing all_handler = hslhs ++ handlers -- use builtin handler first ( you can't override .hs, lhs anyway as target and source filename would be the same, wouldn't it?) preprocess f = let (dir, file) = splitFileName f (fwe, ext) = splitFileExt file in case ext of "" -> case splitFileExt fwe of (_, "") -> return ExitSuccess -- No extension left. do nothing _ -> die $ "no extension found! don't know how to handle this file " ++ f ext -> case lookup ext all_handler of Nothing -> die $ "no handler found for extinsion pant " ++ ext Just pp -> let dest = dir `joinFileName` fwe in do de <- doesFileExist dest recomp <- if de then liftM2 (>) (getModificationTime f) (getModificationTime dest) else return True -- dest file doesn't exist if recomp then pp f dest verbose >>= \exitCode -> case exitCode of ExitSuccess -> return () _ -> fail $ "preprocessor beeing responsible for extension part " ++ ext ++ "failed" else return () -- now do next preprocessing step preprocess dest

in moduleToFilePath searchLoc modu (map fst all_handler) >>= \srcFiles -> case srcFiles of [] -> die $ "!!can't find source for " ++ modu ++ " in " ++ show searchLoc [f] -> -- run preprocessor if necessary preprocess f files -> die $ "muliple fitting source files found for module " ++ modu ++ " files " ++ foldr1 (\a b->a ++ ", " ++ b) files diff -rN old-cabal-1.1.7-my/Distribution/Simple/Utils.hs new-cabal-1.1.7-my/Distribution/Simple/Utils.hs 44a45 on, 58a60 moduleToFilePath2, 89,90c91,93 < import Control.Monad(when, filterM, unless) < import Data.List (nub, unfoldr)

import Control.Monad(when, filterM, unless, liftM) import Data.List (nub, unfoldr, maximumBy, length, isPrefixOf) import Data.Map (union, toList, fromList) 113a117,125 f `on` op = \x y -> f x `op` f y

-- --------------------------------------------------------------------------- List -- spits the list on element element splitBy :: (Eq a) => [a] -> a -> [[a]] splitBy list element = case break (== element) list of (a, []) -> [a] (a, b) -> a:splitBy b element

213a226,249

-- FIXME/TODO: check wether tail contains only known suffixes. Only checks matching filename yet moduleToFilePath2 :: [FilePath] -- ^search locations -> String -- ^Module Name -> [String] -- ^possible suffixes -> IO [(FilePath, FilePath)] moduleToFilePath2 locs mname possibleSuffixes = let mname_parts = splitBy mname '.' -- "Data.List" -> ["Date","List"] m_path = init mname_parts joinPathElements folders = foldr1 joinFileName folders gDC path = catch (getDirectoryContentsWithoutSpecial path) (\_-> return []) maxBy [] = Nothing maxBy l = Just $ maximumBy (\a b -> compare (length a) (length b)) l -- does file match mname? filterFile = ( isPrefixOf ((last mname_parts) ++ ['.'] )) -- filter names beginning with (last mname_parts) ++ ['.'], -- omitting hs/lhs for compatibility (.gc, .chs, ..) -- only use longest filename (thus no intermediate file) filterModule = maxBy . (filter filterFile) foldr_f (loc, files) l = case filterModule files of Nothing -> l Just f -> (loc, f):l in do files <- mapM (\loc -> gDC $ joinPathElements (loc:m_path) ) locs return $ foldr foldr_f [] $ zip locs files

217a254

moduleToFilePath locs mn ps = (liftM (map (uncurry joinFileName))) $ moduleToFilePath2 locs mn ps 219,238c256,280 < moduleToFilePath pref s possibleSuffixes < = filterM doesFileExist $ < concatMap (searchModuleToPossiblePaths s possibleSuffixes) pref < where searchModuleToPossiblePaths :: String -> [String] -> FilePath -> [FilePath] < searchModuleToPossiblePaths s' suffs searchP < = moduleToPossiblePaths searchP s' suffs < < -- |Like 'moduleToFilePath', but return the location and the rest of < -- the path as separate results. < moduleToFilePath2 < :: [FilePath] -- ^search locations < -> String -- ^Module Name < -> [String] -- ^possible suffixes < -> IO [(FilePath, FilePath)] -- ^locations and relative names < moduleToFilePath2 locs mname possibleSuffixes < = filterM exists $ < [(loc, fname `joinFileExt` ext) | loc <- locs, ext <- possibleSuffixes] < where < fname = dotToSep mname < exists (loc, relname) = doesFileExist (loc `joinFileName` relname)

-- moduleToFilePath :: [FilePath] -- ^search locations -- -> String -- ^Module Name -- -> [String] -- ^possible suffixes -- -> IO [FilePath] -- -- moduleToFilePath pref s possibleSuffixes -- = filterM doesFileExist $ -- concatMap (searchModuleToPossiblePaths s possibleSuffixes) pref -- where searchModuleToPossiblePaths :: String -> [String] -> FilePath -> [FilePath] -- searchModuleToPossiblePaths s' suffs searchP -- = moduleToPossiblePaths searchP s' suffs

-- -- |Like 'moduleToFilePath', but return the location and the rest of -- -- the path as separate results. -- moduleToFilePath2 -- :: [FilePath] -- ^search locations -- -> String -- ^Module Name -- -> [String] -- ^possible suffixes -- -> IO [(FilePath, FilePath)] -- ^locations and relative names -- moduleToFilePath2 locs mname possibleSuffixes -- = filterM exists $ -- [(loc, fname `joinFileExt` ext) | loc <- locs, ext <- possibleSuffixes] -- where -- fname = dotToSep mname -- exists (loc, relname) = doesFileExist (loc `joinFileName` relname) diff -rN old-cabal-1.1.7-my/Setup.lhs new-cabal-1.1.7-my/Setup.lhs 1,5d0 < #!/usr/bin/runhaskell < > module Main where < > import Distribution.Simple < > main :: IO () < > main = defaultMain diff -rN old-cabal-1.1.7-my/multiple_extension-test/multiple_extension-test.cabal new-cabal-1.1.7-my/multiple_extension-test/multiple_extension-test.cabal 0a1,12 Name: multipleextensiontest Version: 0.0 License: BSD3 Author: Marc Weber Category: Synopsis: test multiple extensions Build-Depends: haskell98 ,base ,Cabal

Executable: multipleextensiontest hs-source-dirs: src_executable Main-Is: Multipleextensiontest.hs other-modules: Multipleextensiontest diff -rN old-cabal-1.1.7-my/multiple_extension-test/setup.hs new-cabal-1.1.7-my/multiple_extension-test/setup.hs 0a1,56 module Main where import Distribution.Simple import Distribution.Simple.Configure import Distribution.Simple.LocalBuildInfo import Distribution.PreProcess import System import System.Process import System.Exit import Monad

import Char ( isSpace ) -- #ifdef __GLASGOW_HASKELL__ -- #ifndef __HADDOCK__ -- import {-# SOURCE #-} GHC.Unicode ( isSpace ) -- #endif -- import GHC.List ( replicate ) -- import GHC.Base -- #else -- import Data.Char( isSpace ) -- #endif

import Text.ParserCombinators.ReadP

main= do args <- getArgs -- check args to launch ghci when (length args > 0) $ do when ((args!!0) == "ghci") $ do lbi <- getPersistBuildConfig let packageArgs = (concat.concat) [ [" -package ", showPackageId pkg] | pkg <- packageDeps lbi ] system("ghci " ++ packageArgs) exitWith ExitSuccess defaultMainWithHooks $ defaultUserHooks { hookedPreProcessors = hp } where hp = map (testPreprocessor.(:[])) "123abc"

testPreprocessor :: String -> PPSuffixHandler testPreprocessor ext = ( ext, pp) where pp _ _ src dest verb = do print $ " preprocessing file " ++ src ++ " and writing to " ++ dest readFile src >>= \f -> writeFile dest $ unlines . ppFile $ lines f return $ ExitSuccess ppFile :: [ String ] -> [ String ] ppFile =(++ [" print \"preprocessed by "++ ext ++ "\""]) . (map preprocessLine) parseLine :: ReadP (String, String) parseLine = do spaces <- many $ satisfy isSpace string "--" >> (many $ satisfy isSpace) char 'P' ext <- (many1 $ satisfy (not.isSpace)) rest <- many get return $ (spaces, ext) preprocessLine :: String -> String preprocessLine line = let parseResult = (readP_to_S parseLine) $ line in case parseResult of [((spaces, e),_)] -> if ext == e then spaces ++ "print \"" ++ ext ++ "\"" else line _ -> line diff -rN old-cabal-1.1.7-my/multiple_extension-test/src_executable/Multipleextensiontest.hs.1.2.3.a.b new-cabal-1.1.7-my/multiple_extension-test/src_executable/Multipleextensiontest.hs.1.2.3.a.b 0a1,11 module Main where

main = do print "start" -- P1 -- P2 -- P3 -- Pa -- Pb -- Pc print "end"