module Distribution.Client.CmdHaddockProject
( haddockProjectCommand
, haddockProjectAction
) where
import Prelude ()
import Data.Bool (bool)
import Distribution.Client.Compat.Prelude hiding (get)
import qualified Distribution.Client.CmdBuild as CmdBuild
import qualified Distribution.Client.CmdHaddock as CmdHaddock
import Distribution.Client.DistDirLayout (DistDirLayout(..)
,CabalDirLayout(..)
,StoreDirLayout(..))
import Distribution.Client.InstallPlan (foldPlanPackage)
import qualified Distribution.Client.InstallPlan as InstallPlan
import qualified Distribution.Client.NixStyleOptions as NixStyleOptions
import Distribution.Client.ProjectOrchestration
(AvailableTarget(..)
,AvailableTargetStatus(..)
,CurrentCommand(..)
,ProjectBaseContext(..)
,ProjectBuildContext(..)
,TargetSelector(..)
,printPlan
,pruneInstallPlanToTargets
,resolveTargets
,runProjectPreBuildPhase
,selectComponentTargetBasic)
import Distribution.Client.ProjectPlanning (ElaboratedConfiguredPackage(..)
,ElaboratedInstallPlan
,ElaboratedSharedConfig(..)
,TargetAction(..))
import Distribution.Client.ProjectPlanning.Types
(elabDistDirParams)
import Distribution.Client.Setup (GlobalFlags(..)
,ConfigFlags(..))
import Distribution.Client.ScriptUtils (AcceptNoTargets(..)
,TargetContext(..)
,updateContextAndWriteProjectFile
,withContextAndSelectors)
import Distribution.Client.TargetProblem (TargetProblem(..))
import Distribution.Types.PackageId (pkgName)
import Distribution.Types.PackageName (unPackageName)
import Distribution.Types.Version (mkVersion)
import Distribution.Types.VersionRange (orLaterVersion)
import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (..))
import Distribution.Simple.Command
( CommandUI(..) )
import Distribution.Simple.Compiler
( Compiler (..) )
import Distribution.Simple.Flag
( Flag(..)
, flagElim
, flagToList
, fromFlag
, fromFlagOrDefault
)
import Distribution.Simple.InstallDirs
( toPathTemplate )
import Distribution.Simple.Haddock (createHaddockIndex)
import Distribution.Simple.Utils
( die', createDirectoryIfMissingVerbose
, copyDirectoryRecursive, warn )
import Distribution.Simple.Program.Builtin
( haddockProgram )
import Distribution.Simple.Program.Db
( addKnownProgram, reconfigurePrograms, requireProgramVersion )
import Distribution.Simple.Setup
( HaddockFlags(..), defaultHaddockFlags
, HaddockProjectFlags(..)
, Visibility(..)
, haddockProjectCommand
)
import Distribution.Verbosity as Verbosity
( normal )
import System.FilePath ( takeDirectory, normalise, (</>), (<.>) )
import System.Directory ( doesDirectoryExist, doesFileExist )
haddockProjectAction :: HaddockProjectFlags -> [String] -> GlobalFlags -> IO ()
haddockProjectAction :: HaddockProjectFlags -> [String] -> GlobalFlags -> IO ()
haddockProjectAction HaddockProjectFlags
flags [String]
_extraArgs GlobalFlags
globalFlags = do
let outputDir :: String
outputDir = String -> String
normalise forall a b. (a -> b) -> a -> b
$ forall a. WithCallStack (Flag a -> a)
fromFlag (HaddockProjectFlags -> Flag String
haddockProjectDir HaddockProjectFlags
flags)
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
outputDir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int
2::Int) forall a. Ord a => a -> a -> Bool
<=
( forall b a. b -> (a -> b) -> Flag a -> b
flagElim Int
0 (forall a. a -> a -> Bool -> a
bool Int
0 Int
1) (HaddockProjectFlags -> Flag Bool
haddockProjectHackage HaddockProjectFlags
flags)
forall a. Num a => a -> a -> a
+ forall b a. b -> (a -> b) -> Flag a -> b
flagElim Int
0 (forall a. a -> a -> Bool -> a
bool Int
0 Int
1) (HaddockProjectFlags -> Flag Bool
haddockProjectLocal HaddockProjectFlags
flags)
forall a. Num a => a -> a -> a
+ forall b a. b -> (a -> b) -> Flag a -> b
flagElim Int
0 (forall a b. a -> b -> a
const Int
1) (HaddockProjectFlags -> Flag String
haddockProjectHtmlLocation HaddockProjectFlags
flags)
)) forall a b. (a -> b) -> a -> b
$
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"Options `--local`, `--hackage` and `--html-location` are mutually exclusive`"
Verbosity -> String -> IO ()
warn Verbosity
verbosity String
"haddock-project command is experimental, it might break in the future"
let haddockFlags :: HaddockFlags
haddockFlags = HaddockFlags
defaultHaddockFlags
{ haddockHtml :: Flag Bool
haddockHtml = forall a. a -> Flag a
Flag Bool
True
, haddockBaseUrl :: Flag String
haddockBaseUrl = if Bool
localStyle
then forall a. a -> Flag a
Flag String
".."
else forall a. Flag a
NoFlag
, haddockProgramPaths :: [(String, String)]
haddockProgramPaths = HaddockProjectFlags -> [(String, String)]
haddockProjectProgramPaths HaddockProjectFlags
flags
, haddockProgramArgs :: [(String, [String])]
haddockProgramArgs = HaddockProjectFlags -> [(String, [String])]
haddockProjectProgramArgs HaddockProjectFlags
flags
, haddockHtmlLocation :: Flag String
haddockHtmlLocation = if forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (HaddockProjectFlags -> Flag Bool
haddockProjectHackage HaddockProjectFlags
flags)
then forall a. a -> Flag a
Flag String
"https://hackage.haskell.org/package/$pkg-$version/docs"
else HaddockProjectFlags -> Flag String
haddockProjectHtmlLocation HaddockProjectFlags
flags
, haddockHoogle :: Flag Bool
haddockHoogle = HaddockProjectFlags -> Flag Bool
haddockProjectHoogle HaddockProjectFlags
flags
, haddockExecutables :: Flag Bool
haddockExecutables = HaddockProjectFlags -> Flag Bool
haddockProjectExecutables HaddockProjectFlags
flags
, haddockTestSuites :: Flag Bool
haddockTestSuites = HaddockProjectFlags -> Flag Bool
haddockProjectTestSuites HaddockProjectFlags
flags
, haddockBenchmarks :: Flag Bool
haddockBenchmarks = HaddockProjectFlags -> Flag Bool
haddockProjectBenchmarks HaddockProjectFlags
flags
, haddockForeignLibs :: Flag Bool
haddockForeignLibs = HaddockProjectFlags -> Flag Bool
haddockProjectForeignLibs HaddockProjectFlags
flags
, haddockInternal :: Flag Bool
haddockInternal = HaddockProjectFlags -> Flag Bool
haddockProjectInternal HaddockProjectFlags
flags
, haddockCss :: Flag String
haddockCss = HaddockProjectFlags -> Flag String
haddockProjectCss HaddockProjectFlags
flags
, haddockLinkedSource :: Flag Bool
haddockLinkedSource = if Bool
localOrHackage
then forall a. a -> Flag a
Flag Bool
True
else HaddockProjectFlags -> Flag Bool
haddockProjectLinkedSource HaddockProjectFlags
flags
, haddockQuickJump :: Flag Bool
haddockQuickJump = if Bool
localOrHackage
then forall a. a -> Flag a
Flag Bool
True
else HaddockProjectFlags -> Flag Bool
haddockProjectQuickJump HaddockProjectFlags
flags
, haddockHscolourCss :: Flag String
haddockHscolourCss = HaddockProjectFlags -> Flag String
haddockProjectHscolourCss HaddockProjectFlags
flags
, haddockContents :: Flag PathTemplate
haddockContents = if Bool
localStyle then forall a. a -> Flag a
Flag (String -> PathTemplate
toPathTemplate String
"../index.html")
else forall a. Flag a
NoFlag
, haddockIndex :: Flag PathTemplate
haddockIndex = if Bool
localStyle then forall a. a -> Flag a
Flag (String -> PathTemplate
toPathTemplate String
"../doc-index.html")
else forall a. Flag a
NoFlag
, haddockKeepTempFiles :: Flag Bool
haddockKeepTempFiles= HaddockProjectFlags -> Flag Bool
haddockProjectKeepTempFiles HaddockProjectFlags
flags
, haddockVerbosity :: Flag Verbosity
haddockVerbosity = HaddockProjectFlags -> Flag Verbosity
haddockProjectVerbosity HaddockProjectFlags
flags
, haddockLib :: Flag String
haddockLib = HaddockProjectFlags -> Flag String
haddockProjectLib HaddockProjectFlags
flags
}
nixFlags :: NixStyleFlags ClientHaddockFlags
nixFlags = (forall flags. CommandUI flags -> flags
commandDefaultFlags CommandUI (NixStyleFlags ClientHaddockFlags)
CmdHaddock.haddockCommand)
{ haddockFlags :: HaddockFlags
NixStyleOptions.haddockFlags = HaddockFlags
haddockFlags
, configFlags :: ConfigFlags
NixStyleOptions.configFlags =
(forall a. NixStyleFlags a -> ConfigFlags
NixStyleOptions.configFlags (forall flags. CommandUI flags -> flags
commandDefaultFlags CommandUI (NixStyleFlags BuildFlags)
CmdBuild.buildCommand))
{ configVerbosity :: Flag Verbosity
configVerbosity = HaddockProjectFlags -> Flag Verbosity
haddockProjectVerbosity HaddockProjectFlags
flags }
}
forall a b.
AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags a
-> [String]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
-> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors AcceptNoTargets
RejectNoTargets forall a. Maybe a
Nothing NixStyleFlags ClientHaddockFlags
nixFlags [String
"all"] GlobalFlags
globalFlags CurrentCommand
HaddockCommand forall a b. (a -> b) -> a -> b
$ \TargetContext
targetCtx ProjectBaseContext
ctx [TargetSelector]
targetSelectors -> do
ProjectBaseContext
baseCtx <- case TargetContext
targetCtx of
TargetContext
ProjectContext -> forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
TargetContext
GlobalContext -> forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
ScriptContext String
path Executable
exemeta -> ProjectBaseContext -> String -> Executable -> IO ProjectBaseContext
updateContextAndWriteProjectFile ProjectBaseContext
ctx String
path Executable
exemeta
let distLayout :: DistDirLayout
distLayout = ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
baseCtx
cabalLayout :: CabalDirLayout
cabalLayout = ProjectBaseContext -> CabalDirLayout
cabalDirLayout ProjectBaseContext
baseCtx
ProjectBuildContext
buildCtx <-
Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
-> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
runProjectPreBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx forall a b. (a -> b) -> a -> b
$ \ElaboratedInstallPlan
elaboratedPlan -> do
TargetsMap
targets <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall x a. Show x => [x] -> IO a
reportTargetProblems forall (m :: * -> *) a. Monad m => a -> m a
return
forall a b. (a -> b) -> a -> b
$ forall err.
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem ()) [k]
selectPackageTargets
forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic
ElaboratedInstallPlan
elaboratedPlan
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors
let elaboratedPlan' :: ElaboratedInstallPlan
elaboratedPlan' = TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets
TargetAction
TargetActionBuild
TargetsMap
targets
ElaboratedInstallPlan
elaboratedPlan
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
elaboratedPlan', TargetsMap
targets)
Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO ()
printPlan Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx
let elaboratedPlan :: ElaboratedInstallPlan
elaboratedPlan :: ElaboratedInstallPlan
elaboratedPlan = ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanOriginal ProjectBuildContext
buildCtx
sharedConfig :: ElaboratedSharedConfig
sharedConfig :: ElaboratedSharedConfig
sharedConfig = ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared ProjectBuildContext
buildCtx
pkgs :: [Either InstalledPackageInfo ElaboratedConfiguredPackage ]
pkgs :: [Either InstalledPackageInfo ElaboratedConfiguredPackage]
pkgs = ElaboratedInstallPlan
-> [Either InstalledPackageInfo ElaboratedConfiguredPackage]
matchingPackages ElaboratedInstallPlan
elaboratedPlan
ProgramDb
progs <- Verbosity
-> [(String, String)]
-> [(String, [String])]
-> ProgramDb
-> IO ProgramDb
reconfigurePrograms Verbosity
verbosity
(HaddockProjectFlags -> [(String, String)]
haddockProjectProgramPaths HaddockProjectFlags
flags)
(HaddockProjectFlags -> [(String, [String])]
haddockProjectProgramArgs HaddockProjectFlags
flags)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> ProgramDb -> ProgramDb
addKnownProgram Program
haddockProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs
forall a b. (a -> b) -> a -> b
$ ElaboratedSharedConfig
sharedConfig
let sharedConfig' :: ElaboratedSharedConfig
sharedConfig' = ElaboratedSharedConfig
sharedConfig { pkgConfigCompilerProgs :: ProgramDb
pkgConfigCompilerProgs = ProgramDb
progs }
(ConfiguredProgram, Version, ProgramDb)
_ <- Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
Verbosity
verbosity Program
haddockProgram
(Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
2,Int
26,Int
1])) ProgramDb
progs
NixStyleFlags ClientHaddockFlags
-> [String] -> GlobalFlags -> IO ()
CmdHaddock.haddockAction
NixStyleFlags ClientHaddockFlags
nixFlags
[String
"all"]
GlobalFlags
globalFlags
[(String, String, Visibility)]
packageInfos <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Either InstalledPackageInfo ElaboratedConfiguredPackage]
pkgs forall a b. (a -> b) -> a -> b
$ \Either InstalledPackageInfo ElaboratedConfiguredPackage
pkg ->
case Either InstalledPackageInfo ElaboratedConfiguredPackage
pkg of
Left InstalledPackageInfo
_ | Bool -> Bool
not Bool
localStyle ->
forall (m :: * -> *) a. Monad m => a -> m a
return []
Left InstalledPackageInfo
package -> do
let packageName :: String
packageName = PackageName -> String
unPackageName (PackageIdentifier -> PackageName
pkgName forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo -> PackageIdentifier
sourcePackageId InstalledPackageInfo
package)
destDir :: String
destDir = String
outputDir String -> String -> String
</> String
packageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (InstalledPackageInfo -> [String]
haddockInterfaces InstalledPackageInfo
package) forall a b. (a -> b) -> a -> b
$ \String
interfacePath -> do
let docDir :: String
docDir = String -> String
takeDirectory String
interfacePath
Bool
a <- String -> IO Bool
doesFileExist String
interfacePath
case Bool
a of
Bool
True -> Verbosity -> String -> String -> IO ()
copyDirectoryRecursive Verbosity
verbosity String
docDir String
destDir
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ( String
packageName
, String
interfacePath
, Visibility
Hidden
))
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Right ElaboratedConfiguredPackage
package ->
case ElaboratedConfiguredPackage -> Bool
elabLocalToProject ElaboratedConfiguredPackage
package of
Bool
True -> do
let distDirParams :: DistDirParams
distDirParams = ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
sharedConfig' ElaboratedConfiguredPackage
package
buildDir :: String
buildDir = DistDirLayout -> DistDirParams -> String
distBuildDirectory DistDirLayout
distLayout DistDirParams
distDirParams
packageName :: String
packageName = PackageName -> String
unPackageName (PackageIdentifier -> PackageName
pkgName forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId ElaboratedConfiguredPackage
package)
let docDir :: String
docDir = String
buildDir
String -> String -> String
</> String
"doc" String -> String -> String
</> String
"html"
String -> String -> String
</> String
packageName
destDir :: String
destDir = String
outputDir String -> String -> String
</> String
packageName
interfacePath :: String
interfacePath = String
destDir
String -> String -> String
</> String
packageName String -> String -> String
<.> String
"haddock"
Bool
a <- String -> IO Bool
doesDirectoryExist String
docDir
case Bool
a of
Bool
True -> Verbosity -> String -> String -> IO ()
copyDirectoryRecursive Verbosity
verbosity String
docDir String
destDir
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [( String
packageName
, String
interfacePath
, Visibility
Visible
)]
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Bool
False | Bool -> Bool
not Bool
localStyle ->
forall (m :: * -> *) a. Monad m => a -> m a
return []
Bool
False -> do
let packageName :: String
packageName = PackageName -> String
unPackageName (PackageIdentifier -> PackageName
pkgName forall a b. (a -> b) -> a -> b
$ ElaboratedConfiguredPackage -> PackageIdentifier
elabPkgSourceId ElaboratedConfiguredPackage
package)
packageDir :: String
packageDir = StoreDirLayout -> CompilerId -> UnitId -> String
storePackageDirectory (CabalDirLayout -> StoreDirLayout
cabalStoreDirLayout CabalDirLayout
cabalLayout)
(Compiler -> CompilerId
compilerId (ElaboratedSharedConfig -> Compiler
pkgConfigCompiler ElaboratedSharedConfig
sharedConfig'))
(ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
package)
docDir :: String
docDir = String
packageDir String -> String -> String
</> String
"share" String -> String -> String
</> String
"doc" String -> String -> String
</> String
"html"
destDir :: String
destDir = String
outputDir String -> String -> String
</> String
packageName
interfacePath :: String
interfacePath = String
destDir
String -> String -> String
</> String
packageName String -> String -> String
<.> String
"haddock"
Bool
a <- String -> IO Bool
doesDirectoryExist String
docDir
case Bool
a of
Bool
True -> Verbosity -> String -> String -> IO ()
copyDirectoryRecursive Verbosity
verbosity String
docDir String
destDir
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [( String
packageName
, String
interfacePath
, Visibility
Hidden
)]
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return []
let flags' :: HaddockProjectFlags
flags' = HaddockProjectFlags
flags
{ haddockProjectDir :: Flag String
haddockProjectDir = forall a. a -> Flag a
Flag String
outputDir
, haddockProjectGenIndex :: Flag Bool
haddockProjectGenIndex = if Bool
localOrHackage
then forall a. a -> Flag a
Flag Bool
True
else HaddockProjectFlags -> Flag Bool
haddockProjectGenIndex HaddockProjectFlags
flags
, haddockProjectGenContents :: Flag Bool
haddockProjectGenContents = if Bool
localOrHackage
then forall a. a -> Flag a
Flag Bool
True
else HaddockProjectFlags -> Flag Bool
haddockProjectGenContents HaddockProjectFlags
flags
, haddockProjectQuickJump :: Flag Bool
haddockProjectQuickJump = if Bool
localOrHackage
then forall a. a -> Flag a
Flag Bool
True
else HaddockProjectFlags -> Flag Bool
haddockProjectQuickJump HaddockProjectFlags
flags
, haddockProjectLinkedSource :: Flag Bool
haddockProjectLinkedSource = HaddockFlags -> Flag Bool
haddockLinkedSource HaddockFlags
haddockFlags
, haddockProjectInterfaces :: Flag [(String, Maybe String, Maybe String, Visibility)]
haddockProjectInterfaces = forall a. a -> Flag a
Flag
[ ( String
interfacePath
, forall a. a -> Maybe a
Just String
packageName
, forall a. a -> Maybe a
Just String
packageName
, Visibility
visibility
)
| (String
packageName, String
interfacePath, Visibility
visibility) <- [(String, String, Visibility)]
packageInfos
]
}
Verbosity
-> ProgramDb
-> Compiler
-> Platform
-> HaddockProjectFlags
-> IO ()
createHaddockIndex Verbosity
verbosity
(ElaboratedSharedConfig -> ProgramDb
pkgConfigCompilerProgs ElaboratedSharedConfig
sharedConfig')
(ElaboratedSharedConfig -> Compiler
pkgConfigCompiler ElaboratedSharedConfig
sharedConfig')
(ElaboratedSharedConfig -> Platform
pkgConfigPlatform ElaboratedSharedConfig
sharedConfig')
HaddockProjectFlags
flags'
where
verbosity :: Verbosity
verbosity = forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (HaddockProjectFlags -> Flag Verbosity
haddockProjectVerbosity HaddockProjectFlags
flags)
localStyle :: Bool
localStyle =
let local :: Bool
local = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (HaddockProjectFlags -> Flag Bool
haddockProjectLocal HaddockProjectFlags
flags)
hackage :: Bool
hackage = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (HaddockProjectFlags -> Flag Bool
haddockProjectHackage HaddockProjectFlags
flags)
location :: Bool
location = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (forall a b. a -> b -> a
const Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HaddockProjectFlags -> Flag String
haddockProjectHtmlLocation HaddockProjectFlags
flags)
in Bool
local Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hackage Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
location
Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
local Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hackage Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
location
localOrHackage :: Bool
localOrHackage =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Flag a -> [a]
flagToList (HaddockProjectFlags -> Flag Bool
haddockProjectLocal HaddockProjectFlags
flags)
forall a. [a] -> [a] -> [a]
++ forall a. Flag a -> [a]
flagToList (HaddockProjectFlags -> Flag Bool
haddockProjectHackage HaddockProjectFlags
flags)
reportTargetProblems :: Show x => [x] -> IO a
reportTargetProblems :: forall x a. Show x => [x] -> IO a
reportTargetProblems =
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show
selectPackageTargets :: TargetSelector
-> [AvailableTarget k]
-> Either (TargetProblem ()) [k]
selectPackageTargets :: forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem ()) [k]
selectPackageTargets TargetSelector
_ [AvailableTarget k]
ts = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\AvailableTarget k
t -> case forall k. AvailableTarget k -> AvailableTargetStatus k
availableTargetStatus AvailableTarget k
t of
TargetBuildable k
k TargetRequested
_ | forall k. AvailableTarget k -> Bool
availableTargetLocalToProject AvailableTarget k
t
-> forall a. a -> Maybe a
Just k
k
AvailableTargetStatus k
_ -> forall a. Maybe a
Nothing)
[AvailableTarget k]
ts
matchingPackages :: ElaboratedInstallPlan
-> [Either InstalledPackageInfo ElaboratedConfiguredPackage]
matchingPackages :: ElaboratedInstallPlan
-> [Either InstalledPackageInfo ElaboratedConfiguredPackage]
matchingPackages =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
foldPlanPackage forall a b. a -> Either a b
Left forall a b. b -> Either a b
Right)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList