module Distribution.Dev.Interactive (
cabalSet, packageOpts, loadCabal, lookForCabalFile, withOpts, LoadCabalRet(..)
) where
import Distribution.Text (display)
import Distribution.Compiler (buildCompilerFlavor, CompilerId(..))
import Distribution.Verbosity (normal)
import Distribution.System (buildPlatform)
import Distribution.Package (PackageName(..), Dependency(..))
import Distribution.PackageDescription (
FlagName(..), FlagAssignment, BuildInfo(..), hcOptions, allExtensions,
PackageDescription(..), Executable(..), allBuildInfo)
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.PackageDescription.Configuration (
finalizePackageDescription)
import Distribution.Simple.PackageIndex (lookupDependency)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo, installedPkgs)
import Data.Version (Version, showVersion)
import Distribution.Simple.BuildPaths (autogenModulesDir, cppHeaderName)
import System.FilePath (takeDirectory, (</>), takeExtension)
import System.Directory (
getDirectoryContents, getCurrentDirectory, canonicalizePath)
import System.Info (compilerVersion)
import Data.Maybe (listToMaybe, fromMaybe)
import Control.Exception (try, SomeException)
type Deps = [(PackageName, Version)]
data LoadCabalRet =
NoCabalFile |
MissingDeps [Dependency] |
Pkg FilePath PackageDescription (Maybe LocalBuildInfo)
deriving Show
compiler ∷ CompilerId
compiler = CompilerId buildCompilerFlavor compilerVersion
packageOpts
∷ FilePath
→ PackageDescription
→ Maybe LocalBuildInfo
→ String
→ Maybe [String]
packageOpts path pkg mlbi executable =
maybe Nothing (\bi → Just $ ghcOpts path bi mlbi (listDeps bi =<< mlbi)) $
listToMaybe $
if executable == ""
then allBuildInfo pkg
else
fmap buildInfo .
filter (\x → exeName x == executable) .
executables $ pkg
listDeps ∷ BuildInfo → LocalBuildInfo → Maybe Deps
listDeps bi lbi = sequence $ map find reqs
where
reqs = targetBuildDepends bi
db = installedPkgs lbi
find dep@(Dependency pkg _) = do
(fst . head → ver) ← return $ lookupDependency db dep
return (pkg, ver)
ghcOpts ∷ FilePath → BuildInfo → Maybe LocalBuildInfo → Maybe Deps → [String]
ghcOpts path bi mlbi deps = filter validGHCiFlag $ concat $
maybe [] ((noPkgs:) . add "-package=" . map addDep) deps :
map ($ bi) [
hcOptions buildCompilerFlavor,
addf "-X" display . allExtensions,
addf "-i" (dir </>) . (autogendir:) . hsSourceDirs,
add "-optP" . cppOptions,
add "-optc" . ccOptions,
add "-optl" . ldOptions,
const ["-optP-include", "-optP" ++ (autogendir </> cppHeaderName)]
]
where
autogendir
| Just lbi ← mlbi = autogenModulesDir lbi
| otherwise = "dist/build/autogen"
dir
| s@(_:_) ← takeDirectory path = s
| otherwise = "."
add s = map (s++)
addf ∷ String → (a → String) → [a] → [String]
addf s f = map ((s++) . f)
noPkgs = "-hide-all-packages"
addDep (PackageName pkg, showVersion → ver) = pkg ++ "-" ++ ver
validGHCiFlag "-O" = False
validGHCiFlag ['-','O',n] | n `elem` ['0'..'9'] = False
validGHCiFlag "-debug" = False
validGHCiFlag "-rtsopts" = False
validGHCiFlag "-threaded" = False
validGHCiFlag "-ticky" = False
validGHCiFlag _ = True
loadCabal
∷ FilePath
→ FlagAssignment
→ IO LoadCabalRet
loadCabal path flags = do
mCabalFile ← lookForCabalFile =<< canonicalizePath path
flip (maybe (return NoCabalFile))
mCabalFile $ \cabalFile → do
gdescr ← readPackageDescription normal cabalFile
mlbi ← loadCabalConfig (takeDirectory cabalFile </> "dist" </> "setup-config")
case finalizePackageDescription flags (const True)
buildPlatform compiler [] gdescr of
Left deps → return $ MissingDeps deps
Right (descr, _) → return $ Pkg cabalFile descr mlbi
maybeNth ∷ Int → [a] → Maybe a
maybeNth 0 (x:_) = Just x
maybeNth n (_:xs) = maybeNth (n1) xs
maybeNth _ _ = Nothing
maybeRead ∷ Read a ⇒ String → Maybe a
maybeRead s = case reads s of [(a, "")] → Just a; _ → Nothing
loadCabalConfig ∷ FilePath → IO (Maybe LocalBuildInfo)
loadCabalConfig path =
fmap (either ignore id) $ try $
fmap ((maybeRead =<<) . maybeNth 1 . lines) $ readFile path
where
ignore ∷ SomeException → Maybe a
ignore _ = Nothing
lookForCabalFile
∷ FilePath
→ IO (Maybe FilePath)
lookForCabalFile "/" = return Nothing
lookForCabalFile path = do
files ← getDirectoryContents path
let cabals = filter (\f →
takeExtension f == ".cabal"
&& f /= ".cabal") files
case cabals of
[] → lookForCabalFile (takeDirectory path)
[a] → return $ Just $ path </> a
_ → return Nothing
cabalSet
∷ String
→ IO String
cabalSet args =
withOpts (words args)
(\x → putStrLn x >> return "")
((\x → putStrLn x >> return x) .
unlines . (map (":set "++)) . map show )
withOpts
∷ [String]
→ (String → IO a)
→ ([String] → IO a)
→ IO a
withOpts args err go = do
let (flags, executable) = parseArgs args
here ← getCurrentDirectory
ret ← loadCabal here flags
case ret of
NoCabalFile → err "Current directory is not a cabal project"
MissingDeps deps → err $ "Missing dependencies: " ++ unwords (map show deps)
Pkg path descr mlbi → do
let mopts = packageOpts path descr mlbi executable
case mopts of
Nothing → err (
if executable /= ""
then "No such executable in cabal file"
else "No library defined in cabal file")
Just opts → go opts
parseArgs ∷ [String] → (FlagAssignment, String)
parseArgs args =
(map (makeFlag . drop 2) . filter flag $ args,
fromMaybe "" . listToMaybe . filter (not . flag) $ args)
where
flag x = take 2 x == "-f"
makeFlag ∷ String → (FlagName, Bool)
makeFlag ('-':f) = (FlagName f, False)
makeFlag f = (FlagName f, True)