{-# LANGUAGE OverloadedStrings, CPP #-}

module HsDev.Project (
	module HsDev.Project.Types,

	infoSourceDirsDef, targetFiles, projectTargetFiles,
	analyzeCabal,
	readProject, loadProject,
	withExtensions,
	fileInTarget, fileTarget, fileTargets, findSourceDir, sourceDirs,
	targetOpts,

	-- * Helpers
	showExtension, flagExtension, extensionFlag,
	extensionsOpts
	) where

import Control.Arrow
import Control.Lens hiding ((.=), (%=), (<.>), set')
import Control.Monad.Except
import Control.Monad.Loops
import Data.List
import Data.Maybe
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T (intercalate)
import Data.Text.Lens (unpacked)
import Distribution.Compiler (CompilerFlavor(GHC))
#if MIN_VERSION_Cabal(3,0,0)
import Distribution.Compiler (perCompilerFlavorToList)
#endif
import qualified Distribution.Package as P
import qualified Distribution.PackageDescription as PD
import qualified Distribution.ModuleName as PD (toFilePath)
import Distribution.ModuleName (components)
import Distribution.Text (display)
import Language.Haskell.Extension
import System.FilePath
import System.Log.Simple hiding (Level(..))
import qualified System.Log.Simple as Log (Level(..))
import Text.Format

import System.Directory.Paths
import HsDev.Project.Compat
import HsDev.Project.Types
import HsDev.Error
import HsDev.Util

-- | infoSourceDirs lens with default
infoSourceDirsDef :: Lens' Info [Path]
infoSourceDirsDef :: ([Path] -> f [Path]) -> Info -> f Info
infoSourceDirsDef = (Info -> [Path])
-> (Info -> [Path] -> Info) -> Lens Info Info [Path] [Path]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Info -> [Path]
get' Info -> [Path] -> Info
set' where
	get' :: Info -> [Path]
get' Info
i = case Info -> [Path]
_infoSourceDirs Info
i of
		[] -> [Path
"."]
		[Path]
dirs -> [Path]
dirs
	set' :: Info -> [Path] -> Info
set' Info
i [Path
"."] = Info
i { _infoSourceDirs :: [Path]
_infoSourceDirs = [] }
	set' Info
i [Path]
dirs = Info
i { _infoSourceDirs :: [Path]
_infoSourceDirs = [Path]
dirs }

-- | Get all source file names of target without prepending them with source-dirs
targetFiles :: Target t => t -> [Path]
targetFiles :: t -> [Path]
targetFiles t
target' = [[Path]] -> [Path]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
	Maybe Path -> [Path]
forall a. Maybe a -> [a]
maybeToList (t -> Maybe Path
forall a. Target a => a -> Maybe Path
targetMain t
target'),
	([Path] -> Path) -> [[Path]] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map [Path] -> Path
forall s a. (Each s s a a, IsText a) => s -> Path
toFile ([[Path]] -> [Path]) -> [[Path]] -> [Path]
forall a b. (a -> b) -> a -> b
$ t -> [[Path]]
forall a. Target a => a -> [[Path]]
targetModules t
target',
	([Path] -> Path) -> [[Path]] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map [Path] -> Path
forall s a. (Each s s a a, IsText a) => s -> Path
toFile ([[Path]] -> [Path]) -> [[Path]] -> [Path]
forall a b. (a -> b) -> a -> b
$ t
target' t -> Getting (Endo [[Path]]) t [Path] -> [[Path]]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Info -> Const (Endo [[Path]]) Info)
-> t -> Const (Endo [[Path]]) t
forall a. Target a => Lens' a Info
buildInfo ((Info -> Const (Endo [[Path]]) Info)
 -> t -> Const (Endo [[Path]]) t)
-> (([Path] -> Const (Endo [[Path]]) [Path])
    -> Info -> Const (Endo [[Path]]) Info)
-> Getting (Endo [[Path]]) t [Path]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Path]] -> Const (Endo [[Path]]) [[Path]])
-> Info -> Const (Endo [[Path]]) Info
Lens' Info [[Path]]
infoOtherModules (([[Path]] -> Const (Endo [[Path]]) [[Path]])
 -> Info -> Const (Endo [[Path]]) Info)
-> (([Path] -> Const (Endo [[Path]]) [Path])
    -> [[Path]] -> Const (Endo [[Path]]) [[Path]])
-> ([Path] -> Const (Endo [[Path]]) [Path])
-> Info
-> Const (Endo [[Path]]) Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Path] -> Const (Endo [[Path]]) [Path])
-> [[Path]] -> Const (Endo [[Path]]) [[Path]]
forall s t a b. Each s t a b => Traversal s t a b
each]
	where
		toFile :: s -> Path
toFile s
ps = FilePath -> Path
fromFilePath ([FilePath] -> FilePath
joinPath (s
ps s -> Getting (Endo [FilePath]) s FilePath -> [FilePath]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (a -> Const (Endo [FilePath]) a) -> s -> Const (Endo [FilePath]) s
forall s t a b. Each s t a b => Traversal s t a b
each ((a -> Const (Endo [FilePath]) a)
 -> s -> Const (Endo [FilePath]) s)
-> ((FilePath -> Const (Endo [FilePath]) FilePath)
    -> a -> Const (Endo [FilePath]) a)
-> Getting (Endo [FilePath]) s FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Const (Endo [FilePath]) FilePath)
-> a -> Const (Endo [FilePath]) a
forall t. IsText t => Iso' t FilePath
unpacked) FilePath -> FilePath -> FilePath
<.> FilePath
"hs")

-- | Get all source file names relative to project root
projectTargetFiles :: (MonadLog m, Target t) => Project -> t -> m [Path]
projectTargetFiles :: Project -> t -> m [Path]
projectTargetFiles Project
proj t
t = do
	([[Path]] -> [Path]) -> m [[Path]] -> m [Path]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[Path]] -> [Path]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[Path]] -> m [Path]) -> m [[Path]] -> m [Path]
forall a b. (a -> b) -> a -> b
$ [Path] -> (Path -> m [Path]) -> m [[Path]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path]
files ((Path -> m [Path]) -> m [[Path]])
-> (Path -> m [Path]) -> m [[Path]]
forall a b. (a -> b) -> a -> b
$ \Path
file' -> do
		Maybe Path
candidate <- IO (Maybe Path) -> m (Maybe Path)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Path) -> m (Maybe Path))
-> IO (Maybe Path) -> m (Maybe Path)
forall a b. (a -> b) -> a -> b
$ (Path -> IO Bool) -> [Path] -> IO (Maybe Path)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM (Path -> IO Bool
fileExists (Path -> IO Bool) -> (Path -> Path) -> Path -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Path -> Path
forall a. Paths a => Path -> a -> a
absolutise (Project
proj Project -> Getting Path Project Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path Project Path
Lens' Project Path
projectPath)) [Path -> Path -> Path
subPath Path
srcDir Path
file' | Path
srcDir <- [Path]
srcDirs]
		case Maybe Path
candidate of
			Maybe Path
Nothing -> do
				Level -> Path -> m ()
forall (m :: * -> *). MonadLog m => Level -> Path -> m ()
sendLog Level
Log.Warning (Path -> m ()) -> Path -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"Unable to locate source file: {} in source-dirs: {}" Format -> Path -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Path
file' Format -> Path -> Path
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ (Path -> [Path] -> Path
T.intercalate Path
", " [Path]
srcDirs)
				[Path] -> m [Path]
forall (m :: * -> *) a. Monad m => a -> m a
return []
			Just Path
file'' -> [Path] -> m [Path]
forall (m :: * -> *) a. Monad m => a -> m a
return [Path -> Path
normPath Path
file'']
	where
		files :: [Path]
files = t -> [Path]
forall t. Target t => t -> [Path]
targetFiles t
t
		srcDirs :: [Path]
srcDirs = t
t t -> Getting (Endo [Path]) t Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Info -> Const (Endo [Path]) Info) -> t -> Const (Endo [Path]) t
forall a. Target a => Lens' a Info
buildInfo ((Info -> Const (Endo [Path]) Info) -> t -> Const (Endo [Path]) t)
-> ((Path -> Const (Endo [Path]) Path)
    -> Info -> Const (Endo [Path]) Info)
-> Getting (Endo [Path]) t Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Path] -> Const (Endo [Path]) [Path])
-> Info -> Const (Endo [Path]) Info
Lens Info Info [Path] [Path]
infoSourceDirsDef (([Path] -> Const (Endo [Path]) [Path])
 -> Info -> Const (Endo [Path]) Info)
-> ((Path -> Const (Endo [Path]) Path)
    -> [Path] -> Const (Endo [Path]) [Path])
-> (Path -> Const (Endo [Path]) Path)
-> Info
-> Const (Endo [Path]) Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> [Path] -> Const (Endo [Path]) [Path]
forall s t a b. Each s t a b => Traversal s t a b
each

-- | Analyze cabal file
analyzeCabal :: String -> Either String ProjectDescription
analyzeCabal :: FilePath -> Either FilePath ProjectDescription
analyzeCabal FilePath
source = case (GenericPackageDescription -> PackageDescription)
-> Either FilePath GenericPackageDescription
-> Either FilePath PackageDescription
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM GenericPackageDescription -> PackageDescription
flattenDescr (Either FilePath GenericPackageDescription
 -> Either FilePath PackageDescription)
-> Either FilePath GenericPackageDescription
-> Either FilePath PackageDescription
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath GenericPackageDescription
parsePackageDesc FilePath
source of
	Right PackageDescription
r -> ProjectDescription -> Either FilePath ProjectDescription
forall a b. b -> Either a b
Right ProjectDescription :: Path
-> Maybe Library -> [Executable] -> [Test] -> ProjectDescription
ProjectDescription {
		_projectVersion :: Path
_projectVersion = FilePath -> Path
pack (FilePath -> Path) -> FilePath -> Path
forall a b. (a -> b) -> a -> b
$ Version -> FilePath
showVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> Version
P.pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
PD.package PackageDescription
r,
		_projectLibrary :: Maybe Library
_projectLibrary = (Library -> Library) -> Maybe Library -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Library
toLibrary (Maybe Library -> Maybe Library) -> Maybe Library -> Maybe Library
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Maybe Library
PD.library PackageDescription
r,
		_projectExecutables :: [Executable]
_projectExecutables = (Executable -> Executable) -> [Executable] -> [Executable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Executable -> Executable
toExecutable ([Executable] -> [Executable]) -> [Executable] -> [Executable]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
PD.executables PackageDescription
r,
		_projectTests :: [Test]
_projectTests = (TestSuite -> Test) -> [TestSuite] -> [Test]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestSuite -> Test
toTest ([TestSuite] -> [Test]) -> [TestSuite] -> [Test]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
PD.testSuites PackageDescription
r }
	Left FilePath
e -> FilePath -> Either FilePath ProjectDescription
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ProjectDescription)
-> FilePath -> Either FilePath ProjectDescription
forall a b. (a -> b) -> a -> b
$ FilePath
"Parse failed: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e
	where
		toLibrary :: Library -> Library
toLibrary Library
lib = [[Path]] -> Info -> Library
Library ((ModuleName -> [Path]) -> [ModuleName] -> [[Path]]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Path) -> [FilePath] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path
pack ([FilePath] -> [Path])
-> (ModuleName -> [FilePath]) -> ModuleName -> [Path]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [FilePath]
components) ([ModuleName] -> [[Path]]) -> [ModuleName] -> [[Path]]
forall a b. (a -> b) -> a -> b
$ Library -> [ModuleName]
PD.exposedModules Library
lib) (BuildInfo -> Info
toInfo (BuildInfo -> Info) -> BuildInfo -> Info
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
PD.libBuildInfo Library
lib)
		toExecutable :: Executable -> Executable
toExecutable Executable
exe = Path -> Path -> Info -> Executable
Executable (UnqualComponentName -> Path
componentName (UnqualComponentName -> Path) -> UnqualComponentName -> Path
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
PD.exeName Executable
exe) (FilePath -> Path
fromFilePath (FilePath -> Path) -> FilePath -> Path
forall a b. (a -> b) -> a -> b
$ Executable -> FilePath
PD.modulePath Executable
exe) (BuildInfo -> Info
toInfo (BuildInfo -> Info) -> BuildInfo -> Info
forall a b. (a -> b) -> a -> b
$ Executable -> BuildInfo
PD.buildInfo Executable
exe)
		toTest :: TestSuite -> Test
toTest TestSuite
test = Path -> Bool -> Maybe Path -> Info -> Test
Test (UnqualComponentName -> Path
componentName (UnqualComponentName -> Path) -> UnqualComponentName -> Path
forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
PD.testName TestSuite
test) (TestSuite -> Bool
testSuiteEnabled TestSuite
test) ((FilePath -> Path) -> Maybe FilePath -> Maybe Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Path
fromFilePath Maybe FilePath
mainFile) (BuildInfo -> Info
toInfo (BuildInfo -> Info) -> BuildInfo -> Info
forall a b. (a -> b) -> a -> b
$ TestSuite -> BuildInfo
PD.testBuildInfo TestSuite
test) where
			mainFile :: Maybe FilePath
mainFile = case TestSuite -> TestSuiteInterface
PD.testInterface TestSuite
test of
				PD.TestSuiteExeV10 Version
_ FilePath
fpath -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fpath
				PD.TestSuiteLibV09 Version
_ ModuleName
mname -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
PD.toFilePath ModuleName
mname
				TestSuiteInterface
_ -> Maybe FilePath
forall a. Maybe a
Nothing
		toInfo :: BuildInfo -> Info
toInfo BuildInfo
info = Info :: [Path]
-> Maybe Language
-> [Extension]
-> [Path]
-> [Path]
-> [[Path]]
-> Info
Info {
			_infoDepends :: [Path]
_infoDepends = (Dependency -> Path) -> [Dependency] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Path
pkgName (BuildInfo -> [Dependency]
PD.targetBuildDepends BuildInfo
info),
			_infoLanguage :: Maybe Language
_infoLanguage = BuildInfo -> Maybe Language
PD.defaultLanguage BuildInfo
info,
			_infoExtensions :: [Extension]
_infoExtensions = BuildInfo -> [Extension]
PD.defaultExtensions BuildInfo
info [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [Extension]
PD.otherExtensions BuildInfo
info [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [Extension]
PD.oldExtensions BuildInfo
info,
			_infoGHCOptions :: [Path]
_infoGHCOptions = [Path] -> ([FilePath] -> [Path]) -> Maybe [FilePath] -> [Path]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((FilePath -> Path) -> [FilePath] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path
pack) (Maybe [FilePath] -> [Path]) -> Maybe [FilePath] -> [Path]
forall a b. (a -> b) -> a -> b
$ CompilerFlavor
-> [(CompilerFlavor, [FilePath])] -> Maybe [FilePath]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CompilerFlavor
GHC (BuildInfo -> [(CompilerFlavor, [FilePath])]
pkgOptions BuildInfo
info),
			_infoSourceDirs :: [Path]
_infoSourceDirs = (FilePath -> Path) -> [FilePath] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path
pack ([FilePath] -> [Path]) -> [FilePath] -> [Path]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
PD.hsSourceDirs BuildInfo
info,
			_infoOtherModules :: [[Path]]
_infoOtherModules = (ModuleName -> [Path]) -> [ModuleName] -> [[Path]]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Path) -> [FilePath] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path
pack ([FilePath] -> [Path])
-> (ModuleName -> [FilePath]) -> ModuleName -> [Path]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [FilePath]
components) (BuildInfo -> [ModuleName]
PD.otherModules BuildInfo
info) }

#if MIN_VERSION_Cabal(3,0,0)
		pkgOptions :: BuildInfo -> [(CompilerFlavor, [FilePath])]
pkgOptions = PerCompilerFlavor [FilePath] -> [(CompilerFlavor, [FilePath])]
forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor [FilePath] -> [(CompilerFlavor, [FilePath])])
-> (BuildInfo -> PerCompilerFlavor [FilePath])
-> BuildInfo
-> [(CompilerFlavor, [FilePath])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> PerCompilerFlavor [FilePath]
PD.options
#else
		pkgOptions = PD.options
#endif

		pkgName :: P.Dependency -> Text
		pkgName :: Dependency -> Path
pkgName = FilePath -> Path
pack (FilePath -> Path)
-> (Dependency -> FilePath) -> Dependency -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
P.unPackageName (PackageName -> FilePath)
-> (Dependency -> PackageName) -> Dependency -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PackageName
P.depPkgName

		flattenDescr :: PD.GenericPackageDescription -> PD.PackageDescription
		flattenDescr :: GenericPackageDescription -> PackageDescription
flattenDescr GenericPackageDescription
gpkg = PackageDescription
pkg {
			library :: Maybe Library
PD.library = ((CondTree ConfVar [Dependency] Library -> Library)
 -> Maybe (CondTree ConfVar [Dependency] Library) -> Maybe Library)
-> Maybe (CondTree ConfVar [Dependency] Library)
-> (CondTree ConfVar [Dependency] Library -> Library)
-> Maybe Library
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CondTree ConfVar [Dependency] Library -> Library)
-> Maybe (CondTree ConfVar [Dependency] Library) -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (CondTree ConfVar [Dependency] Library)
mlib ((CondTree ConfVar [Dependency] Library -> Library)
 -> Maybe Library)
-> (CondTree ConfVar [Dependency] Library -> Library)
-> Maybe Library
forall a b. (a -> b) -> a -> b
$ ([Dependency] -> Library -> Library)
-> CondTree ConfVar [Dependency] Library -> Library
forall a c v. Monoid a => (c -> a -> a) -> CondTree v c a -> a
flattenCondTree
				((Library -> BuildInfo)
-> (BuildInfo -> Library -> Library)
-> [Dependency]
-> Library
-> Library
forall a.
(a -> BuildInfo) -> (BuildInfo -> a -> a) -> [Dependency] -> a -> a
insertInfo Library -> BuildInfo
PD.libBuildInfo (\BuildInfo
i Library
l -> Library
l { libBuildInfo :: BuildInfo
PD.libBuildInfo = BuildInfo
i })),
			executables :: [Executable]
PD.executables = (((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  -> Executable)
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)]
 -> [Executable])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> Executable)
-> [Executable]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> Executable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [Executable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
mexes (((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  -> Executable)
 -> [Executable])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> Executable)
-> [Executable]
forall a b. (a -> b) -> a -> b
$
				(CondTree ConfVar [Dependency] Executable -> Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, Executable)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Dependency] -> Executable -> Executable)
-> CondTree ConfVar [Dependency] Executable -> Executable
forall a c v. Monoid a => (c -> a -> a) -> CondTree v c a -> a
flattenCondTree ((Executable -> BuildInfo)
-> (BuildInfo -> Executable -> Executable)
-> [Dependency]
-> Executable
-> Executable
forall a.
(a -> BuildInfo) -> (BuildInfo -> a -> a) -> [Dependency] -> a -> a
insertInfo Executable -> BuildInfo
PD.buildInfo (\BuildInfo
i Executable
l -> Executable
l { buildInfo :: BuildInfo
PD.buildInfo = BuildInfo
i }))) ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> (UnqualComponentName, Executable))
-> ((UnqualComponentName, Executable) -> Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Executable
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
				(\(UnqualComponentName
n, Executable
e) -> Executable
e { exeName :: UnqualComponentName
PD.exeName = UnqualComponentName
n }),
			testSuites :: [TestSuite]
PD.testSuites = (((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  -> TestSuite)
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> [TestSuite])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> TestSuite)
-> [TestSuite]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [TestSuite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
mtests (((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  -> TestSuite)
 -> [TestSuite])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> TestSuite)
-> [TestSuite]
forall a b. (a -> b) -> a -> b
$
				(CondTree ConfVar [Dependency] TestSuite -> TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, TestSuite)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Dependency] -> TestSuite -> TestSuite)
-> CondTree ConfVar [Dependency] TestSuite -> TestSuite
forall a c v. Monoid a => (c -> a -> a) -> CondTree v c a -> a
flattenCondTree ((TestSuite -> BuildInfo)
-> (BuildInfo -> TestSuite -> TestSuite)
-> [Dependency]
-> TestSuite
-> TestSuite
forall a.
(a -> BuildInfo) -> (BuildInfo -> a -> a) -> [Dependency] -> a -> a
insertInfo TestSuite -> BuildInfo
PD.testBuildInfo (\BuildInfo
i TestSuite
l -> TestSuite
l { testBuildInfo :: BuildInfo
PD.testBuildInfo = BuildInfo
i }))) ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> (UnqualComponentName, TestSuite))
-> ((UnqualComponentName, TestSuite) -> TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> TestSuite
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
				(\(UnqualComponentName
n, TestSuite
t) -> TestSuite
t { testName :: UnqualComponentName
PD.testName = UnqualComponentName
n }) }
			where
				pkg :: PackageDescription
pkg = GenericPackageDescription -> PackageDescription
PD.packageDescription GenericPackageDescription
gpkg
				mlib :: Maybe (CondTree ConfVar [Dependency] Library)
mlib = GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
PD.condLibrary GenericPackageDescription
gpkg
				mexes :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
mexes = GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
PD.condExecutables GenericPackageDescription
gpkg
				mtests :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
mtests = GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
PD.condTestSuites GenericPackageDescription
gpkg

				insertInfo :: (a -> PD.BuildInfo) -> (PD.BuildInfo -> a -> a) -> [P.Dependency] -> a -> a
				insertInfo :: (a -> BuildInfo) -> (BuildInfo -> a -> a) -> [Dependency] -> a -> a
insertInfo a -> BuildInfo
f BuildInfo -> a -> a
s [Dependency]
deps' a
x = BuildInfo -> a -> a
s ((a -> BuildInfo
f a
x) { targetBuildDepends :: [Dependency]
PD.targetBuildDepends = [Dependency]
deps' }) a
x

-- | Read project info from .cabal
readProject :: FilePath -> IO Project
readProject :: FilePath -> IO Project
readProject FilePath
file' = do
	FilePath
source <- FilePath -> IO FilePath
readFile FilePath
file'
	FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
source Int -> IO Project -> IO Project
`seq` (FilePath -> IO Project)
-> (ProjectDescription -> IO Project)
-> Either FilePath ProjectDescription
-> IO Project
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (HsDevError -> IO Project
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> IO Project)
-> (FilePath -> HsDevError) -> FilePath -> IO Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> HsDevError
InspectCabalError FilePath
file') (Project -> IO Project
forall (m :: * -> *) a. Monad m => a -> m a
return (Project -> IO Project)
-> (ProjectDescription -> Project)
-> ProjectDescription
-> IO Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectDescription -> Project
mkProject) (Either FilePath ProjectDescription -> IO Project)
-> Either FilePath ProjectDescription -> IO Project
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ProjectDescription
analyzeCabal FilePath
source
	where
		mkProject :: ProjectDescription -> Project
mkProject ProjectDescription
desc = (FilePath -> Project
project FilePath
file') {
			_projectDescription :: Maybe ProjectDescription
_projectDescription = ProjectDescription -> Maybe ProjectDescription
forall a. a -> Maybe a
Just ProjectDescription
desc }

-- | Load project description
loadProject :: Project -> IO Project
loadProject :: Project -> IO Project
loadProject Project
p
	| Maybe ProjectDescription -> Bool
forall a. Maybe a -> Bool
isJust (Project -> Maybe ProjectDescription
_projectDescription Project
p) = Project -> IO Project
forall (m :: * -> *) a. Monad m => a -> m a
return Project
p
	| Bool
otherwise = do
		Project
p' <- FilePath -> IO Project
readProject (Project -> Path
_projectCabal Project
p Path -> Getting FilePath Path FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath Path FilePath
Lens' Path FilePath
path)
		Project -> IO Project
forall (m :: * -> *) a. Monad m => a -> m a
return (Project -> IO Project) -> Project -> IO Project
forall a b. (a -> b) -> a -> b
$ ASetter Project Project BuildTool BuildTool
-> BuildTool -> Project -> Project
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Project Project BuildTool BuildTool
Lens' Project BuildTool
projectBuildTool (Getting BuildTool Project BuildTool -> Project -> BuildTool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildTool Project BuildTool
Lens' Project BuildTool
projectBuildTool Project
p) Project
p'

-- | Extensions for target
withExtensions :: a -> Info -> Extensions a
withExtensions :: a -> Info -> Extensions a
withExtensions a
x Info
i = Extensions :: forall a. [Extension] -> [Path] -> a -> Extensions a
Extensions {
	_extensions :: [Extension]
_extensions = Info -> [Extension]
_infoExtensions Info
i,
	_ghcOptions :: [Path]
_ghcOptions = Info -> [Path]
_infoGHCOptions Info
i,
	_entity :: a
_entity = a
x }

-- | Check if source related to target, source must be relative to project directory
fileInTarget :: Path -> Info -> Bool
fileInTarget :: Path -> Info -> Bool
fileInTarget Path
src Info
info = (Path -> Bool) -> [Path] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Path -> Path -> Bool
`isParent` Path
src) ([Path] -> Bool) -> [Path] -> Bool
forall a b. (a -> b) -> a -> b
$ Getting [Path] Info [Path] -> Info -> [Path]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Path] Info [Path]
Lens Info Info [Path] [Path]
infoSourceDirsDef Info
info

-- | Get first target for source file
fileTarget :: Project -> Path -> Maybe Info
fileTarget :: Project -> Path -> Maybe Info
fileTarget Project
p Path
f = [Info] -> Maybe Info
forall a. [a] -> Maybe a
listToMaybe ([Info] -> Maybe Info) -> [Info] -> Maybe Info
forall a b. (a -> b) -> a -> b
$ Project -> Path -> [Info]
fileTargets Project
p Path
f

-- | Get possible targets for source file
-- There can be many candidates in case of module related to several executables or tests
fileTargets :: Project -> Path -> [Info]
fileTargets :: Project -> Path -> [Info]
fileTargets Project
p Path
f = case (Executable -> Bool) -> [Executable] -> [Executable]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Path -> Path -> Bool
`isParent` Path
f') (Path -> Bool) -> (Executable -> Path) -> Executable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Path Executable Path -> Executable -> Path
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Path Executable Path
Lens' Executable Path
executablePath) [Executable]
exes of
	[] -> (Info -> Bool) -> [Info] -> [Info]
forall a. (a -> Bool) -> [a] -> [a]
filter (Path
f' Path -> Info -> Bool
`fileInTarget`) (Project
p Project -> Getting (Endo [Info]) Project Info -> [Info]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Maybe ProjectDescription
 -> Const (Endo [Info]) (Maybe ProjectDescription))
-> Project -> Const (Endo [Info]) Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription
  -> Const (Endo [Info]) (Maybe ProjectDescription))
 -> Project -> Const (Endo [Info]) Project)
-> ((Info -> Const (Endo [Info]) Info)
    -> Maybe ProjectDescription
    -> Const (Endo [Info]) (Maybe ProjectDescription))
-> Getting (Endo [Info]) Project Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Const (Endo [Info]) ProjectDescription)
-> Maybe ProjectDescription
-> Const (Endo [Info]) (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Const (Endo [Info]) ProjectDescription)
 -> Maybe ProjectDescription
 -> Const (Endo [Info]) (Maybe ProjectDescription))
-> ((Info -> Const (Endo [Info]) Info)
    -> ProjectDescription -> Const (Endo [Info]) ProjectDescription)
-> (Info -> Const (Endo [Info]) Info)
-> Maybe ProjectDescription
-> Const (Endo [Info]) (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Info -> Const (Endo [Info]) Info)
-> ProjectDescription -> Const (Endo [Info]) ProjectDescription
Traversal' ProjectDescription Info
infos)
	[Executable]
exes' -> (Executable -> Info) -> [Executable] -> [Info]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> Info
_executableBuildInfo [Executable]
exes'
	where
		f' :: Path
f' = Path -> Path -> Path
relPathTo (Project -> Path
_projectPath Project
p) Path
f
		exes :: [Executable]
exes = Project
p Project
-> Getting [Executable] Project [Executable] -> [Executable]
forall s a. s -> Getting a s a -> a
^. (Maybe ProjectDescription
 -> Const [Executable] (Maybe ProjectDescription))
-> Project -> Const [Executable] Project
Lens' Project (Maybe ProjectDescription)
projectDescription ((Maybe ProjectDescription
  -> Const [Executable] (Maybe ProjectDescription))
 -> Project -> Const [Executable] Project)
-> (([Executable] -> Const [Executable] [Executable])
    -> Maybe ProjectDescription
    -> Const [Executable] (Maybe ProjectDescription))
-> Getting [Executable] Project [Executable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectDescription -> Const [Executable] ProjectDescription)
-> Maybe ProjectDescription
-> Const [Executable] (Maybe ProjectDescription)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProjectDescription -> Const [Executable] ProjectDescription)
 -> Maybe ProjectDescription
 -> Const [Executable] (Maybe ProjectDescription))
-> (([Executable] -> Const [Executable] [Executable])
    -> ProjectDescription -> Const [Executable] ProjectDescription)
-> ([Executable] -> Const [Executable] [Executable])
-> Maybe ProjectDescription
-> Const [Executable] (Maybe ProjectDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Executable] -> Const [Executable] [Executable])
-> ProjectDescription -> Const [Executable] ProjectDescription
Lens' ProjectDescription [Executable]
projectExecutables

-- | Finds source dir file belongs to
findSourceDir :: Project -> Path -> Maybe (Extensions Path)
findSourceDir :: Project -> Path -> Maybe (Extensions Path)
findSourceDir Project
p Path
f = do
	Info
info <- [Info] -> Maybe Info
forall a. [a] -> Maybe a
listToMaybe ([Info] -> Maybe Info) -> [Info] -> Maybe Info
forall a b. (a -> b) -> a -> b
$ Project -> Path -> [Info]
fileTargets Project
p Path
f
	(Path -> Extensions Path) -> Maybe Path -> Maybe (Extensions Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path -> Info -> Extensions Path
forall a. a -> Info -> Extensions a
`withExtensions` Info
info) (Maybe Path -> Maybe (Extensions Path))
-> Maybe Path -> Maybe (Extensions Path)
forall a b. (a -> b) -> a -> b
$ [Path] -> Maybe Path
forall a. [a] -> Maybe a
listToMaybe ([Path] -> Maybe Path) -> [Path] -> Maybe Path
forall a b. (a -> b) -> a -> b
$ (Path -> Bool) -> [Path] -> [Path]
forall a. (a -> Bool) -> [a] -> [a]
filter (Path -> Path -> Bool
`isParent` Path
f) ([Path] -> [Path]) -> [Path] -> [Path]
forall a b. (a -> b) -> a -> b
$ (Path -> Path) -> [Path] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map (Project -> Path
_projectPath Project
p Path -> Path -> Path
`subPath`) (Info
info Info -> Getting [Path] Info [Path] -> [Path]
forall s a. s -> Getting a s a -> a
^. Getting [Path] Info [Path]
Lens Info Info [Path] [Path]
infoSourceDirsDef)

-- | Returns source dirs for library, executables and tests
sourceDirs :: ProjectDescription -> [Extensions Path]
sourceDirs :: ProjectDescription -> [Extensions Path]
sourceDirs = [Extensions Path] -> [Extensions Path]
forall a. Ord a => [a] -> [a]
ordNub ([Extensions Path] -> [Extensions Path])
-> (ProjectDescription -> [Extensions Path])
-> ProjectDescription
-> [Extensions Path]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Info -> [Extensions Path]) -> [Info] -> [Extensions Path]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Info -> [Extensions Path]
dirs ([Info] -> [Extensions Path])
-> (ProjectDescription -> [Info])
-> ProjectDescription
-> [Extensions Path]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Info -> Const (Endo [Info]) Info)
 -> ProjectDescription -> Const (Endo [Info]) ProjectDescription)
-> ProjectDescription -> [Info]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Info -> Const (Endo [Info]) Info)
-> ProjectDescription -> Const (Endo [Info]) ProjectDescription
Traversal' ProjectDescription Info
infos where
	dirs :: Info -> [Extensions Path]
dirs Info
i = (Path -> Extensions Path) -> [Path] -> [Extensions Path]
forall a b. (a -> b) -> [a] -> [b]
map (Path -> Info -> Extensions Path
forall a. a -> Info -> Extensions a
`withExtensions` Info
i) (Info
i Info -> Getting [Path] Info [Path] -> [Path]
forall s a. s -> Getting a s a -> a
^. Getting [Path] Info [Path]
Lens Info Info [Path] [Path]
infoSourceDirsDef)

-- | Get options for specific target
targetOpts :: Info -> [String]
targetOpts :: Info -> [FilePath]
targetOpts Info
info' = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
	[FilePath
"-i" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path -> FilePath
unpack Path
s | Path
s <- Info -> [Path]
_infoSourceDirs Info
info'],
	Extensions () -> [FilePath]
forall a. Extensions a -> [FilePath]
extensionsOpts (Extensions () -> [FilePath]) -> Extensions () -> [FilePath]
forall a b. (a -> b) -> a -> b
$ () -> Info -> Extensions ()
forall a. a -> Info -> Extensions a
withExtensions () Info
info',
	[FilePath
"-package " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path -> FilePath
unpack Path
p | Path
p <- Info -> [Path]
_infoDepends Info
info']]

-- | Extension as flag name
showExtension :: Extension -> String
showExtension :: Extension -> FilePath
showExtension = Extension -> FilePath
forall a. Pretty a => a -> FilePath
display

-- | Convert -Xext to ext
flagExtension :: String -> Maybe String
flagExtension :: FilePath -> Maybe FilePath
flagExtension = FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"-X"

-- | Convert ext to -Xext
extensionFlag :: String -> String
extensionFlag :: FilePath -> FilePath
extensionFlag = (FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)

-- | Extensions as opts to GHC
extensionsOpts :: Extensions a -> [String]
extensionsOpts :: Extensions a -> [FilePath]
extensionsOpts Extensions a
e = (Extension -> FilePath) -> [Extension] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
extensionFlag (FilePath -> FilePath)
-> (Extension -> FilePath) -> Extension -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> FilePath
showExtension) (Extensions a -> [Extension]
forall a. Extensions a -> [Extension]
_extensions Extensions a
e) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (Path -> FilePath) -> [Path] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Path -> FilePath
unpack (Extensions a -> [Path]
forall a. Extensions a -> [Path]
_ghcOptions Extensions a
e)