zeroth 2009.6.23.2 → 2009.6.23.3
raw patch · 2 files changed
+178/−1 lines, 2 files
Files
- ppsrc/Language/Haskell/TH/ZeroTH/GetOpt.hs +176/−0
- zeroth.cabal +2/−1
+ ppsrc/Language/Haskell/TH/ZeroTH/GetOpt.hs view
@@ -0,0 +1,176 @@+{-# OPTIONS_GHC+ -Wall -fno-warn-missing-signatures -pgmP cpphs -optP --hashes -optP --cpp + #-}+module Language.Haskell.TH.ZeroTH.GetOpt where+import Control.Applicative ((<$>))+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe)+import Data.Monoid (Any(..), Last(..), Monoid(..))+import Data.Monoid.Record (addP)+import System.Console.GetOpt (ArgDescr(..), OptDescr(..))+import System.Console.GetOpt.Skeleton (mParseArgs)+import System.Console.GetOpt.StandardOpts (StandardFlag, stdOpts)+import System.Directory (findExecutable)+import System.Info (os)+import Distribution.Version (Version(..))+import Language.Haskell.TH.ZeroTH.Config (Config(..))+ +getExecutable :: String -> Maybe FilePath -> IO FilePath+getExecutable _ (Just path) = return path+getExecutable name (Nothing)+ = fromMaybe (error errMsg) <$> findExecutable name+ where errMsg = "Couldn't find: " ++ name+ +mkConfig :: TempFlags -> IO Config+mkConfig tmpFlags+ = do ghcPath' <- getExecutable "ghc" . getLast $+ tempGHCPath tmpFlags+ cpphsPath' <- getExecutable "cpphs" . getLast $+ tempCpphsPath tmpFlags+ return+ Config{ghcPath = ghcPath', cpphsPath = cpphsPath',+ inputFile = fromMaybe "-" . getLast $ tempInputFile tmpFlags,+ outputFile = fromMaybe "-" . getLast $ tempOutputFile tmpFlags,+ ghcArgs = tempGHCArgs tmpFlags `orElse` defaultGhcArgs,+ cpphsArgs = tempCpphsArgs tmpFlags,+ dropImport = tempDropImport tmpFlags `orElse` defaultDrop,+ wholeFile = not . getAny $ tempJustSplices tmpFlags}+ where defaultGhcArgs+ = ["-fno-code", "-o", nullFile, "-ohi", nullFile]+ nullFile+ | "mingw" `isPrefixOf` os = "NUL:"+ | otherwise = "/dev/null"+ defaultDrop = ["Language.Haskell.TH"]+ +orElse :: [] a -> [] a -> [] a+orElse [] theDefault = theDefault+orElse x _ = x+ +data TempFlags = TempFlags{tempGHCPath :: Last FilePath,+ tempInputFile :: Last FilePath, tempOutputFile :: Last FilePath,+ tempCpphsPath :: Last FilePath, tempGHCArgs :: [] String,+ tempCpphsArgs :: [] String, tempDropImport :: [] String,+ tempJustSplices :: Any, tempStdFlag :: Last StandardFlag}+ +instance Monoid TempFlags where+ mempty+ = TempFlags mempty mempty mempty mempty mempty mempty mempty mempty+ mempty+ mappend (TempFlags x1 x2 x3 x4 x5 x6 x7 x8 x9)+ (TempFlags y1 y2 y3 y4 y5 y6 y7 y8 y9)+ = TempFlags (mappend x1 y1) (mappend x2 y2) (mappend x3 y3)+ (mappend x4 y4)+ (mappend x5 y5)+ (mappend x6 y6)+ (mappend x7 y7)+ (mappend x8 y8)+ (mappend x9 y9)+setTempGHCPath a0 b0+ = TempFlags a0 (tempInputFile b0) (tempOutputFile b0)+ (tempCpphsPath b0)+ (tempGHCArgs b0)+ (tempCpphsArgs b0)+ (tempDropImport b0)+ (tempJustSplices b0)+ (tempStdFlag b0)+setTempInputFile a0 b0+ = TempFlags (tempGHCPath b0) a0 (tempOutputFile b0)+ (tempCpphsPath b0)+ (tempGHCArgs b0)+ (tempCpphsArgs b0)+ (tempDropImport b0)+ (tempJustSplices b0)+ (tempStdFlag b0)+setTempOutputFile a0 b0+ = TempFlags (tempGHCPath b0) (tempInputFile b0) a0+ (tempCpphsPath b0)+ (tempGHCArgs b0)+ (tempCpphsArgs b0)+ (tempDropImport b0)+ (tempJustSplices b0)+ (tempStdFlag b0)+setTempCpphsPath a0 b0+ = TempFlags (tempGHCPath b0) (tempInputFile b0) (tempOutputFile b0)+ a0+ (tempGHCArgs b0)+ (tempCpphsArgs b0)+ (tempDropImport b0)+ (tempJustSplices b0)+ (tempStdFlag b0)+setTempGHCArgs a0 b0+ = TempFlags (tempGHCPath b0) (tempInputFile b0) (tempOutputFile b0)+ (tempCpphsPath b0)+ a0+ (tempCpphsArgs b0)+ (tempDropImport b0)+ (tempJustSplices b0)+ (tempStdFlag b0)+setTempCpphsArgs a0 b0+ = TempFlags (tempGHCPath b0) (tempInputFile b0) (tempOutputFile b0)+ (tempCpphsPath b0)+ (tempGHCArgs b0)+ a0+ (tempDropImport b0)+ (tempJustSplices b0)+ (tempStdFlag b0)+setTempDropImport a0 b0+ = TempFlags (tempGHCPath b0) (tempInputFile b0) (tempOutputFile b0)+ (tempCpphsPath b0)+ (tempGHCArgs b0)+ (tempCpphsArgs b0)+ a0+ (tempJustSplices b0)+ (tempStdFlag b0)+setTempJustSplices a0 b0+ = TempFlags (tempGHCPath b0) (tempInputFile b0) (tempOutputFile b0)+ (tempCpphsPath b0)+ (tempGHCArgs b0)+ (tempCpphsArgs b0)+ (tempDropImport b0)+ a0+ (tempStdFlag b0)+setTempStdFlag a0 b0+ = TempFlags (tempGHCPath b0) (tempInputFile b0) (tempOutputFile b0)+ (tempCpphsPath b0)+ (tempGHCArgs b0)+ (tempCpphsArgs b0)+ (tempDropImport b0)+ (tempJustSplices b0)+ a0+-- XXX: Use Data.Derive to generate these instead+tempGHCPath' = addP tempGHCPath setTempGHCPath+tempInputFile' = addP tempInputFile setTempInputFile+tempOutputFile' = addP tempOutputFile setTempOutputFile+tempCpphsPath' = addP tempCpphsPath setTempCpphsPath+tempGHCArgs' = addP tempGHCArgs setTempGHCArgs+tempCpphsArgs' = addP tempCpphsArgs setTempCpphsArgs+tempDropImport' = addP tempDropImport setTempDropImport+tempJustSplices' = addP tempJustSplices setTempJustSplices+tempStdFlag' = addP tempStdFlag setTempStdFlag+ +globalOptions :: [] (OptDescr (TempFlags -> TempFlags))+globalOptions+ = stdOpts tempStdFlag' +++ [Option "" ["only-splices"] (NoArg $ tempJustSplices' True)+ "Only pass the splices to GHC, not the whole file (for faster processing)",+ Option "w" ["ghc"] (ReqArg tempGHCPath' "PATH") "Use this GHC",+ Option "" ["cpphs"] (ReqArg tempCpphsPath' "PATH")+ "Use this cpphs",+ Option "i" ["input"] (ReqArg tempInputFile' "PATH") "Input file",+ Option "o" ["output"] (ReqArg tempOutputFile' "PATH")+ "Output file",+ Option "" ["ghc-args"] (ReqArg (tempGHCArgs' . words) "Arguments")+ "Arguments to GHC",+ Option "" ["cpphs-args"]+ (ReqArg (tempCpphsArgs' . words) "Arguments")+ "Arguments to cpphs",+ Option "d" ["drop-import"]+ (ReqArg (tempDropImport' . words) "Prefix")+ "Any import that starts with this prefix will be removed"]+ +myParseArgs :: [] String -> IO TempFlags+myParseArgs+ = mParseArgs+ Version{versionBranch = [2009, 6, 23, 3], versionTags = []}+ globalOptions+ tempStdFlag
zeroth.cabal view
@@ -1,5 +1,5 @@ Name: zeroth-Version: 2009.6.23.2+Version: 2009.6.23.3 Cabal-version: >= 1.6 License: BSD3 License-file: LICENSE@@ -18,6 +18,7 @@ Stability: experimental Tested-with: GHC == 6.10.3 Extra-tmp-files: ppsrc/Language/Haskell/TH/ZeroTH/GetOpt.hs+Extra-source-files: Language/Haskell/TH/ZeroTH/GetOpt.hs Source-repository head Type: darcs