{-# LANGUAGE OverloadedStrings, CPP #-}
module HsDev.Project (
module HsDev.Project.Types,
infoSourceDirsDef, targetFiles, projectTargetFiles,
analyzeCabal,
readProject, loadProject,
withExtensions,
fileInTarget, fileTarget, fileTargets, findSourceDir, sourceDirs,
targetOpts,
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
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 }
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")
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
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
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 }
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'
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 }
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
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
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
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)
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)
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']]
showExtension :: Extension -> String
showExtension :: Extension -> FilePath
showExtension = Extension -> FilePath
forall a. Pretty a => a -> FilePath
display
flagExtension :: String -> Maybe String
flagExtension :: FilePath -> Maybe FilePath
flagExtension = FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"-X"
extensionFlag :: String -> String
extensionFlag :: FilePath -> FilePath
extensionFlag = (FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)
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)