ghc-options (empty) → 0.1.0.0
raw patch · 9 files changed
+581/−0 lines, 9 filesdep +Cabaldep +basedep +bin-package-dbsetup-changed
Dependencies added: Cabal, base, bin-package-db, directory, filepath, process, transformers, unix
Files
- LICENSE +23/−0
- Setup.hs +2/−0
- ghc-options.cabal +65/−0
- src/Language/Haskell/GhcOpts.hs +51/−0
- src/Language/Haskell/GhcOpts/Cabal.hs +242/−0
- src/Language/Haskell/GhcOpts/Stack.hs +66/−0
- src/Language/Haskell/GhcOpts/Types.hs +41/−0
- src/Language/Haskell/GhcOpts/Utils.hs +82/−0
- src/Main.hs +9/−0
+ LICENSE view
@@ -0,0 +1,23 @@++The MIT License (MIT)++Copyright (c) 2015 Ranjit Jhala++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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ghc-options.cabal view
@@ -0,0 +1,65 @@+-- Initial ghc-options.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: ghc-options+version: 0.1.0.0+synopsis: Utilities for extracting GHC options needed to compile a given Haskell target.+description: 'ghcopts' is a library that makes it easy to determine what+ GHC options are needed to compile a file. It was built + by extracting the relevant code from 'hdevtools' which + queries 'cabal' and 'stack' to determine the locations + of various package databases, in order to pass them to + GHC to process a target file. We have refactored this + code into a separate package so that it can be used by + other tools built on the GHC API.++homepage: https://github.com/ranjitjhala/ghc-options.git+license: MIT+license-file: LICENSE+author: Ranjit Jhala+maintainer: jhala@cs.ucsd.edu+-- copyright:+category: Language+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++executable ghcopts+ hs-source-dirs: src+ ghc-options: -Wall+ cpp-options: -DCABAL+ main-is: Main.hs+ build-depends: base >=4.8 && <4.9,+ process,+ filepath,+ directory,+ transformers,+ Cabal >= 1.22,+ bin-package-db,+ unix++ other-modules: Language.Haskell.GhcOpts,+ Language.Haskell.GhcOpts.Types,+ Language.Haskell.GhcOpts.Stack,+ Language.Haskell.GhcOpts.Cabal,+ Language.Haskell.GhcOpts.Utils++ hs-source-dirs: src+ default-language: Haskell2010+ cpp-options: -DENABLE_CABAL++library+ exposed-modules: Language.Haskell.GhcOpts++ build-depends: base >=4.8 && <4.9,+ process,+ filepath,+ directory,+ transformers,+ Cabal >= 1.22,+ bin-package-db,+ unix++ hs-source-dirs: src+ default-language: Haskell2010+ cpp-options: -DENABLE_CABAL
+ src/Language/Haskell/GhcOpts.hs view
@@ -0,0 +1,51 @@+module Language.Haskell.GhcOpts+ ( ghcOpts+ , module Language.Haskell.GhcOpts.Types+ ) where++import System.Directory (setCurrentDirectory)+import System.FilePath (takeDirectory)++import Language.Haskell.GhcOpts.Utils+import Language.Haskell.GhcOpts.Types+import Language.Haskell.GhcOpts.Cabal+import Language.Haskell.GhcOpts.Stack++ghcOpts :: FilePath -> IO (Either String Config)+ghcOpts f = fileCommand f >>= newConfig >>= packageConfig +{-+ do+ -- putStrLn $ "File: " ++ f+ cmd <- fileCommand f+ -- putStrLn $ "Command: " ++ show cmd+ cf0 <- newConfig cmd+ -- putStrLn $ "NewCfg: " ++ show cf0+ packageConfig cf0+-}++fileCommand :: FilePath -> IO CommandExtra+fileCommand f = do+ mCabalFile <- findCabalFile (Just f) >>= traverse absoluteFilePath+ return $ emptyCommand { cePath = Just f, ceCabalConfig = mCabalFile}++newConfig :: CommandExtra -> IO Config+newConfig cmd = do+ cabal <- traverse (\path -> mkCabalConfig path (ceCabalOptions cmd)) $ ceCabalConfig cmd+ stack <- getStackConfig (cePath cmd)+ return Config { configGhcOpts = "-O0" : ceGhcOptions cmd+ , configCabal = cabal+ , configStack = stack }++packageConfig :: Config -> IO (Either String Config)+packageConfig cfg =+ case configCabal cfg of+ Nothing -> return $ Right cfg+ Just c -> (withOpts cfg <$>) <$> packageOptions (configStack cfg) c++withOpts :: Config -> [String] -> Config+withOpts cfg opts = cfg { configGhcOpts = opts ++ configGhcOpts cfg }++packageOptions :: Maybe StackConfig -> CabalConfig -> IO (Either String [String])+packageOptions stack cabal = do+ setCurrentDirectory . takeDirectory $ cabalConfigPath cabal+ getPackageGhcOpts (cabalConfigPath cabal) stack (cabalConfigOpts cabal)
+ src/Language/Haskell/GhcOpts/Cabal.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE CPP #-}+module Language.Haskell.GhcOpts.Cabal+ ( getPackageGhcOpts+ , mkCabalConfig+ , findCabalFile+ ) where++import Language.Haskell.GhcOpts.Types++import System.Posix.Files (getFileStatus, modificationTime)+import Control.Exception (IOException, catch)+import Control.Monad (when)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State (execStateT, modify)+import Data.Char (isSpace)+import Data.List (foldl', nub, sort, find, isPrefixOf, isSuffixOf)+#if __GLASGOW_HASKELL__ < 709+import Control.Applicative ((<$>))+import Data.Monoid (Monoid(..))+#endif+import Distribution.Package (PackageIdentifier(..), PackageName)+import Distribution.PackageDescription (PackageDescription(..), Executable(..), TestSuite(..), Benchmark(..), emptyHookedBuildInfo, buildable, libBuildInfo)+import Distribution.PackageDescription.Parse (readPackageDescription)+import Distribution.Simple.Configure (configure)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), ComponentLocalBuildInfo(..),+ Component(..), ComponentName(..),+#if __GLASGOW_HASKELL__ < 707+ allComponentsBy,+#endif+ componentBuildInfo, foldComponent)+import Distribution.Simple.Compiler (PackageDB(..))+import Distribution.Simple.Command (CommandParse(..), commandParseArgs)+import Distribution.Simple.GHC (componentGhcOptions)+import Distribution.Simple.Program (defaultProgramConfiguration)+import Distribution.Simple.Program.Db (lookupProgram)+import Distribution.Simple.Program.Types (ConfiguredProgram(programVersion), simpleProgram)+import Distribution.Simple.Program.GHC (GhcOptions(..), renderGhcOptions)+import Distribution.Simple.Setup (ConfigFlags(..), defaultConfigFlags, configureCommand, toFlag)+#if __GLASGOW_HASKELL__ >= 709+import Distribution.Utils.NubList+import qualified Distribution.Simple.GHC as GHC(configure)+#endif+import Distribution.Verbosity (silent)+import Distribution.Version (Version(..))++import System.IO.Error (ioeGetErrorString)+import System.Directory (getCurrentDirectory, doesFileExist, getDirectoryContents)+import System.FilePath (takeDirectory, splitFileName, (</>))+import Language.Haskell.GhcOpts.Utils++componentName :: Component -> ComponentName+componentName =+ foldComponent (const CLibName)+ (CExeName . exeName)+ (CTestName . testName)+ (CBenchName . benchmarkName)++getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo+#if __GLASGOW_HASKELL__ >= 707+getComponentLocalBuildInfo lbi cname = getLocalBuildInfo cname $ componentsConfigs lbi+ where getLocalBuildInfo cname' ((cname'', clbi, _):cfgs) =+ if cname' == cname'' then clbi else getLocalBuildInfo cname' cfgs+ getLocalBuildInfo _ [] = error $ "internal error: missing config"+#else+getComponentLocalBuildInfo lbi CLibName =+ case libraryConfig lbi of+ Nothing -> error $ "internal error: missing library config"+ Just clbi -> clbi+getComponentLocalBuildInfo lbi (CExeName name) =+ case lookup name (executableConfigs lbi) of+ Nothing -> error $ "internal error: missing config for executable " ++ name+ Just clbi -> clbi+getComponentLocalBuildInfo lbi (CTestName name) =+ case lookup name (testSuiteConfigs lbi) of+ Nothing -> error $ "internal error: missing config for test suite " ++ name+ Just clbi -> clbi+getComponentLocalBuildInfo lbi (CBenchName name) =+ case lookup name (testSuiteConfigs lbi) of+ Nothing -> error $ "internal error: missing config for benchmark " ++ name+ Just clbi -> clbi+#endif++#if __GLASGOW_HASKELL__ >= 707+-- TODO: Fix callsites so we don't need `allComponentsBy`. It was taken from+-- http://hackage.haskell.org/package/Cabal-1.16.0.3/docs/src/Distribution-Simple-LocalBuildInfo.html#allComponentsBy+-- since it doesn't exist in Cabal 1.18.*+--+-- | Obtains all components (libs, exes, or test suites), transformed by the+-- given function. Useful for gathering dependencies with component context.+allComponentsBy :: PackageDescription+ -> (Component -> a)+ -> [a]+allComponentsBy pkg_descr f =+ [ f (CLib lib) | Just lib <- [library pkg_descr]+ , buildable (libBuildInfo lib) ]+ ++ [ f (CExe exe) | exe <- executables pkg_descr+ , buildable (buildInfo exe) ]+ ++ [ f (CTest tst) | tst <- testSuites pkg_descr+ , buildable (testBuildInfo tst)+ , testEnabled tst ]+ ++ [ f (CBench bm) | bm <- benchmarks pkg_descr+ , buildable (benchmarkBuildInfo bm)+ , benchmarkEnabled bm ]+#endif++stackifyFlags :: ConfigFlags -> Maybe StackConfig -> ConfigFlags+stackifyFlags cfg Nothing = cfg+stackifyFlags cfg (Just si) = cfg { configDistPref = toFlag dist+ , configPackageDBs = pdbs+ }+ where+ pdbs = [Nothing, Just GlobalPackageDB] ++ pdbs'+ pdbs' = Just . SpecificPackageDB <$> stackDbs si+ dist = stackDist si++-- via: https://groups.google.com/d/msg/haskell-stack/8HJ6DHAinU0/J68U6AXTsasJ+-- cabal configure --package-db=clear --package-db=global --package-db=$(stack path --snapshot-pkg-db) --package-db=$(stack path --local-pkg-db)++-- returns the right 'dist' directory in the case of a sandbox+getDistDir :: FilePath -> IO FilePath+getDistDir path = do+ let dir = takeDirectory path </> "dist"+ contents <- getDirectoryContentsIfExists dir+ return $ case find ("dist-sandbox-" `isPrefixOf`) contents of+ Just sbdir -> dir </> sbdir+ Nothing -> dir++getPackageGhcOpts :: FilePath -> Maybe StackConfig -> [String] -> IO (Either String [String])+getPackageGhcOpts path mbStack opts = do+ -- putStrLn $ "getPackageGhcOpts: path = " ++ path+ getPackageGhcOpts' `catch` (\e -> return $ Left $ "Cabal error: " ++ ioeGetErrorString (e :: IOException))+ where+ getPackageGhcOpts' :: IO (Either String [String])+ getPackageGhcOpts' = do+ genPkgDescr <- readPackageDescription silent path+ distDir <- getDistDir path++ let programCfg = defaultProgramConfiguration+ let initCfgFlags = (defaultConfigFlags programCfg)+ { configDistPref = toFlag distDir+ -- TODO: figure out how to find out this flag+ , configUserInstall = toFlag True++ -- configure with --enable-tests to include test dependencies/modules+ , configTests = toFlag True++ -- configure with --enable-benchmarks to include benchmark dependencies/modules+ , configBenchmarks = toFlag True+ }+ let initCfgFlags' = stackifyFlags initCfgFlags mbStack++ cfgFlags <- flip execStateT initCfgFlags' $ do+ let sandboxConfig = takeDirectory path </> "cabal.sandbox.config"++ exists <- lift $ doesFileExist sandboxConfig+ when exists $ do+ sandboxPackageDb <- lift $ getSandboxPackageDB sandboxConfig+ modify $ \x -> x { configPackageDBs = [Just sandboxPackageDb] }++ let cmdUI = configureCommand programCfg+ case commandParseArgs cmdUI True opts of+ CommandReadyToGo (modFlags, _) -> modify modFlags+ CommandErrors (e:_) -> error e+ _ -> return ()++ localBuildInfo <- configure (genPkgDescr, emptyHookedBuildInfo) cfgFlags+ let pkgDescr = localPkgDescr localBuildInfo+ let baseDir = fst . splitFileName $ path+ case getGhcVersion localBuildInfo of+ Nothing -> return $ Left "GHC is not configured"++ Just _ -> do+ let mbLibName = pkgLibName pkgDescr+ let ghcOpts' = foldl' mappend mempty $ map (getComponentGhcOptions localBuildInfo) $ flip allComponentsBy (\c -> c) . localPkgDescr $ localBuildInfo+ -- FIX bug in GhcOptions' `mappend`+ ghcOpts = ghcOpts' { ghcOptExtra = overNubListR (filter (/= "-Werror")) $ ghcOptExtra ghcOpts'+ , ghcOptPackageDBs = sort $ nub (ghcOptPackageDBs ghcOpts')+ , ghcOptPackages = overNubListR (filter (\(_, pkgId, _) -> Just (pkgName pkgId) /= mbLibName)) $ (ghcOptPackages ghcOpts')+ , ghcOptSourcePath = overNubListR (map (baseDir </>)) (ghcOptSourcePath ghcOpts')+ }+ -- putStrLn "configuring"+ (ghcInfo,_,_) <- GHC.configure silent Nothing Nothing defaultProgramConfiguration++ return $ Right $ renderGhcOptions ghcInfo ghcOpts++pkgLibName :: PackageDescription -> Maybe PackageName+pkgLibName pkgDescr = if hasLibrary pkgDescr+ then Just $ pkgName . package $ pkgDescr+ else Nothing++hasLibrary :: PackageDescription -> Bool+hasLibrary = maybe False (\_ -> True) . library++getComponentGhcOptions :: LocalBuildInfo -> Component -> GhcOptions+getComponentGhcOptions lbi comp =+ componentGhcOptions silent lbi bi clbi (buildDir lbi)++ where bi = componentBuildInfo comp+ clbi = getComponentLocalBuildInfo lbi (componentName comp)++getGhcVersion :: LocalBuildInfo -> Maybe Version+getGhcVersion lbi = let db = withPrograms lbi+ in do ghc <- lookupProgram (simpleProgram "ghc") db+ programVersion ghc++getSandboxPackageDB :: FilePath -> IO PackageDB+getSandboxPackageDB sandboxPath = do+ contents <- readFile sandboxPath+ return $ SpecificPackageDB $ extractValue . parse $ contents+ where+ pkgDbKey = "package-db:"+ parse = head . filter (pkgDbKey `isPrefixOf`) . lines+ extractValue = fst . break isSpace . dropWhile isSpace . drop (length pkgDbKey)+++findCabalFile :: Maybe FilePath -> IO (Maybe FilePath)+findCabalFile f = go =<< maybe getCurrentDirectory (return . takeDirectory) f+ where+ go dir = do+ allFiles <- getDirectoryContents dir+ let mbCabalFile = find isCabalFile allFiles+ case mbCabalFile of+ Just cabalFile -> return $ Just $ dir </> cabalFile+ Nothing ->+ let parentDir = takeDirectory dir in+ if parentDir == dir then return Nothing else go parentDir++isCabalFile :: FilePath -> Bool+isCabalFile path = cabalExtension `isSuffixOf` path &&+ length path > length cabalExtension+ where+ cabalExtension = ".cabal"++--------------------------------------------------------------------------------+mkCabalConfig :: FilePath -> [String] -> IO CabalConfig+--------------------------------------------------------------------------------+mkCabalConfig path opts = do+ fileStatus <- getFileStatus path+ return CabalConfig { cabalConfigPath = path+ , cabalConfigOpts = opts+ , cabalConfigLastUpdatedAt = modificationTime fileStatus+ }
+ src/Language/Haskell/GhcOpts/Stack.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE CPP #-}++-- | This module adds support for `stack`, as follows:+-- 1. Figure out if the target-file is in a stack project,+-- 2. If `stack.yaml` in PATH, run `stack exec` to extract `StackConfig`+-- 3. Use `StackConfig` to alter the cabal ConfigFlags in Cabal.hs++module Language.Haskell.GhcOpts.Stack ( getStackConfig ) where++#if __GLASGOW_HASKELL__ < 709+import Control.Applicative((<$>), (<*>))+import System.IO+#endif++import Data.Maybe (listToMaybe)++import System.FilePath+import System.Directory+import Control.Monad (filterM)++import Language.Haskell.GhcOpts.Utils+import Language.Haskell.GhcOpts.Types++--------------------------------------------------------------------------------+getStackConfig :: Maybe FilePath -> IO (Maybe StackConfig)+--------------------------------------------------------------------------------+getStackConfig Nothing =+ return Nothing+getStackConfig (Just p) = do+ mbYaml <- getStackYaml p+ case mbYaml of+ Nothing -> return Nothing+ Just _ -> do mdbs <- getStackDbs p+ mdst <- getStackDist p+ return $ StackConfig <$> mdst <*> mdbs++--------------------------------------------------------------------------------+getStackYaml :: FilePath -> IO (Maybe FilePath)+--------------------------------------------------------------------------------+getStackYaml p = listToMaybe <$> filterM doesFileExist paths+ where+ paths = [ d </> "stack.yaml" | d <- pathsToRoot dir]+ dir = takeDirectory p++--------------------------------------------------------------------------------+getStackDist :: FilePath -> IO (Maybe FilePath)+--------------------------------------------------------------------------------+getStackDist p = (trim <$>) <$> execInPath cmd p+ where+ cmd = "stack path --dist-dir"++--------------------------------------------------------------------------------+getStackDbs :: FilePath -> IO (Maybe [FilePath])+--------------------------------------------------------------------------------+getStackDbs p = do mpp <- execInPath cmd p+ case mpp of+ Just pp -> Just <$> extractDbs pp+ Nothing -> return Nothing+ where+ cmd = "stack --verbosity quiet exec printenv GHC_PACKAGE_PATH"++extractDbs :: String -> IO [FilePath]+extractDbs = filterM doesDirectoryExist . stringPaths++stringPaths :: String -> [String]+stringPaths = splitBy ':' . trim
+ src/Language/Haskell/GhcOpts/Types.hs view
@@ -0,0 +1,41 @@+module Language.Haskell.GhcOpts.Types (+ CommandExtra (..)+ , emptyCommand+ , Config (..)+ , CabalConfig (..)+ , StackConfig (..)+ ) where++import System.Posix.Types (EpochTime)++data Config = Config+ { configGhcOpts :: [String]+ , configCabal :: Maybe CabalConfig+ , configStack :: Maybe StackConfig+ }+ deriving (Eq, Show)++data CabalConfig = CabalConfig+ { cabalConfigPath :: FilePath+ , cabalConfigOpts :: [String]+ , cabalConfigLastUpdatedAt :: EpochTime+ }+ deriving (Eq, Show)++data StackConfig = StackConfig+ { stackDist :: FilePath+ , stackDbs :: [FilePath]+ }+ deriving (Eq, Show)++-- | Bonus config parameters used to override those in .cabal and stack.yaml++data CommandExtra = CommandExtra+ { ceGhcOptions :: [String]+ , ceCabalConfig :: Maybe FilePath+ , cePath :: Maybe FilePath+ , ceCabalOptions :: [String]+ } deriving (Read, Show)++emptyCommand :: CommandExtra+emptyCommand = CommandExtra [] Nothing Nothing []
+ src/Language/Haskell/GhcOpts/Utils.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE CPP #-}++-- | Various utilities pertaining to searching for files & directories.++module Language.Haskell.GhcOpts.Utils where++import Control.Exception+import System.Process+import Data.Char (isSpace)+import System.FilePath+import System.Directory+++getDirectoryContentsIfExists :: FilePath -> IO [FilePath]+getDirectoryContentsIfExists dir = do+ b <- doesFileExist dir+ if b then getDirectoryContents dir+ else return []++absoluteFilePath :: FilePath -> IO FilePath+absoluteFilePath p = if isAbsolute p then return p else do+ dir <- getCurrentDirectory+ return $ dir </> p+++pathsToRoot :: FilePath -> [FilePath]+pathsToRoot p+ | p == parent = [p]+ | otherwise = p : pathsToRoot parent+ where+ parent = takeDirectory p++splitBy :: Char -> String -> [String]+splitBy c str+ | null str' = [x]+ | otherwise = x : splitBy c (tail str')+ where+ (x, str') = span (c /=) str++trim :: String -> String+trim = f . f+ where+ f = reverse . dropWhile isSpace++#if __GLASGOW_HASKELL__ < 709+execInPath :: String -> FilePath -> IO (Maybe String)+execInPath cmd p = do+ eIOEstr <- try $ createProcess prc :: IO (Either IOError ProcH)+ case eIOEstr of+ Right (_, Just h, _, _) -> Just <$> getClose h+ Right (_, Nothing, _, _) -> return Nothing+ -- This error is most likely "/bin/sh: stack: command not found"+ -- which is caused by the package containing a stack.yaml file but+ -- no stack command is in the PATH.+ Left _ -> return Nothing+ where+ prc = (shell cmd) { cwd = Just $ takeDirectory p }++getClose :: Handle -> IO String+getClose h = do+ str <- hGetContents h+ hClose h+ return str++type ProcH = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)++-- Not deleting this because this is likely more robust than the above! (but+-- only works on process-1.2.3.0 onwards++#else+execInPath :: String -> FilePath -> IO (Maybe String)+execInPath cmd p = do+ eIOEstr <- try $ readCreateProcess prc "" :: IO (Either IOError String)+ return $ case eIOEstr of+ Right s -> Just s+ -- This error is most likely "/bin/sh: stack: command not found"+ -- which is caused by the package containing a stack.yaml file but+ -- no stack command is in the PATH.+ Left _ -> Nothing+ where+ prc = (shell cmd) { cwd = Just $ takeDirectory p }+#endif
+ src/Main.hs view
@@ -0,0 +1,9 @@+import System.Environment++import Language.Haskell.GhcOpts++main :: IO () +main = do+ f:_ <- getArgs+ z <- ghcOpts f+ putStrLn $ "GHC Options: " ++ show z