{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Stack.Dot
( dot
, listDependencies
, DotOpts (..)
, DotPayload (..)
, ListDepsOpts (..)
, ListDepsFormat (..)
, ListDepsFormatOpts (..)
, resolveDependencies
, printGraph
, pruneGraph
) where
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as LBC8
import qualified Data.Foldable as F
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Traversable as T
import Distribution.License ( License (BSD3), licenseFromSPDX )
import qualified Distribution.PackageDescription as PD
import qualified Distribution.SPDX.License as SPDX
import Distribution.Text ( display )
import Distribution.Types.PackageName ( mkPackageName )
import qualified Path
import RIO.Process ( HasProcessContext (..) )
import Stack.Build ( loadPackage )
import Stack.Build.Installed ( getInstalled, toInstallMap )
import Stack.Build.Source
import Stack.Build.Target( NeedTargets (..), parseTargets )
import Stack.Constants
import Stack.Package
import Stack.Prelude hiding ( Display (..), pkgName, loadPackage )
import qualified Stack.Prelude ( pkgName )
import Stack.Runners
import Stack.SourceMap
import Stack.Types.Build
import Stack.Types.Compiler ( wantedToActual )
import Stack.Types.Config
import Stack.Types.GhcPkgId
import Stack.Types.SourceMap
data DotException
= DependencyNotFoundBug GhcPkgId
| PackageNotFoundBug PackageName
deriving (Int -> DotException -> ShowS
[DotException] -> ShowS
DotException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DotException] -> ShowS
$cshowList :: [DotException] -> ShowS
show :: DotException -> [Char]
$cshow :: DotException -> [Char]
showsPrec :: Int -> DotException -> ShowS
$cshowsPrec :: Int -> DotException -> ShowS
Show, Typeable)
instance Exception DotException where
displayException :: DotException -> [Char]
displayException (DependencyNotFoundBug GhcPkgId
depId) = [Char] -> ShowS
bugReport [Char]
"[S-7071]" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"Expected to find "
, GhcPkgId -> [Char]
ghcPkgIdString GhcPkgId
depId
, [Char]
" in global DB."
]
displayException (PackageNotFoundBug PackageName
pkgName) = [Char] -> ShowS
bugReport [Char]
"[S-7151]" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"The '"
, PackageName -> [Char]
packageNameString PackageName
pkgName
, [Char]
"' package was not found in any of the dependency sources."
]
data DotOpts = DotOpts
{ DotOpts -> Bool
dotIncludeExternal :: !Bool
, DotOpts -> Bool
dotIncludeBase :: !Bool
, DotOpts -> Maybe Int
dotDependencyDepth :: !(Maybe Int)
, DotOpts -> Set PackageName
dotPrune :: !(Set PackageName)
, DotOpts -> [Text]
dotTargets :: [Text]
, DotOpts -> Map ApplyCLIFlag (Map FlagName Bool)
dotFlags :: !(Map ApplyCLIFlag (Map FlagName Bool))
, DotOpts -> Bool
dotTestTargets :: Bool
, DotOpts -> Bool
dotBenchTargets :: Bool
, DotOpts -> Bool
dotGlobalHints :: Bool
}
data ListDepsFormatOpts = ListDepsFormatOpts
{ ListDepsFormatOpts -> Text
listDepsSep :: !Text
, ListDepsFormatOpts -> Bool
listDepsLicense :: !Bool
}
data ListDepsFormat = ListDepsText ListDepsFormatOpts
| ListDepsTree ListDepsFormatOpts
| ListDepsJSON
| ListDepsConstraints
data ListDepsOpts = ListDepsOpts
{ ListDepsOpts -> ListDepsFormat
listDepsFormat :: !ListDepsFormat
, ListDepsOpts -> DotOpts
listDepsDotOpts :: !DotOpts
}
dot :: DotOpts -> RIO Runner ()
dot :: DotOpts -> RIO Runner ()
dot DotOpts
dotOpts = do
(Set PackageName
localNames, Map PackageName (Set PackageName, DotPayload)
prunedGraph) <- DotOpts
-> RIO
Runner
(Set PackageName, Map PackageName (Set PackageName, DotPayload))
createPrunedDependencyGraph DotOpts
dotOpts
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
DotOpts
-> Set PackageName
-> Map PackageName (Set PackageName, DotPayload)
-> m ()
printGraph DotOpts
dotOpts Set PackageName
localNames Map PackageName (Set PackageName, DotPayload)
prunedGraph
data DotPayload = DotPayload
{ DotPayload -> Maybe Version
payloadVersion :: Maybe Version
, DotPayload -> Maybe (Either License License)
payloadLicense :: Maybe (Either SPDX.License License)
, DotPayload -> Maybe PackageLocation
payloadLocation :: Maybe PackageLocation
} deriving (DotPayload -> DotPayload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotPayload -> DotPayload -> Bool
$c/= :: DotPayload -> DotPayload -> Bool
== :: DotPayload -> DotPayload -> Bool
$c== :: DotPayload -> DotPayload -> Bool
Eq, Int -> DotPayload -> ShowS
[DotPayload] -> ShowS
DotPayload -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DotPayload] -> ShowS
$cshowList :: [DotPayload] -> ShowS
show :: DotPayload -> [Char]
$cshow :: DotPayload -> [Char]
showsPrec :: Int -> DotPayload -> ShowS
$cshowsPrec :: Int -> DotPayload -> ShowS
Show)
createPrunedDependencyGraph
:: DotOpts
-> RIO Runner (Set PackageName, Map PackageName (Set PackageName, DotPayload))
createPrunedDependencyGraph :: DotOpts
-> RIO
Runner
(Set PackageName, Map PackageName (Set PackageName, DotPayload))
createPrunedDependencyGraph DotOpts
dotOpts = forall a. DotOpts -> RIO DotConfig a -> RIO Runner a
withDotConfig DotOpts
dotOpts forall a b. (a -> b) -> a -> b
$ do
Set PackageName
localNames <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMWanted -> Map PackageName ProjectPackage
smwProject forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> SMWanted
bcSMWanted)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Creating dependency graph"
Map PackageName (Set PackageName, DotPayload)
resultGraph <- DotOpts
-> RIO DotConfig (Map PackageName (Set PackageName, DotPayload))
createDependencyGraph DotOpts
dotOpts
let pkgsToPrune :: Set PackageName
pkgsToPrune = if DotOpts -> Bool
dotIncludeBase DotOpts
dotOpts
then DotOpts -> Set PackageName
dotPrune DotOpts
dotOpts
else forall a. Ord a => a -> Set a -> Set a
Set.insert PackageName
"base" (DotOpts -> Set PackageName
dotPrune DotOpts
dotOpts)
prunedGraph :: Map PackageName (Set PackageName, DotPayload)
prunedGraph = forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Eq a) =>
f PackageName
-> g PackageName
-> Map PackageName (Set PackageName, a)
-> Map PackageName (Set PackageName, a)
pruneGraph Set PackageName
localNames Set PackageName
pkgsToPrune Map PackageName (Set PackageName, DotPayload)
resultGraph
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Returning pruned dependency graph"
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set PackageName
localNames, Map PackageName (Set PackageName, DotPayload)
prunedGraph)
createDependencyGraph
:: DotOpts
-> RIO DotConfig (Map PackageName (Set PackageName, DotPayload))
createDependencyGraph :: DotOpts
-> RIO DotConfig (Map PackageName (Set PackageName, DotPayload))
createDependencyGraph DotOpts
dotOpts = do
SourceMap
sourceMap <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => Lens' env SourceMap
sourceMapL
[LocalPackage]
locals <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sourceMap) forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage
let graph :: Map PackageName (Set PackageName, DotPayload)
graph = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ DotOpts
-> [LocalPackage] -> [(PackageName, (Set PackageName, DotPayload))]
projectPackageDependencies DotOpts
dotOpts (forall a. (a -> Bool) -> [a] -> [a]
filter LocalPackage -> Bool
lpWanted [LocalPackage]
locals)
[DumpPackage]
globalDump <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall s a. (s -> a) -> SimpleGetter s a
to DotConfig -> [DumpPackage]
dcGlobalDump
let globalDumpMap :: Map PackageName DumpPackage
globalDumpMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\DumpPackage
dp -> (PackageIdentifier -> PackageName
Stack.Prelude.pkgName (DumpPackage -> PackageIdentifier
dpPackageIdent DumpPackage
dp), DumpPackage
dp)) [DumpPackage]
globalDump
globalIdMap :: Map GhcPkgId PackageIdentifier
globalIdMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\DumpPackage
dp -> (DumpPackage -> GhcPkgId
dpGhcPkgId DumpPackage
dp, DumpPackage -> PackageIdentifier
dpPackageIdent DumpPackage
dp)) [DumpPackage]
globalDump
let depLoader :: PackageName -> RIO DotConfig (Set PackageName, DotPayload)
depLoader = SourceMap
-> Map PackageName DumpPackage
-> Map GhcPkgId PackageIdentifier
-> (PackageName
-> Version
-> PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO DotConfig (Set PackageName, DotPayload))
-> PackageName
-> RIO DotConfig (Set PackageName, DotPayload)
createDepLoader SourceMap
sourceMap Map PackageName DumpPackage
globalDumpMap Map GhcPkgId PackageIdentifier
globalIdMap forall {env}.
(HasBuildConfig env, HasSourceMap env) =>
PackageName
-> Version
-> PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO env (Set PackageName, DotPayload)
loadPackageDeps
loadPackageDeps :: PackageName
-> Version
-> PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO env (Set PackageName, DotPayload)
loadPackageDeps PackageName
name Version
version PackageLocationImmutable
loc Map FlagName Bool
flags [Text]
ghcOptions [Text]
cabalConfigOpts
| PackageName
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char] -> PackageName
mkPackageName [Char]
"rts", [Char] -> PackageName
mkPackageName [Char]
"ghc"] =
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( forall a. Set a
Set.empty
, Maybe Version
-> Maybe (Either License License)
-> Maybe PackageLocation
-> DotPayload
DotPayload (forall a. a -> Maybe a
Just Version
version) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right License
BSD3) forall a. Maybe a
Nothing )
| Bool
otherwise =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Package -> Set PackageName
packageAllDeps forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PackageLocationImmutable -> Package -> DotPayload
makePayload PackageLocationImmutable
loc)
(forall env.
(HasBuildConfig env, HasSourceMap env) =>
PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO env Package
loadPackage PackageLocationImmutable
loc Map FlagName Bool
flags [Text]
ghcOptions [Text]
cabalConfigOpts)
forall (m :: * -> *).
(Applicative m, Monad m) =>
Maybe Int
-> Map PackageName (Set PackageName, DotPayload)
-> (PackageName -> m (Set PackageName, DotPayload))
-> m (Map PackageName (Set PackageName, DotPayload))
resolveDependencies (DotOpts -> Maybe Int
dotDependencyDepth DotOpts
dotOpts) Map PackageName (Set PackageName, DotPayload)
graph PackageName -> RIO DotConfig (Set PackageName, DotPayload)
depLoader
where
makePayload :: PackageLocationImmutable -> Package -> DotPayload
makePayload PackageLocationImmutable
loc Package
pkg = Maybe Version
-> Maybe (Either License License)
-> Maybe PackageLocation
-> DotPayload
DotPayload (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Package -> Version
packageVersion Package
pkg)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Package -> Either License License
packageLicense Package
pkg)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PackageLocationImmutable -> PackageLocation
PLImmutable PackageLocationImmutable
loc)
listDependencies
:: ListDepsOpts
-> RIO Runner ()
listDependencies :: ListDepsOpts -> RIO Runner ()
listDependencies ListDepsOpts
opts = do
let dotOpts :: DotOpts
dotOpts = ListDepsOpts -> DotOpts
listDepsDotOpts ListDepsOpts
opts
(Set PackageName
pkgs, Map PackageName (Set PackageName, DotPayload)
resultGraph) <- DotOpts
-> RIO
Runner
(Set PackageName, Map PackageName (Set PackageName, DotPayload))
createPrunedDependencyGraph DotOpts
dotOpts
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case ListDepsOpts -> ListDepsFormat
listDepsFormat ListDepsOpts
opts of
ListDepsTree ListDepsFormatOpts
treeOpts ->
Text -> IO ()
Text.putStrLn Text
"Packages"
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ListDepsFormatOpts
-> DotOpts
-> Int
-> [Int]
-> Set PackageName
-> Map PackageName (Set PackageName, DotPayload)
-> IO ()
printTree ListDepsFormatOpts
treeOpts DotOpts
dotOpts Int
0 [] (ListDepsOpts -> Set PackageName -> Set PackageName
treeRoots ListDepsOpts
opts Set PackageName
pkgs) Map PackageName (Set PackageName, DotPayload)
resultGraph
ListDepsFormat
ListDepsJSON -> Set PackageName
-> Map PackageName (Set PackageName, DotPayload) -> IO ()
printJSON Set PackageName
pkgs Map PackageName (Set PackageName, DotPayload)
resultGraph
ListDepsText ListDepsFormatOpts
textOpts ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (Text -> ListDepsFormatOpts -> PackageName -> DotPayload -> IO ()
go Text
"" ListDepsFormatOpts
textOpts) (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PackageName (Set PackageName, DotPayload)
resultGraph)
ListDepsFormat
ListDepsConstraints -> do
let constraintOpts :: ListDepsFormatOpts
constraintOpts = Text -> Bool -> ListDepsFormatOpts
ListDepsFormatOpts Text
" ==" Bool
False
Text -> IO ()
Text.putStrLn Text
"constraints:"
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (Text -> ListDepsFormatOpts -> PackageName -> DotPayload -> IO ()
go Text
" , " ListDepsFormatOpts
constraintOpts)
(forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PackageName (Set PackageName, DotPayload)
resultGraph)
where
go :: Text -> ListDepsFormatOpts -> PackageName -> DotPayload -> IO ()
go Text
prefix ListDepsFormatOpts
lineOpts PackageName
name DotPayload
payload =
Text -> IO ()
Text.putStrLn forall a b. (a -> b) -> a -> b
$ Text
prefix forall a. Semigroup a => a -> a -> a
<> ListDepsFormatOpts -> PackageName -> DotPayload -> Text
listDepsLine ListDepsFormatOpts
lineOpts PackageName
name DotPayload
payload
data DependencyTree =
DependencyTree (Set PackageName)
(Map PackageName (Set PackageName, DotPayload))
instance ToJSON DependencyTree where
toJSON :: DependencyTree -> Value
toJSON (DependencyTree Set PackageName
_ Map PackageName (Set PackageName, DotPayload)
dependencyMap) =
forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b) -> Map k a -> [b]
foldToList PackageName -> (Set PackageName, DotPayload) -> Value
dependencyToJSON Map PackageName (Set PackageName, DotPayload)
dependencyMap
foldToList :: (k -> a -> b) -> Map k a -> [b]
foldToList :: forall k a b. (k -> a -> b) -> Map k a -> [b]
foldToList k -> a -> b
f = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\k
k a
a [b]
bs -> [b]
bs forall a. [a] -> [a] -> [a]
++ [k -> a -> b
f k
k a
a]) []
dependencyToJSON :: PackageName -> (Set PackageName, DotPayload) -> Value
dependencyToJSON :: PackageName -> (Set PackageName, DotPayload) -> Value
dependencyToJSON PackageName
pkg (Set PackageName
deps, DotPayload
payload) =
let fieldsAlwaysPresent :: [Pair]
fieldsAlwaysPresent = [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PackageName -> [Char]
packageNameString PackageName
pkg
, Key
"license" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DotPayload -> Text
licenseText DotPayload
payload
, Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DotPayload -> Text
versionText DotPayload
payload
, Key
"dependencies" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> [Char]
packageNameString Set PackageName
deps
]
loc :: [Pair]
loc = forall a. [Maybe a] -> [a]
catMaybes
[(Key
"location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageLocation -> Value
pkgLocToJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DotPayload -> Maybe PackageLocation
payloadLocation DotPayload
payload]
in [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [Pair]
fieldsAlwaysPresent forall a. [a] -> [a] -> [a]
++ [Pair]
loc
pkgLocToJSON :: PackageLocation -> Value
pkgLocToJSON :: PackageLocation -> Value
pkgLocToJSON (PLMutable (ResolvedPath RelFilePath
_ Path Abs Dir
dir)) = [Pair] -> Value
object
[ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"project package" :: Text)
, Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ([Char]
"file://" forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> [Char]
Path.toFilePath Path Abs Dir
dir)
]
pkgLocToJSON (PLImmutable (PLIHackage PackageIdentifier
pkgid BlobKey
_ TreeKey
_)) = [Pair] -> Value
object
[ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"hackage" :: Text)
, Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ([Char]
"https://hackage.haskell.org/package/" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
display PackageIdentifier
pkgid)
]
pkgLocToJSON (PLImmutable (PLIArchive Archive
archive PackageMetadata
_)) =
let url :: Text
url = case Archive -> ArchiveLocation
archiveLocation Archive
archive of
ALUrl Text
u -> Text
u
ALFilePath (ResolvedPath RelFilePath
_ Path Abs File
path) ->
[Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"file://" forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> [Char]
Path.toFilePath Path Abs File
path
in [Pair] -> Value
object
[ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"archive" :: Text)
, Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
url
, Key
"sha256" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Archive -> SHA256
archiveHash Archive
archive
, Key
"size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Archive -> FileSize
archiveSize Archive
archive
]
pkgLocToJSON (PLImmutable (PLIRepo Repo
repo PackageMetadata
_)) = [Pair] -> Value
object
[ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= case Repo -> RepoType
repoType Repo
repo of
RepoType
RepoGit -> Text
"git" :: Text
RepoType
RepoHg -> Text
"hg" :: Text
, Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repo -> Text
repoUrl Repo
repo
, Key
"commit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repo -> Text
repoCommit Repo
repo
, Key
"subdir" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Repo -> Text
repoSubdir Repo
repo
]
printJSON :: Set PackageName
-> Map PackageName (Set PackageName, DotPayload)
-> IO ()
printJSON :: Set PackageName
-> Map PackageName (Set PackageName, DotPayload) -> IO ()
printJSON Set PackageName
pkgs Map PackageName (Set PackageName, DotPayload)
dependencyMap =
ByteString -> IO ()
LBC8.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ Set PackageName
-> Map PackageName (Set PackageName, DotPayload) -> DependencyTree
DependencyTree Set PackageName
pkgs Map PackageName (Set PackageName, DotPayload)
dependencyMap
treeRoots :: ListDepsOpts -> Set PackageName -> Set PackageName
treeRoots :: ListDepsOpts -> Set PackageName -> Set PackageName
treeRoots ListDepsOpts
opts Set PackageName
projectPackages' =
let targets :: [Text]
targets = DotOpts -> [Text]
dotTargets forall a b. (a -> b) -> a -> b
$ ListDepsOpts -> DotOpts
listDepsDotOpts ListDepsOpts
opts
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
targets
then Set PackageName
projectPackages'
else forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> PackageName
mkPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack) [Text]
targets
printTree :: ListDepsFormatOpts
-> DotOpts
-> Int
-> [Int]
-> Set PackageName
-> Map PackageName (Set PackageName, DotPayload)
-> IO ()
printTree :: ListDepsFormatOpts
-> DotOpts
-> Int
-> [Int]
-> Set PackageName
-> Map PackageName (Set PackageName, DotPayload)
-> IO ()
printTree ListDepsFormatOpts
opts DotOpts
dotOpts Int
depth [Int]
remainingDepsCounts Set PackageName
packages Map PackageName (Set PackageName, DotPayload)
dependencyMap =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
F.sequence_ forall a b. (a -> b) -> a -> b
$ forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> PackageName -> IO ()
go (forall {a}. Set a -> Seq a
toSeq Set PackageName
packages)
where
toSeq :: Set a -> Seq a
toSeq = forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList
go :: Int -> PackageName -> IO ()
go Int
index PackageName
name =
let newDepsCounts :: [Int]
newDepsCounts = [Int]
remainingDepsCounts forall a. [a] -> [a] -> [a]
++ [forall a. Set a -> Int
Set.size Set PackageName
packages forall a. Num a => a -> a -> a
- Int
index forall a. Num a => a -> a -> a
- Int
1]
in case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName (Set PackageName, DotPayload)
dependencyMap of
Just (Set PackageName
deps, DotPayload
payload) -> do
ListDepsFormatOpts
-> DotOpts
-> Int
-> [Int]
-> Set PackageName
-> DotPayload
-> PackageName
-> IO ()
printTreeNode ListDepsFormatOpts
opts DotOpts
dotOpts Int
depth [Int]
newDepsCounts Set PackageName
deps DotPayload
payload PackageName
name
if forall a. a -> Maybe a
Just Int
depth forall a. Eq a => a -> a -> Bool
== DotOpts -> Maybe Int
dotDependencyDepth DotOpts
dotOpts
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else ListDepsFormatOpts
-> DotOpts
-> Int
-> [Int]
-> Set PackageName
-> Map PackageName (Set PackageName, DotPayload)
-> IO ()
printTree ListDepsFormatOpts
opts DotOpts
dotOpts (Int
depth forall a. Num a => a -> a -> a
+ Int
1) [Int]
newDepsCounts Set PackageName
deps
Map PackageName (Set PackageName, DotPayload)
dependencyMap
Maybe (Set PackageName, DotPayload)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
printTreeNode :: ListDepsFormatOpts
-> DotOpts
-> Int
-> [Int]
-> Set PackageName
-> DotPayload
-> PackageName
-> IO ()
printTreeNode :: ListDepsFormatOpts
-> DotOpts
-> Int
-> [Int]
-> Set PackageName
-> DotPayload
-> PackageName
-> IO ()
printTreeNode ListDepsFormatOpts
opts DotOpts
dotOpts Int
depth [Int]
remainingDepsCounts Set PackageName
deps DotPayload
payload PackageName
name =
let remainingDepth :: Int
remainingDepth = forall a. a -> Maybe a -> a
fromMaybe Int
999 (DotOpts -> Maybe Int
dotDependencyDepth DotOpts
dotOpts) forall a. Num a => a -> a -> a
- Int
depth
hasDeps :: Bool
hasDeps = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set PackageName
deps
in Text -> IO ()
Text.putStrLn forall a b. (a -> b) -> a -> b
$
Text -> [Int] -> Bool -> Int -> Text
treeNodePrefix Text
"" [Int]
remainingDepsCounts Bool
hasDeps Int
remainingDepth forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<>
ListDepsFormatOpts -> PackageName -> DotPayload -> Text
listDepsLine ListDepsFormatOpts
opts PackageName
name DotPayload
payload
treeNodePrefix :: Text -> [Int] -> Bool -> Int -> Text
treeNodePrefix :: Text -> [Int] -> Bool -> Int -> Text
treeNodePrefix Text
t [] Bool
_ Int
_ = Text
t
treeNodePrefix Text
t [Int
0] Bool
True Int
0 = Text
t forall a. Semigroup a => a -> a -> a
<> Text
"└──"
treeNodePrefix Text
t [Int
_] Bool
True Int
0 = Text
t forall a. Semigroup a => a -> a -> a
<> Text
"├──"
treeNodePrefix Text
t [Int
0] Bool
True Int
_ = Text
t forall a. Semigroup a => a -> a -> a
<> Text
"└─┬"
treeNodePrefix Text
t [Int
_] Bool
True Int
_ = Text
t forall a. Semigroup a => a -> a -> a
<> Text
"├─┬"
treeNodePrefix Text
t [Int
0] Bool
False Int
_ = Text
t forall a. Semigroup a => a -> a -> a
<> Text
"└──"
treeNodePrefix Text
t [Int
_] Bool
False Int
_ = Text
t forall a. Semigroup a => a -> a -> a
<> Text
"├──"
treeNodePrefix Text
t (Int
0:[Int]
ns) Bool
d Int
remainingDepth = Text -> [Int] -> Bool -> Int -> Text
treeNodePrefix (Text
t forall a. Semigroup a => a -> a -> a
<> Text
" ") [Int]
ns Bool
d Int
remainingDepth
treeNodePrefix Text
t (Int
_:[Int]
ns) Bool
d Int
remainingDepth = Text -> [Int] -> Bool -> Int -> Text
treeNodePrefix (Text
t forall a. Semigroup a => a -> a -> a
<> Text
"│ ") [Int]
ns Bool
d Int
remainingDepth
listDepsLine :: ListDepsFormatOpts -> PackageName -> DotPayload -> Text
listDepsLine :: ListDepsFormatOpts -> PackageName -> DotPayload -> Text
listDepsLine ListDepsFormatOpts
opts PackageName
name DotPayload
payload =
[Char] -> Text
Text.pack (PackageName -> [Char]
packageNameString PackageName
name) forall a. Semigroup a => a -> a -> a
<> ListDepsFormatOpts -> Text
listDepsSep ListDepsFormatOpts
opts forall a. Semigroup a => a -> a -> a
<>
ListDepsFormatOpts -> DotPayload -> Text
payloadText ListDepsFormatOpts
opts DotPayload
payload
payloadText :: ListDepsFormatOpts -> DotPayload -> Text
payloadText :: ListDepsFormatOpts -> DotPayload -> Text
payloadText ListDepsFormatOpts
opts DotPayload
payload =
if ListDepsFormatOpts -> Bool
listDepsLicense ListDepsFormatOpts
opts
then DotPayload -> Text
licenseText DotPayload
payload
else DotPayload -> Text
versionText DotPayload
payload
licenseText :: DotPayload -> Text
licenseText :: DotPayload -> Text
licenseText DotPayload
payload =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<unknown>" ([Char] -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> [Char]
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> License
licenseFromSPDX forall a. a -> a
id)
(DotPayload -> Maybe (Either License License)
payloadLicense DotPayload
payload)
versionText :: DotPayload -> Text
versionText :: DotPayload -> Text
versionText DotPayload
payload =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<unknown>" ([Char] -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> [Char]
display) (DotPayload -> Maybe Version
payloadVersion DotPayload
payload)
pruneGraph :: (F.Foldable f, F.Foldable g, Eq a)
=> f PackageName
-> g PackageName
-> Map PackageName (Set PackageName, a)
-> Map PackageName (Set PackageName, a)
pruneGraph :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Eq a) =>
f PackageName
-> g PackageName
-> Map PackageName (Set PackageName, a)
-> Map PackageName (Set PackageName, a)
pruneGraph f PackageName
dontPrune g PackageName
names =
forall a (f :: * -> *).
(Eq a, Foldable f) =>
f PackageName
-> Map PackageName (Set PackageName, a)
-> Map PackageName (Set PackageName, a)
pruneUnreachable f PackageName
dontPrune forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey (\PackageName
pkg (Set PackageName
pkgDeps,a
x) ->
if PackageName
pkg forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.elem` g PackageName
names
then forall a. Maybe a
Nothing
else let filtered :: Set PackageName
filtered = forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\PackageName
n -> PackageName
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.notElem` g PackageName
names) Set PackageName
pkgDeps
in if forall a. Set a -> Bool
Set.null Set PackageName
filtered Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set PackageName
pkgDeps)
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Set PackageName
filtered,a
x))
pruneUnreachable :: (Eq a, F.Foldable f)
=> f PackageName
-> Map PackageName (Set PackageName, a)
-> Map PackageName (Set PackageName, a)
pruneUnreachable :: forall a (f :: * -> *).
(Eq a, Foldable f) =>
f PackageName
-> Map PackageName (Set PackageName, a)
-> Map PackageName (Set PackageName, a)
pruneUnreachable f PackageName
dontPrune = forall a. Eq a => (a -> a) -> a -> a
fixpoint forall {b}.
Map PackageName (Set PackageName, b)
-> Map PackageName (Set PackageName, b)
prune
where
fixpoint :: Eq a => (a -> a) -> a -> a
fixpoint :: forall a. Eq a => (a -> a) -> a -> a
fixpoint a -> a
f a
v = if a -> a
f a
v forall a. Eq a => a -> a -> Bool
== a
v then a
v else forall a. Eq a => (a -> a) -> a -> a
fixpoint a -> a
f (a -> a
f a
v)
prune :: Map PackageName (Set PackageName, b)
-> Map PackageName (Set PackageName, b)
prune Map PackageName (Set PackageName, b)
graph' = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\PackageName
k (Set PackageName, b)
_ -> PackageName -> Bool
reachable PackageName
k) Map PackageName (Set PackageName, b)
graph'
where
reachable :: PackageName -> Bool
reachable PackageName
k = PackageName
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.elem` f PackageName
dontPrune Bool -> Bool -> Bool
|| PackageName
k forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageName
reachables
reachables :: Set PackageName
reachables = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PackageName (Set PackageName, b)
graph')
resolveDependencies
:: (Applicative m, Monad m)
=> Maybe Int
-> Map PackageName (Set PackageName, DotPayload)
-> (PackageName -> m (Set PackageName, DotPayload))
-> m (Map PackageName (Set PackageName, DotPayload))
resolveDependencies :: forall (m :: * -> *).
(Applicative m, Monad m) =>
Maybe Int
-> Map PackageName (Set PackageName, DotPayload)
-> (PackageName -> m (Set PackageName, DotPayload))
-> m (Map PackageName (Set PackageName, DotPayload))
resolveDependencies (Just Int
0) Map PackageName (Set PackageName, DotPayload)
graph PackageName -> m (Set PackageName, DotPayload)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Map PackageName (Set PackageName, DotPayload)
graph
resolveDependencies Maybe Int
limit Map PackageName (Set PackageName, DotPayload)
graph PackageName -> m (Set PackageName, DotPayload)
loadPackageDeps = do
let values :: Set PackageName
values = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map PackageName (Set PackageName, DotPayload)
graph)
keys :: Set PackageName
keys = forall k a. Map k a -> Set k
Map.keysSet Map PackageName (Set PackageName, DotPayload)
graph
next :: Set PackageName
next = forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set PackageName
values Set PackageName
keys
if forall a. Set a -> Bool
Set.null Set PackageName
next
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Map PackageName (Set PackageName, DotPayload)
graph
else do
[(PackageName, (Set PackageName, DotPayload))]
x <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (\PackageName
name -> (PackageName
name,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageName -> m (Set PackageName, DotPayload)
loadPackageDeps PackageName
name) (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Set PackageName
next)
forall (m :: * -> *).
(Applicative m, Monad m) =>
Maybe Int
-> Map PackageName (Set PackageName, DotPayload)
-> (PackageName -> m (Set PackageName, DotPayload))
-> m (Map PackageName (Set PackageName, DotPayload))
resolveDependencies (forall a. Num a => a -> a -> a
subtract Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
limit)
(forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall {a} {b} {b}. Ord a => (Set a, b) -> (Set a, b) -> (Set a, b)
unifier Map PackageName (Set PackageName, DotPayload)
graph (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PackageName, (Set PackageName, DotPayload))]
x))
PackageName -> m (Set PackageName, DotPayload)
loadPackageDeps
where
unifier :: (Set a, b) -> (Set a, b) -> (Set a, b)
unifier (Set a
pkgs1,b
v1) (Set a
pkgs2,b
_) = (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
pkgs1 Set a
pkgs2, b
v1)
createDepLoader
:: SourceMap
-> Map PackageName DumpPackage
-> Map GhcPkgId PackageIdentifier
-> (PackageName -> Version -> PackageLocationImmutable ->
Map FlagName Bool -> [Text] -> [Text] ->
RIO DotConfig (Set PackageName, DotPayload))
-> PackageName
-> RIO DotConfig (Set PackageName, DotPayload)
createDepLoader :: SourceMap
-> Map PackageName DumpPackage
-> Map GhcPkgId PackageIdentifier
-> (PackageName
-> Version
-> PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO DotConfig (Set PackageName, DotPayload))
-> PackageName
-> RIO DotConfig (Set PackageName, DotPayload)
createDepLoader SourceMap
sourceMap Map PackageName DumpPackage
globalDumpMap Map GhcPkgId PackageIdentifier
globalIdMap PackageName
-> Version
-> PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO DotConfig (Set PackageName, DotPayload)
loadPackageDeps PackageName
pkgName = do
forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ PackageName -> DotException
PackageNotFoundBug PackageName
pkgName)
(Maybe (RIO DotConfig (Set PackageName, DotPayload))
projectPackageDeps forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (RIO DotConfig (Set PackageName, DotPayload))
dependencyDeps forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (RIO DotConfig (Set PackageName, DotPayload))
globalDeps)
where
projectPackageDeps :: Maybe (RIO DotConfig (Set PackageName, DotPayload))
projectPackageDeps = forall {env}.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env (Set PackageName, DotPayload)
loadDeps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pkgName (SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sourceMap)
where
loadDeps :: ProjectPackage -> RIO env (Set PackageName, DotPayload)
loadDeps ProjectPackage
pp = do
Package
pkg <- forall env.
(HasBuildConfig env, HasSourceMap env) =>
CommonPackage -> RIO env Package
loadCommonPackage (ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> Set PackageName
packageAllDeps Package
pkg, Package -> Maybe PackageLocation -> DotPayload
payloadFromLocal Package
pkg forall a. Maybe a
Nothing)
dependencyDeps :: Maybe (RIO DotConfig (Set PackageName, DotPayload))
dependencyDeps =
DepPackage -> RIO DotConfig (Set PackageName, DotPayload)
loadDeps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pkgName (SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sourceMap)
where
loadDeps :: DepPackage -> RIO DotConfig (Set PackageName, DotPayload)
loadDeps DepPackage{dpLocation :: DepPackage -> PackageLocation
dpLocation=PLMutable ResolvedPath Dir
dir} = do
ProjectPackage
pp <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
mkProjectPackage PrintWarnings
YesPrintWarnings ResolvedPath Dir
dir Bool
False
Package
pkg <- forall env.
(HasBuildConfig env, HasSourceMap env) =>
CommonPackage -> RIO env Package
loadCommonPackage (ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> Set PackageName
packageAllDeps Package
pkg, Package -> Maybe PackageLocation -> DotPayload
payloadFromLocal Package
pkg (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ResolvedPath Dir -> PackageLocation
PLMutable ResolvedPath Dir
dir))
loadDeps dp :: DepPackage
dp@DepPackage{dpLocation :: DepPackage -> PackageLocation
dpLocation=PLImmutable PackageLocationImmutable
loc} = do
let common :: CommonPackage
common = DepPackage -> CommonPackage
dpCommon DepPackage
dp
GenericPackageDescription
gpd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD CommonPackage
common
let PackageIdentifier PackageName
name Version
version = PackageDescription -> PackageIdentifier
PD.package forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
PD.packageDescription GenericPackageDescription
gpd
flags :: Map FlagName Bool
flags = CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common
ghcOptions :: [Text]
ghcOptions = CommonPackage -> [Text]
cpGhcOptions CommonPackage
common
cabalConfigOpts :: [Text]
cabalConfigOpts = CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common
forall a. HasCallStack => Bool -> a -> a
assert
(PackageName
pkgName forall a. Eq a => a -> a -> Bool
== PackageName
name)
(PackageName
-> Version
-> PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO DotConfig (Set PackageName, DotPayload)
loadPackageDeps PackageName
pkgName Version
version PackageLocationImmutable
loc Map FlagName Bool
flags [Text]
ghcOptions [Text]
cabalConfigOpts)
globalDeps :: Maybe (RIO DotConfig (Set PackageName, DotPayload))
globalDeps =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. DumpPackage -> (Set PackageName, DotPayload)
getDepsFromDump forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pkgName Map PackageName DumpPackage
globalDumpMap
where
getDepsFromDump :: DumpPackage -> (Set PackageName, DotPayload)
getDepsFromDump DumpPackage
dump = (forall a. Ord a => [a] -> Set a
Set.fromList [PackageName]
deps, DumpPackage -> DotPayload
payloadFromDump DumpPackage
dump)
where
deps :: [PackageName]
deps = forall a b. (a -> b) -> [a] -> [b]
map GhcPkgId -> PackageName
ghcIdToPackageName (DumpPackage -> [GhcPkgId]
dpDepends DumpPackage
dump)
ghcIdToPackageName :: GhcPkgId -> PackageName
ghcIdToPackageName GhcPkgId
depId =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> a
impureThrow forall a b. (a -> b) -> a -> b
$ GhcPkgId -> DotException
DependencyNotFoundBug GhcPkgId
depId)
PackageIdentifier -> PackageName
Stack.Prelude.pkgName
(forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GhcPkgId
depId Map GhcPkgId PackageIdentifier
globalIdMap)
payloadFromLocal :: Package -> Maybe PackageLocation -> DotPayload
payloadFromLocal Package
pkg Maybe PackageLocation
loc =
Maybe Version
-> Maybe (Either License License)
-> Maybe PackageLocation
-> DotPayload
DotPayload (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Package -> Version
packageVersion Package
pkg)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Package -> Either License License
packageLicense Package
pkg)
Maybe PackageLocation
loc
payloadFromDump :: DumpPackage -> DotPayload
payloadFromDump DumpPackage
dp =
Maybe Version
-> Maybe (Either License License)
-> Maybe PackageLocation
-> DotPayload
DotPayload (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> Version
pkgVersion forall a b. (a -> b) -> a -> b
$ DumpPackage -> PackageIdentifier
dpPackageIdent DumpPackage
dp)
(forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DumpPackage -> Maybe License
dpLicense DumpPackage
dp)
forall a. Maybe a
Nothing
projectPackageDependencies
:: DotOpts
-> [LocalPackage]
-> [(PackageName, (Set PackageName, DotPayload))]
projectPackageDependencies :: DotOpts
-> [LocalPackage] -> [(PackageName, (Set PackageName, DotPayload))]
projectPackageDependencies DotOpts
dotOpts [LocalPackage]
locals =
forall a b. (a -> b) -> [a] -> [b]
map (\LocalPackage
lp -> let pkg :: Package
pkg = LocalPackage -> Package
localPackageToPackage LocalPackage
lp
pkgDir :: Path Abs Dir
pkgDir = forall b t. Path b t -> Path b Dir
Path.parent forall a b. (a -> b) -> a -> b
$ LocalPackage -> Path Abs File
lpCabalFile LocalPackage
lp
loc :: PackageLocation
loc = ResolvedPath Dir -> PackageLocation
PLMutable forall a b. (a -> b) -> a -> b
$ forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath Text
"N/A") Path Abs Dir
pkgDir
in (Package -> PackageName
packageName Package
pkg, (Package -> Set PackageName
deps Package
pkg, Package -> PackageLocation -> DotPayload
lpPayload Package
pkg PackageLocation
loc)))
[LocalPackage]
locals
where
deps :: Package -> Set PackageName
deps Package
pkg = if DotOpts -> Bool
dotIncludeExternal DotOpts
dotOpts
then forall a. Ord a => a -> Set a -> Set a
Set.delete (Package -> PackageName
packageName Package
pkg) (Package -> Set PackageName
packageAllDeps Package
pkg)
else forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set PackageName
localNames (Package -> Set PackageName
packageAllDeps Package
pkg)
localNames :: Set PackageName
localNames = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Package -> PackageName
packageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalPackage -> Package
lpPackage) [LocalPackage]
locals
lpPayload :: Package -> PackageLocation -> DotPayload
lpPayload Package
pkg PackageLocation
loc =
Maybe Version
-> Maybe (Either License License)
-> Maybe PackageLocation
-> DotPayload
DotPayload (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Package -> Version
packageVersion Package
pkg)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Package -> Either License License
packageLicense Package
pkg)
(forall a. a -> Maybe a
Just PackageLocation
loc)
printGraph :: (Applicative m, MonadIO m)
=> DotOpts
-> Set PackageName
-> Map PackageName (Set PackageName, DotPayload)
-> m ()
printGraph :: forall (m :: * -> *).
(Applicative m, MonadIO m) =>
DotOpts
-> Set PackageName
-> Map PackageName (Set PackageName, DotPayload)
-> m ()
printGraph DotOpts
dotOpts Set PackageName
locals Map PackageName (Set PackageName, DotPayload)
graph = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn Text
"strict digraph deps {"
forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadIO m) =>
DotOpts -> t PackageName -> m ()
printLocalNodes DotOpts
dotOpts Set PackageName
filteredLocals
forall (m :: * -> *).
MonadIO m =>
Map PackageName (Set PackageName, DotPayload) -> m ()
printLeaves Map PackageName (Set PackageName, DotPayload)
graph
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey forall (m :: * -> *).
MonadIO m =>
PackageName -> Set PackageName -> m ()
printEdges (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PackageName (Set PackageName, DotPayload)
graph))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn Text
"}"
where
filteredLocals :: Set PackageName
filteredLocals =
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\PackageName
local' -> PackageName
local' forall a. Ord a => a -> Set a -> Bool
`Set.notMember` DotOpts -> Set PackageName
dotPrune DotOpts
dotOpts) Set PackageName
locals
printLocalNodes :: (F.Foldable t, MonadIO m)
=> DotOpts
-> t PackageName
-> m ()
printLocalNodes :: forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadIO m) =>
DotOpts -> t PackageName -> m ()
printLocalNodes DotOpts
dotOpts t PackageName
locals =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (Text -> [Text] -> Text
Text.intercalate Text
"\n" [Text]
lpNodes)
where
applyStyle :: Text -> Text
applyStyle :: Text -> Text
applyStyle Text
n = if DotOpts -> Bool
dotIncludeExternal DotOpts
dotOpts
then Text
n forall a. Semigroup a => a -> a -> a
<> Text
" [style=dashed];"
else Text
n forall a. Semigroup a => a -> a -> a
<> Text
" [style=solid];"
lpNodes :: [Text]
lpNodes :: [Text]
lpNodes = forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
applyStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Text
nodeName) (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t PackageName
locals)
printLeaves :: MonadIO m
=> Map PackageName (Set PackageName, DotPayload)
-> m ()
printLeaves :: forall (m :: * -> *).
MonadIO m =>
Map PackageName (Set PackageName, DotPayload) -> m ()
printLeaves = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ forall (m :: * -> *). MonadIO m => PackageName -> m ()
printLeaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter forall a. Set a -> Bool
Set.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst
printEdges :: MonadIO m => PackageName -> Set PackageName -> m ()
printEdges :: forall (m :: * -> *).
MonadIO m =>
PackageName -> Set PackageName -> m ()
printEdges PackageName
package Set PackageName
deps = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Set PackageName
deps (forall (m :: * -> *).
MonadIO m =>
PackageName -> PackageName -> m ()
printEdge PackageName
package)
printEdge :: MonadIO m => PackageName -> PackageName -> m ()
printEdge :: forall (m :: * -> *).
MonadIO m =>
PackageName -> PackageName -> m ()
printEdge PackageName
from PackageName
to' =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn ([Text] -> Text
Text.concat [ PackageName -> Text
nodeName PackageName
from
, Text
" -> "
, PackageName -> Text
nodeName PackageName
to'
, Text
";" ])
nodeName :: PackageName -> Text
nodeName :: PackageName -> Text
nodeName PackageName
name = Text
"\"" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PackageName -> [Char]
packageNameString PackageName
name) forall a. Semigroup a => a -> a -> a
<> Text
"\""
printLeaf :: MonadIO m => PackageName -> m ()
printLeaf :: forall (m :: * -> *). MonadIO m => PackageName -> m ()
printLeaf PackageName
package = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Text.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.concat forall a b. (a -> b) -> a -> b
$
if PackageName -> Bool
isWiredIn PackageName
package
then [Text
"{rank=max; ", PackageName -> Text
nodeName PackageName
package, Text
" [shape=box]; };"]
else [Text
"{rank=max; ", PackageName -> Text
nodeName PackageName
package, Text
"; };"]
isWiredIn :: PackageName -> Bool
isWiredIn :: PackageName -> Bool
isWiredIn = (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageName
wiredInPackages)
localPackageToPackage :: LocalPackage -> Package
localPackageToPackage :: LocalPackage -> Package
localPackageToPackage LocalPackage
lp =
forall a. a -> Maybe a -> a
fromMaybe (LocalPackage -> Package
lpPackage LocalPackage
lp) (LocalPackage -> Maybe Package
lpTestBench LocalPackage
lp)
withDotConfig
:: DotOpts
-> RIO DotConfig a
-> RIO Runner a
withDotConfig :: forall a. DotOpts -> RIO DotConfig a -> RIO Runner a
withDotConfig DotOpts
opts RIO DotConfig a
inner =
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall env. HasRunner env => Lens' env GlobalOpts
globalOptsL GlobalOpts -> GlobalOpts
modifyGO) forall a b. (a -> b) -> a -> b
$
if DotOpts -> Bool
dotGlobalHints DotOpts
opts
then forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
NoReexec forall a b. (a -> b) -> a -> b
$ forall a. RIO BuildConfig a -> RIO Config a
withBuildConfig RIO BuildConfig a
withGlobalHints
else forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
YesReexec RIO Config a
withReal
where
withGlobalHints :: RIO BuildConfig a
withGlobalHints = do
BuildConfig
bconfig <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
Map PackageName Version
globals <- forall env.
HasConfig env =>
WantedCompiler -> RIO env (Map PackageName Version)
globalsFromHints forall a b. (a -> b) -> a -> b
$ SMWanted -> WantedCompiler
smwCompiler forall a b. (a -> b) -> a -> b
$ BuildConfig -> SMWanted
bcSMWanted BuildConfig
bconfig
GhcPkgId
fakeGhcPkgId <- forall (m :: * -> *). MonadThrow m => Text -> m GhcPkgId
parseGhcPkgId Text
"ignored"
ActualCompiler
actual <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
WantedCompiler -> Either CompilerException ActualCompiler
wantedToActual forall a b. (a -> b) -> a -> b
$ SMWanted -> WantedCompiler
smwCompiler forall a b. (a -> b) -> a -> b
$
BuildConfig -> SMWanted
bcSMWanted BuildConfig
bconfig
let smActual :: SMActual DumpPackage
smActual = SMActual
{ smaCompiler :: ActualCompiler
smaCompiler = ActualCompiler
actual
, smaProject :: Map PackageName ProjectPackage
smaProject = SMWanted -> Map PackageName ProjectPackage
smwProject forall a b. (a -> b) -> a -> b
$ BuildConfig -> SMWanted
bcSMWanted BuildConfig
bconfig
, smaDeps :: Map PackageName DepPackage
smaDeps = SMWanted -> Map PackageName DepPackage
smwDeps forall a b. (a -> b) -> a -> b
$ BuildConfig -> SMWanted
bcSMWanted BuildConfig
bconfig
, smaGlobal :: Map PackageName DumpPackage
smaGlobal = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey PackageName -> Version -> DumpPackage
toDump Map PackageName Version
globals
}
toDump :: PackageName -> Version -> DumpPackage
toDump :: PackageName -> Version -> DumpPackage
toDump PackageName
name Version
version = DumpPackage
{ dpGhcPkgId :: GhcPkgId
dpGhcPkgId = GhcPkgId
fakeGhcPkgId
, dpPackageIdent :: PackageIdentifier
dpPackageIdent = PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
version
, dpParentLibIdent :: Maybe PackageIdentifier
dpParentLibIdent = forall a. Maybe a
Nothing
, dpLicense :: Maybe License
dpLicense = forall a. Maybe a
Nothing
, dpLibDirs :: [[Char]]
dpLibDirs = []
, dpLibraries :: [Text]
dpLibraries = []
, dpHasExposedModules :: Bool
dpHasExposedModules = Bool
True
, dpExposedModules :: Set ModuleName
dpExposedModules = forall a. Monoid a => a
mempty
, dpDepends :: [GhcPkgId]
dpDepends = []
, dpHaddockInterfaces :: [[Char]]
dpHaddockInterfaces = []
, dpHaddockHtml :: Maybe [Char]
dpHaddockHtml = forall a. Maybe a
Nothing
, dpIsExposed :: Bool
dpIsExposed = Bool
True
}
actualPkgs :: Set PackageName
actualPkgs = forall k a. Map k a -> Set k
Map.keysSet (forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual DumpPackage
smActual) forall a. Semigroup a => a -> a -> a
<>
forall k a. Map k a -> Set k
Map.keysSet (forall global. SMActual global -> Map PackageName ProjectPackage
smaProject SMActual DumpPackage
smActual)
prunedActual :: SMActual GlobalPackage
prunedActual = SMActual DumpPackage
smActual { smaGlobal :: Map PackageName GlobalPackage
smaGlobal = Map PackageName DumpPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals (forall global. SMActual global -> Map PackageName global
smaGlobal SMActual DumpPackage
smActual) Set PackageName
actualPkgs }
SMTargets
targets <- forall env.
HasBuildConfig env =>
NeedTargets
-> Bool
-> BuildOptsCLI
-> SMActual GlobalPackage
-> RIO env SMTargets
parseTargets NeedTargets
NeedTargets Bool
False BuildOptsCLI
boptsCLI SMActual GlobalPackage
prunedActual
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Loading source map"
SourceMap
sourceMap <- forall env.
HasBuildConfig env =>
SMTargets
-> BuildOptsCLI -> SMActual DumpPackage -> RIO env SourceMap
loadSourceMap SMTargets
targets BuildOptsCLI
boptsCLI SMActual DumpPackage
smActual
let dc :: DotConfig
dc = DotConfig
{ dcBuildConfig :: BuildConfig
dcBuildConfig = BuildConfig
bconfig
, dcSourceMap :: SourceMap
dcSourceMap = SourceMap
sourceMap
, dcGlobalDump :: [DumpPackage]
dcGlobalDump = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall global. SMActual global -> Map PackageName global
smaGlobal SMActual DumpPackage
smActual
}
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"DotConfig fully loaded"
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO DotConfig
dc RIO DotConfig a
inner
withReal :: RIO Config a
withReal = forall a.
NeedTargets -> BuildOptsCLI -> RIO EnvConfig a -> RIO Config a
withEnvConfig NeedTargets
NeedTargets BuildOptsCLI
boptsCLI forall a b. (a -> b) -> a -> b
$ do
EnvConfig
envConfig <- forall r (m :: * -> *). MonadReader r m => m r
ask
let sourceMap :: SourceMap
sourceMap = EnvConfig -> SourceMap
envConfigSourceMap EnvConfig
envConfig
InstallMap
installMap <- forall (m :: * -> *). MonadIO m => SourceMap -> m InstallMap
toInstallMap SourceMap
sourceMap
(InstalledMap
_, [DumpPackage]
globalDump, [DumpPackage]
_, [DumpPackage]
_) <- forall env.
HasEnvConfig env =>
InstallMap
-> RIO
env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
getInstalled InstallMap
installMap
let dc :: DotConfig
dc = DotConfig
{ dcBuildConfig :: BuildConfig
dcBuildConfig = EnvConfig -> BuildConfig
envConfigBuildConfig EnvConfig
envConfig
, dcSourceMap :: SourceMap
dcSourceMap = SourceMap
sourceMap
, dcGlobalDump :: [DumpPackage]
dcGlobalDump = [DumpPackage]
globalDump
}
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO DotConfig
dc RIO DotConfig a
inner
boptsCLI :: BuildOptsCLI
boptsCLI = BuildOptsCLI
defaultBuildOptsCLI
{ boptsCLITargets :: [Text]
boptsCLITargets = DotOpts -> [Text]
dotTargets DotOpts
opts
, boptsCLIFlags :: Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags = DotOpts -> Map ApplyCLIFlag (Map FlagName Bool)
dotFlags DotOpts
opts
}
modifyGO :: GlobalOpts -> GlobalOpts
modifyGO =
(if DotOpts -> Bool
dotTestTargets DotOpts
opts
then forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidTestsL) (forall a. a -> Maybe a
Just Bool
True)
else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if DotOpts -> Bool
dotBenchTargets DotOpts
opts
then forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidBenchmarksL) (forall a. a -> Maybe a
Just Bool
True)
else forall a. a -> a
id)
data DotConfig = DotConfig
{ DotConfig -> BuildConfig
dcBuildConfig :: !BuildConfig
, DotConfig -> SourceMap
dcSourceMap :: !SourceMap
, DotConfig -> [DumpPackage]
dcGlobalDump :: ![DumpPackage]
}
instance HasLogFunc DotConfig where
logFuncL :: Lens' DotConfig LogFunc
logFuncL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasLogFunc env => Lens' env LogFunc
logFuncL
instance HasPantryConfig DotConfig where
pantryConfigL :: Lens' DotConfig PantryConfig
pantryConfigL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL
instance HasTerm DotConfig where
useColorL :: Lens' DotConfig Bool
useColorL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasTerm env => Lens' env Bool
useColorL
termWidthL :: Lens' DotConfig Int
termWidthL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasTerm env => Lens' env Int
termWidthL
instance HasStylesUpdate DotConfig where
stylesUpdateL :: Lens' DotConfig StylesUpdate
stylesUpdateL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasStylesUpdate env => Lens' env StylesUpdate
stylesUpdateL
instance HasGHCVariant DotConfig
instance HasPlatform DotConfig
instance HasRunner DotConfig where
runnerL :: Lens' DotConfig Runner
runnerL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasRunner env => Lens' env Runner
runnerL
instance HasProcessContext DotConfig where
processContextL :: Lens' DotConfig ProcessContext
processContextL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
instance HasConfig DotConfig
instance HasBuildConfig DotConfig where
buildConfigL :: Lens' DotConfig BuildConfig
buildConfigL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DotConfig -> BuildConfig
dcBuildConfig (\DotConfig
x BuildConfig
y -> DotConfig
x { dcBuildConfig :: BuildConfig
dcBuildConfig = BuildConfig
y })
instance HasSourceMap DotConfig where
sourceMapL :: Lens' DotConfig SourceMap
sourceMapL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DotConfig -> SourceMap
dcSourceMap (\DotConfig
x SourceMap
y -> DotConfig
x { dcSourceMap :: SourceMap
dcSourceMap = SourceMap
y })