diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC.hs b/cabal-plugin/src/Distribution/Simple/UUAGC.hs deleted file mode 100644 --- a/cabal-plugin/src/Distribution/Simple/UUAGC.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Distribution.Simple.UUAGC(uuagcUserHook - ,uuagcUserHook' - ,uuagc) where - -import Distribution.Simple.UUAGC.UUAGC - diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC/AbsSyn.hs b/cabal-plugin/src/Distribution/Simple/UUAGC/AbsSyn.hs deleted file mode 100644 --- a/cabal-plugin/src/Distribution/Simple/UUAGC/AbsSyn.hs +++ /dev/null @@ -1,160 +0,0 @@ -module Distribution.Simple.UUAGC.AbsSyn where - -import Distribution.Simple.UUAGC.Options -import System.FilePath(normalise) - -data AGFileOption = AGFileOption {filename :: String, - fileClasses :: [String], - opts :: UUAGCOptions} - deriving (Show, Eq) - -data AGOptionsClass = AGOptionsClass {className :: String, opts' :: UUAGCOptions} - deriving (Show, Read, Eq) - -type AGFileOptions = [AGFileOption] - -data UUAGCOption = UModuleDefault - | UModule String - | UData - | UStrictData - | UStrictWData - | UCatas - | USemFuns - | USignatures - | UNewTypes - | UPretty - | UWrappers - | URename - | UModCopy - | UNest - | USyntaxMacro - | UOutput FilePath - | UVerbose - | UHelp -- ? - | UAll - | USearchPath FilePath - | UPrefix String - | USelf - | UCycle - | UVersion -- ? - | UVisit - | USeq - | UUnbox -- UUnbox - | UBangPats - | UCase - | UStrictCase - | UStricterCase - | ULocalCPS - | USplitSems - | UWErrors - | UWIgnore - | UWMax Int - | UDumpGrammar - | UDumpCGrammar - | UGenTraces - | UGenUseTraces - | UGenCostCentres - | UGenLinePragmas - | USepSemMods - | UGenFileDeps - | UGenVisage - | UGenAspectAG - | UGenAttrList - | UForceIrrefutable FilePath - | UUniqueDispenser String - | ULCKeyWords - | UOptimize - | UDoubleColons - | UHaskellSyntax - | UStatistics FilePath - | UCheckParseRhs - | UCheckParseTys - | UCheckParseBlocks - | UCheckParseHaskell - deriving (Eq, Read, Show) - -type UUAGCOptions = [UUAGCOption] - -defaultUUAGCOptions :: UUAGCOptions -defaultUUAGCOptions = [UData - ,UCatas - ,USemFuns - ,USignatures - ,UPretty - ,UWrappers - ,URename - ,UModuleDefault - ] - -optionTxt = "--" -equalTxt = "=" - -toLOp s = optionTxt ++ s -toLEOpA s a = (toLOp s) ++ equalTxt ++ a - -fromUUAGCOtoArgs :: UUAGCOption -> String -fromUUAGCOtoArgs (UModule s) = toLEOpA omodule s -fromUUAGCOtoArgs UData = toLOp odata -fromUUAGCOtoArgs UStrictData = toLOp ostrictdata -fromUUAGCOtoArgs UStrictWData = toLOp ostrictwrap -fromUUAGCOtoArgs UCatas = toLOp ocatas -fromUUAGCOtoArgs USemFuns = toLOp osemfuns -fromUUAGCOtoArgs USignatures = toLOp osignatures -fromUUAGCOtoArgs UNewTypes = toLOp onewtypes -fromUUAGCOtoArgs UPretty = toLOp opretty -fromUUAGCOtoArgs UWrappers = toLOp owrappers -fromUUAGCOtoArgs URename = toLOp orename -fromUUAGCOtoArgs UModCopy = toLOp omodcopy -fromUUAGCOtoArgs UNest = toLOp onest -fromUUAGCOtoArgs USyntaxMacro = toLOp osyntaxmacro -fromUUAGCOtoArgs (UOutput fp) = toLEOpA ooutput fp -fromUUAGCOtoArgs UVerbose = toLOp overbose -fromUUAGCOtoArgs (USearchPath fp) = toLEOpA "" fp -fromUUAGCOtoArgs (UPrefix p) = toLEOpA oprefix p -fromUUAGCOtoArgs USelf = toLOp oself -fromUUAGCOtoArgs UCycle = toLOp ocycle -fromUUAGCOtoArgs UVersion = toLOp oversion -fromUUAGCOtoArgs UVisit = toLOp ovisit -fromUUAGCOtoArgs USeq = toLOp oseq -fromUUAGCOtoArgs UUnbox = toLOp ounbox -fromUUAGCOtoArgs UBangPats = toLOp obangpats -fromUUAGCOtoArgs UCase = toLOp ocase -fromUUAGCOtoArgs UStrictCase = toLOp ostrictcase -fromUUAGCOtoArgs UStricterCase = toLOp ostrictercase -fromUUAGCOtoArgs ULocalCPS = toLOp olocalcps -fromUUAGCOtoArgs USplitSems = toLOp osplitsems -fromUUAGCOtoArgs UWErrors = toLOp owerrors -fromUUAGCOtoArgs UWIgnore = toLOp owignore -fromUUAGCOtoArgs (UWMax i) = toLEOpA owmax (show i) -fromUUAGCOtoArgs UDumpGrammar = toLOp odumpgrammar -fromUUAGCOtoArgs UDumpCGrammar = toLOp odumpcgrammar -fromUUAGCOtoArgs UGenTraces = toLOp ogentraces -fromUUAGCOtoArgs UGenUseTraces = toLOp ogenusetraces -fromUUAGCOtoArgs UGenCostCentres = toLOp ogencostcentres -fromUUAGCOtoArgs UGenLinePragmas = toLOp ogenlinepragmas -fromUUAGCOtoArgs USepSemMods = toLOp osepsemmods -fromUUAGCOtoArgs UGenFileDeps = toLOp ogenfiledeps -fromUUAGCOtoArgs UGenVisage = toLOp ogenvisage -fromUUAGCOtoArgs UGenAspectAG = toLOp ogenaspectag -fromUUAGCOtoArgs UGenAttrList = toLOp ogenattrlist -fromUUAGCOtoArgs (UForceIrrefutable fp) = toLEOpA oforceirrefutable fp -fromUUAGCOtoArgs (UUniqueDispenser nm) = toLEOpA ouniquedispenser nm -fromUUAGCOtoArgs UOptimize = toLOp ooptimize -fromUUAGCOtoArgs UModuleDefault = toLOp omodule -fromUUAGCOtoArgs UHaskellSyntax = toLOp ohaskellsyntax -fromUUAGCOtoArgs UDoubleColons = toLOp odoublecolons -fromUUAGCOtoArgs ULCKeyWords = toLOp olckeywords -fromUUAGCOtoArgs (UStatistics fp) = toLEOpA ostatistics fp -fromUUAGCOtoArgs UCheckParseRhs = toLOp ocheckparserhs -fromUUAGCOtoArgs UCheckParseTys = toLOp ocheckparsetys -fromUUAGCOtoArgs UCheckParseBlocks = toLOp ocheckparseblocks -fromUUAGCOtoArgs UCheckParseHaskell = toLOp ocheckparsehaskell - -fromUUAGCOstoArgs :: UUAGCOptions -> [String] -fromUUAGCOstoArgs = map fromUUAGCOtoArgs - -lookupFileOptions :: FilePath -> AGFileOptions -> UUAGCOptions -lookupFileOptions s = foldl f defaultUUAGCOptions - where f e (AGFileOption s' classes opt) - | s == (normalise s') = opt - | otherwise = e diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC/Options.hs b/cabal-plugin/src/Distribution/Simple/UUAGC/Options.hs deleted file mode 100644 --- a/cabal-plugin/src/Distribution/Simple/UUAGC/Options.hs +++ /dev/null @@ -1,59 +0,0 @@ -module Distribution.Simple.UUAGC.Options where - -odata = "data" -ostrictdata = "strictdata" -ostrictwrap = "strictwrap" -ocatas = "catas" -osemfuns = "semfuns" -osignatures = "signatures" -onewtypes = "newtypes" -opretty = "pretty" -owrappers = "wrappers" -orename = "rename" -omodcopy = "modcopy" -onest = "nest" -osyntaxmacro = "syntaxmacro" -overbose = "verbose" -ohelp = "help" -oself = "self" -ocycle = "cycle" -oversion = "version" -ovisit = "visit" -oseq = "seq" -ounbox = "unbox" -obangpats = "bangpats" -ocase = "case" -ostrictcase = "strictcase" -ostrictercase = "strictercase" -olocalcps = "localcps" -osplitsems = "splitsems" -owerrors = "Werrors" -owignore = "Wignore" -owmax = "Wmax" -odumpgrammar = "dumpgrammar" -odumpcgrammar = "dumpcgrammar" -ogentraces = "gentraces" -ogenusetraces = "genusetraces" -ogencostcentres = "gencostcentres" -ogenlinepragmas = "genlinepragmas" -osepsemmods = "sepsemmods" -ogenfiledeps = "genfiledeps" -ogenvisage = "genvisage" -ogenaspectag = "genAspectAG" -ogenattrlist = "genattrlist" -oforceirrefutable = "forceirrefutable" -ouniquedispenser = "uniquedispenser" -olckeywords = "lckeywords" -ooptimize = "optimize" -odoublecolons = "doublecolons" -ohaskellsyntax = "haskellsyntax" -oall = "all" -omodule = "module" -ooutput = "output" -osearch = "path" -oprefix = "prefix" -ostatistics = "statistics" -ocheckparserhs = "checkParseRhs" -ocheckparsetys = "checkParseTys" -ocheckparseblocks = "checkParseBlocks" -ocheckparsehaskell = "checkParseHaskell" diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC/Parser.hs b/cabal-plugin/src/Distribution/Simple/UUAGC/Parser.hs deleted file mode 100644 --- a/cabal-plugin/src/Distribution/Simple/UUAGC/Parser.hs +++ /dev/null @@ -1,209 +0,0 @@ -{-# OPTIONS_GHC -XScopedTypeVariables #-} -module Distribution.Simple.UUAGC.Parser(parserAG, - parserAG', - scanner, - parseIOAction, - parseClassAG, - parseOptionAG) where - -import UU.Parsing -import UU.Scanner -import Distribution.Simple.UUAGC.AbsSyn -import Distribution.Simple.UUAGC.Options -import System.IO.Unsafe(unsafeInterleaveIO) -import System.IO(hPutStr,stderr) -import Control.Monad.Error - -data (Show a) => ParserError a = ParserError a - | DefParserError String - deriving (Show, Eq, Read) - -instance Error (ParserError a) where - strMsg x = DefParserError x - --- import Control.Exception - -uFlags = [odata, ostrictdata, ostrictwrap, ocatas, osemfuns, osignatures - ,onewtypes, opretty - ,owrappers, orename, omodcopy, onest, osyntaxmacro, overbose - ,ohelp, ocycle, oversion, ovisit, oseq, ounbox, obangpats - ,ocase, ostrictcase, ostrictercase, olocalcps, osplitsems - ,owerrors, owignore, odumpgrammar, odumpcgrammar, ogentraces - ,ogenusetraces, ogencostcentres, ogenlinepragmas, osepsemmods - ,ogenfiledeps, ogenvisage, ogenaspectag, ogenattrlist, olckeywords - ,odoublecolons, oself - ,ocheckparserhs,ocheckparsetys,ocheckparseblocks,ocheckparsehaskell] - -uabsFlags = [UData, UStrictData, UStrictWData, UCatas, USemFuns, USignatures - ,UNewTypes, UPretty - ,UWrappers, URename, UModCopy, UNest, USyntaxMacro, UVerbose - ,UHelp, UCycle, UVersion, UVisit, USeq, UUnbox, UBangPats - ,UCase, UStrictCase, UStricterCase, ULocalCPS, USplitSems - ,UWErrors, UWIgnore, UDumpGrammar, UDumpCGrammar, UGenTraces - ,UGenUseTraces, UGenCostCentres, UGenLinePragmas, USepSemMods - ,UGenFileDeps, UGenVisage, UGenAspectAG, UGenAttrList, ULCKeyWords - ,UDoubleColons, USelf - ,UCheckParseRhs, UCheckParseTys, UCheckParseBlocks, UCheckParseHaskell] - -gFlags = [(oall, [odata, ocatas, osemfuns, osignatures, opretty, orename]) - ,(ooptimize, [ovisit,ocase]) - ,(ohaskellsyntax, [olckeywords, odoublecolons,ogenlinepragmas]) - ] - -gabsFlags = [UAll, UOptimize, UHaskellSyntax] - - -aFlags = [omodule, ooutput, osearch, oprefix, owmax, oforceirrefutable, ouniquedispenser, ostatistics] - -ugFlags = uFlags ++ (map (fst) gFlags) - -ugabsFlags = uabsFlags ++ gabsFlags - -kwtxt = uFlags ++ (map fst gFlags) ++ aFlags ++ ["file", "options", "class", "with"] -kwotxt = ["=",":","..","."] -sctxt = "..," -octxt = "=:.," - -posTxt :: Pos -posTxt = Pos 0 0 "" - -puFlag :: UUAGCOption -> String -> Parser Token UUAGCOption -puFlag opt sopt = opt <$ pKey sopt - - -pugFlags :: [Parser Token UUAGCOption] -pugFlags = zipWith puFlag ugabsFlags ugFlags - -pModule :: Parser Token UUAGCOption -pModule = UModuleDefault <$ pKey omodule - <|> UModule <$> (pKey omodule *> pString) - -pOutput :: Parser Token UUAGCOption -pOutput = UOutput <$> (pKey ooutput *> pString) - -pSearch :: Parser Token UUAGCOption -pSearch = USearchPath <$> (pKey osearch *> pString) - -pPrefix :: Parser Token UUAGCOption -pPrefix = UPrefix <$> (pKey oprefix *> pString) - -pWmax :: Parser Token UUAGCOption -pWmax = f <$> (pKey owmax *> pInteger) - where f x = UWMax (read x) - -pForceIrrefutable :: Parser Token UUAGCOption -pForceIrrefutable = UForceIrrefutable <$> (pKey oforceirrefutable *> pString) - -pUniqueDispenser :: Parser Token UUAGCOption -pUniqueDispenser = UUniqueDispenser <$> (pKey ouniquedispenser *> pString) - -pStatistics :: Parser Token UUAGCOption -pStatistics = UStatistics <$> (pKey ostatistics *> pString) - -pAllFlags = pugFlags ++ [pModule,pOutput,pSearch,pPrefix,pWmax,pForceIrrefutable,pUniqueDispenser,pStatistics] - -pAnyFlag = pAny id pAllFlags - -pSep :: Parser Token String -pSep = pKey ":" <|> pKey "=" - -pFileClasses :: Parser Token [String] -pFileClasses = pKey "with" *> (pCommas pString) - <|> pSucceed [] - -pLiftOptions :: (String -> [UUAGCOption] -> a) -> String -> Parser Token a -pLiftOptions f n = f <$> (pKey n *> pSep *> pString) - <*> (pKey "options" *> pSep *> pCommas pAnyFlag) - -pAGFileOption :: Parser Token AGFileOption -pAGFileOption = AGFileOption <$> (pKey "file" *> pSep *> pString) - <*> pFileClasses - <*> (pKey "options" *> pSep *> pCommas pAnyFlag) - -pAGOptionsClass :: Parser Token AGOptionsClass -pAGOptionsClass = pLiftOptions AGOptionsClass "class" - -pAGFileOptions :: Parser Token AGFileOptions -pAGFileOptions = pList pAGFileOption - -parserAG :: FilePath -> IO AGFileOptions -parserAG fp = do s <- readFile fp - parseIOAction action pAGFileOptions (scanner fp s) - -parserAG' :: FilePath -> IO (Either (ParserError String) AGFileOptions) -parserAG' fp = do s <- readFile fp - let steps = parse pAGFileOptions (scanner fp s) - let (Pair res _, mesg) = evalStepsMessages steps - if null mesg - then return $ Right res - else do let err = foldr (++) [] $ map message2error mesg - return (Left $ ParserError err) - -message2error :: Message Token (Maybe Token) -> String -message2error (Msg e p a) = "Expecting: " ++ (show e) ++ " at " ++ action - where action = case a of - Insert s -> " Inserting: " ++ (show s) - Delete s -> " Deleting: " ++ (show s) - Other s -> s - -liftParse p text = parseIOAction action p (scanner text text) - -parseOptionAG :: String -> IO AGFileOption -parseOptionAG = liftParse pAGFileOption - -parseClassAG :: String -> IO AGOptionsClass -parseClassAG = liftParse pAGOptionsClass - -scanner :: String -> String -> [Token] -scanner fn s = scan kwtxt kwotxt sctxt octxt (Pos 0 0 fn) s - -action :: (Eq s, Show s, Show p) => Message s p -> IO () -action m = hPutStr stderr (show m) - -test :: (Show a) => Parser Token a -> [Token] -> IO () -test p inp = do r <- parseIOAction action p inp - print r - -parseIOAction :: (Symbol s, InputState inp s p) - => (Message s p -> IO ()) - -> AnaParser inp Pair s p a - -> inp - -> IO a -parseIOAction showMessage p inp - = do (Pair v final) <- evalStepsIOAction showMessage (parse p inp) - final `seq` return v -- in order to force the trailing error messages to be printed - -evalStepsIOAction :: (Message s p -> IO ()) - -> Steps b s p - -> IO b -evalStepsIOAction showMessage = evalStepsIOAction' showMessage (-1) - - -evalStepsIOAction' :: (Message s p -> IO ()) - -> Int - -> Steps b s p - -> IO b -evalStepsIOAction' showMessage n (steps :: Steps b s p) = eval n steps - where eval :: Int -> Steps a s p -> IO a - eval 0 steps = return (evalSteps steps) - eval n steps = case steps of - OkVal v rest -> do arg <- unsafeInterleaveIO (eval n rest) - return (v arg) - Ok rest -> eval n rest - Cost _ rest -> eval n rest - StRepair _ msg rest -> do showMessage msg - eval (n-1) rest - Best _ rest _ -> eval n rest - NoMoreSteps v -> return v - - -evalStepsMessages :: (Eq s, Show s, Show p) => Steps a s p -> (a,[Message s p]) -evalStepsMessages steps = case steps of - OkVal v rest -> let (arg, ms) = evalStepsMessages rest - in (v arg, ms) - Ok rest -> evalStepsMessages rest - Cost _ rest -> evalStepsMessages rest - StRepair _ msg rest -> let (v, ms) = evalStepsMessages rest - in (v, msg:ms) - Best _ rest _ -> evalStepsMessages rest - NoMoreSteps v -> (v,[]) diff --git a/cabal-plugin/src/Distribution/Simple/UUAGC/UUAGC.hs b/cabal-plugin/src/Distribution/Simple/UUAGC/UUAGC.hs deleted file mode 100644 --- a/cabal-plugin/src/Distribution/Simple/UUAGC/UUAGC.hs +++ /dev/null @@ -1,275 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Distribution.Simple.UUAGC.UUAGC(uuagcUserHook, - uuagcUserHook', - uuagc - ) where -import Distribution.Simple.BuildPaths (autogenModulesDir) -import Debug.Trace -import Distribution.Simple -import Distribution.Simple.PreProcess -import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.Utils -import Distribution.Simple.Setup -import Distribution.PackageDescription hiding (Flag) -import Distribution.Simple.UUAGC.AbsSyn( AGFileOption(..) - , AGFileOptions - , AGOptionsClass(..) - , UUAGCOption(..) - , UUAGCOptions - , defaultUUAGCOptions - , fromUUAGCOtoArgs - , fromUUAGCOstoArgs - , lookupFileOptions - , fileClasses - ) -import Distribution.Simple.UUAGC.Parser -import Distribution.Verbosity -import System.Process( CreateProcess(..), createProcess, CmdSpec(..) - , StdStream(..), runProcess, waitForProcess - , proc) -import System.Directory(getModificationTime - ,doesFileExist - ,removeFile) -import System.FilePath(pathSeparators, - (), - takeFileName, - normalise, - joinPath, - dropFileName, - addExtension, - dropExtension) - -import System.Exit (ExitCode(..)) -import System.IO( openFile, IOMode(..), - hFileSize, - hSetFileSize, - hClose, - hGetContents, - hFlush, - Handle(..), stderr, hPutStr, hPutStrLn) -import System(exitFailure) -import Control.Exception (throwIO) -import Control.Monad (liftM, when, guard, forM_, forM) -import Control.Arrow ((&&&), second) -import Data.Maybe (maybeToList) -import Data.Either (partitionEithers) -import Data.List (nub) - --- | 'uuagc' returns the name of the uuagc compiler -uuagcn = "uuagc" - --- | 'defUUAGCOptions' returns the default names of the uuagc options -defUUAGCOptions = "uuagc_options" - --- | File used to store de classes defined in the cabal file. -agClassesFile = ".ag_file_options" - --- | The prefix used for the cabal file optionsw -agModule = "x-agmodule" - --- | The prefix used for the cabal file options used for defining classes -agClass = "x-agclass" - -uuagcUserHook :: UserHooks -uuagcUserHook = uuagcUserHook' uuagcn - -uuagcUserHook' :: String -> UserHooks -uuagcUserHook' uuagcPath = hooks where - hooks = simpleUserHooks { hookedPreProcessors = ("ag", ag):("lag",ag):knownSuffixHandlers - , buildHook = uuagcBuildHook uuagcPath - , postBuild = uuagcPostBuild - } - ag = uuagc' uuagcPath - -originalPreBuild = preBuild simpleUserHooks -originalBuildHook = buildHook simpleUserHooks - -processContent :: Handle -> IO [String] -processContent = liftM words . hGetContents - -putErrorInfo :: Handle -> IO () -putErrorInfo h = hGetContents h >>= hPutStr stderr - -addSearch :: String -> [String] -> [String] -addSearch sp fl = let sf = [head pathSeparators] - path = if sp == "" - then '.' : sf - else sp ++ sf - in [normalise (joinPath [sp,f]) | f <- fl] - -throwFailure :: IO () -throwFailure = throwIO $ ExitFailure 1 - --- The tmp build directory really depends on the type of project. --- In the case executables it uses the name of the generated file for --- the output directory. -withBuildTmpDir - :: PackageDescription - -> LocalBuildInfo - -> (FilePath -> IO ()) - -> IO () -withBuildTmpDir pkgDescr lbi f = do -#if MIN_VERSION_Cabal(1,8,0) - withLib pkgDescr $ \ _ -> f $ buildDir lbi -#else - withLib pkgDescr () $ \ _ -> f $ buildDir lbi -#endif - withExe pkgDescr $ \ theExe -> - f $ buildDir lbi exeName theExe exeName theExe ++ "-tmp" - --- Creates the output file given the main preprocessed file and the buildtmp folder -tmpFile :: FilePath -> FilePath -> FilePath -tmpFile buildTmp = (buildTmp ) - . (`addExtension` "hs") - . dropExtension - . takeFileName - --- | 'updateAGFile' search into the uuagc options file for a list of all --- AG Files and theirs file dependencies in order to see if the latters --- are more updated that the formers, and if this is the case to --- update the AG File -updateAGFile :: String - -> PackageDescription - -> LocalBuildInfo - -> (FilePath, String) - -> IO () -updateAGFile uuagcPath pkgDescr lbi (f, sp) = do - fileOpts <- readFileOptions - let opts = case lookup f fileOpts of - Nothing -> [] - Just x -> x - modeOpts = filter isModeOption opts - isModeOption UHaskellSyntax = True - isModeOption ULCKeyWords = True - isModeOption UDoubleColons = True - isModeOption _ = False - (_, Just ppOutput, Just ppError, ph) <- newProcess modeOpts - ec <- waitForProcess ph - case ec of - ExitSuccess -> - do fls <- processContent ppOutput - let flsC = addSearch sp fls - when ((not.null) flsC) $ do - flsmt <- mapM getModificationTime flsC - let maxModified = maximum flsmt - removeTmpFile f = do - exists <- doesFileExist f - when exists $ do - fmt <- getModificationTime f - when (maxModified > fmt) $ removeFile f - withBuildTmpDir pkgDescr lbi $ removeTmpFile . (`tmpFile` f) - (ExitFailure exc) -> - do putErrorInfo ppOutput - putErrorInfo ppError - throwFailure - where newProcess mopts = createProcess $ (proc uuagcPath - (fromUUAGCOstoArgs mopts ++ ["--genfiledeps" - ,"--=" ++ intercalate ":" [sp] - ,f - ] - ) - ) - { std_in = Inherit - , std_out = CreatePipe - , std_err = CreatePipe - } - -getAGFileOptions :: [(String, String)] -> IO AGFileOptions -getAGFileOptions extra = do - usesOptionsFile <- doesFileExist defUUAGCOptions - if usesOptionsFile - then do r <- parserAG' defUUAGCOptions - case r of - Left e -> print e >> exitFailure - Right a -> return a - else mapM (parseOptionAG . snd) - $ filter ((== agModule) . fst) extra - -getAGClasses :: [(String, String)] -> IO [AGOptionsClass] -getAGClasses = mapM (parseClassAG . snd) . filter ((== agClass) . fst) - -writeFileOptions :: [(String, [UUAGCOption])] -> IO () -writeFileOptions opts = do - hClasses <- openFile agClassesFile WriteMode - hPutStr hClasses $ show opts - hFlush hClasses - hClose hClasses - -readFileOptions :: IO [(String, [UUAGCOption])] -readFileOptions = do - hClasses <- openFile agClassesFile ReadMode - sClasses <- hGetContents hClasses - classes <- readIO sClasses :: IO [(String, [UUAGCOption])] - hClose hClasses - return $ classes - -getOptionsFromClass :: [(String, [UUAGCOption])] -> AGFileOption -> ([String], [UUAGCOption]) -getOptionsFromClass classes fOpt = - second (nub . concat . ((opts fOpt):)) - . partitionEithers $ do - fClass <- fileClasses fOpt - case fClass `lookup` classes of - Just x -> return $ Right x - Nothing -> return $ Left $ "Warning: The class " - ++ show fClass - ++ " is not defined." - -uuagcBuildHook - :: String - -> PackageDescription - -> LocalBuildInfo - -> UserHooks - -> BuildFlags - -> IO () -uuagcBuildHook uuagcPath pd lbi uh bf = do - let lib = library pd - exes = executables pd - bis = map libBuildInfo (maybeToList lib) ++ map buildInfo exes - classes <- map (className &&& opts') `fmap` (getAGClasses . customFieldsPD $ pd) - options <- getAGFileOptions (bis >>= customFieldsBI) - fileOptions <- forM options (\ opt -> - let (notFound, opts) = getOptionsFromClass classes $ opt - in do case buildVerbosity bf of - Flag v | v >= verbose -> putStrLn ("options for " ++ filename opt ++ ": " ++ show opts) - _ -> return () - forM_ notFound (hPutStrLn stderr) >> return (normalise . filename $ opt, opts)) - writeFileOptions fileOptions - let agflSP = map (id &&& dropFileName) $ nub $ getAGFileList options - mapM_ (updateAGFile uuagcPath pd lbi) agflSP - originalBuildHook pd lbi uh bf - -uuagcPostBuild _ _ _ _ = do - exists <- doesFileExist agClassesFile - when exists $ removeFile agClassesFile - -getAGFileList :: AGFileOptions -> [FilePath] -getAGFileList = map (normalise . filename) - -uuagc :: BuildInfo -> LocalBuildInfo -> PreProcessor -uuagc = uuagc' uuagcn - -uuagc' :: String - -> BuildInfo - -> LocalBuildInfo - -> PreProcessor -uuagc' uuagcPath build local = - PreProcessor { - platformIndependent = True, - runPreProcessor = mkSimplePreProcessor $ \ inFile outFile verbosity -> - do info verbosity $ concat [inFile, " has been preprocessed into ", outFile] - print $ "processing: " ++ inFile ++ " generating: " ++ outFile --- opts <- getAGFileOptions $ customFieldsBI build - fileOpts <- readFileOptions - let opts = case lookup inFile fileOpts of - Nothing -> [] - Just x -> x - search = dropFileName inFile - options = fromUUAGCOstoArgs opts - ++ ["-P" ++ search, "--output=" ++ outFile, inFile] - (_,_,_,ph) <- createProcess (proc uuagcPath options) - eCode <- waitForProcess ph - case eCode of - ExitSuccess -> return () - ExitFailure _ -> throwFailure - } diff --git a/uuagc-bootstrap.cabal b/uuagc-bootstrap.cabal --- a/uuagc-bootstrap.cabal +++ b/uuagc-bootstrap.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.2 build-type: Simple name: uuagc-bootstrap -version: 0.9.38.6.2 +version: 0.9.38.6.3 license: GPL license-file: LICENSE maintainer: Arie Middelkoop @@ -18,6 +18,7 @@ build-depends: containers >= 0.3, directory >= 1.0.1.1, array >= 0.3.0.1 build-depends: haskell98 >= 1.0.1.1, uulib >= 0.9.12, mtl >= 1.1.1.1 build-depends: haskell-src-exts >= 1.11.1 + build-depends: filepath >= 1.1.0.4 main-is: Ag.hs other-modules: Ag , CommonTypes @@ -72,13 +73,3 @@ , ExecutionPlan2Hs extensions: TypeSynonymInstances, MultiParamTypeClasses hs-source-dirs: src, src-derived - -library - build-depends: base >= 4, base < 5, Cabal >= 1.8.0.6, directory >= 1.0.1.1 - build-depends: process >= 1.0.1.3, uulib >= 0.9.12, filepath >= 1.1.0.4, mtl >= 2.0.1.0 - hs-source-dirs: cabal-plugin/src - exposed-modules: Distribution.Simple.UUAGC - other-modules: Distribution.Simple.UUAGC.UUAGC, - Distribution.Simple.UUAGC.Parser, - Distribution.Simple.UUAGC.AbsSyn, - Distribution.Simple.UUAGC.Options