{-# 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.Text (display)
import qualified Distribution.PackageDescription as PD
import qualified Distribution.SPDX.License as SPDX
import           Distribution.License (License(BSD3), licenseFromSPDX)
import           Distribution.Types.PackageName (mkPackageName)
import qualified Path
import           RIO.PrettyPrint (HasTerm (..), HasStylesUpdate (..))
import           RIO.Process (HasProcessContext (..))
import           Stack.Build (loadPackage)
import           Stack.Build.Installed (getInstalled, toInstallMap)
import           Stack.Build.Source
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
import           Stack.Build.Target(NeedTargets(..), parseTargets)

-- | Options record for @stack dot@

data DotOpts = DotOpts
    { DotOpts -> Bool
dotIncludeExternal :: !Bool
    -- ^ Include external dependencies

    , DotOpts -> Bool
dotIncludeBase :: !Bool
    -- ^ Include dependencies on base

    , DotOpts -> Maybe Int
dotDependencyDepth :: !(Maybe Int)
    -- ^ Limit the depth of dependency resolution to (Just n) or continue until fixpoint

    , DotOpts -> Set PackageName
dotPrune :: !(Set PackageName)
    -- ^ Package names to prune from the graph

    , DotOpts -> [Text]
dotTargets :: [Text]
    -- ^ stack TARGETs to trace dependencies for

    , DotOpts -> Map ApplyCLIFlag (Map FlagName Bool)
dotFlags :: !(Map ApplyCLIFlag (Map FlagName Bool))
    -- ^ Flags to apply when calculating dependencies

    , DotOpts -> Bool
dotTestTargets :: Bool
    -- ^ Like the "--test" flag for build, affects the meaning of 'dotTargets'.

    , DotOpts -> Bool
dotBenchTargets :: Bool
    -- ^ Like the "--bench" flag for build, affects the meaning of 'dotTargets'.

    , DotOpts -> Bool
dotGlobalHints :: Bool
    -- ^ Use global hints instead of relying on an actual GHC installation.

    }

data ListDepsFormatOpts = ListDepsFormatOpts { ListDepsFormatOpts -> Text
listDepsSep :: !Text
                                             -- ^ Separator between the package name and details.

                                             , ListDepsFormatOpts -> Bool
listDepsLicense :: !Bool
                                             -- ^ Print dependency licenses instead of versions.

                                             }

data ListDepsFormat = ListDepsText ListDepsFormatOpts
                    | ListDepsTree ListDepsFormatOpts
                    | ListDepsJSON

data ListDepsOpts = ListDepsOpts
    { ListDepsOpts -> ListDepsFormat
listDepsFormat :: !ListDepsFormat
    -- ^ Format of printing dependencies

    , ListDepsOpts -> DotOpts
listDepsDotOpts :: !DotOpts
    -- ^ The normal dot options.

    }

-- | Visualize the project's dependencies as a graphviz graph

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

-- | Information about a package in the dependency graph, when available.

data DotPayload = DotPayload
  { DotPayload -> Maybe Version
payloadVersion :: Maybe Version
  -- ^ The package version.

  , DotPayload -> Maybe (Either License License)
payloadLicense :: Maybe (Either SPDX.License License)
  -- ^ The license the package was released under.

  , DotPayload -> Maybe PackageLocation
payloadLocation :: Maybe PackageLocation
  -- ^ The location of the package.

  } 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)

-- | Create the dependency graph and also prune it as specified in the dot

-- options. Returns a set of local names and a map from package names to

-- dependencies.

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 (m :: * -> *) a. Monad m => a -> m a
return (Set PackageName
localNames, Map PackageName (Set PackageName, DotPayload)
prunedGraph)

-- | Create the dependency graph, the result is a map from a package

-- name to a tuple of dependencies and payload if available. This

-- function mainly gathers the required arguments for

-- @resolveDependencies@.

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
  -- TODO: Can there be multiple entries for wired-in-packages? If so,

  -- this will choose one arbitrarily..

  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
          -- Skip packages that can't be loaded - see

          -- https://github.com/commercialhaskell/stack/issues/2967

          | 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 (m :: * -> *) a. Monad m => a -> m a
return (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 (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey PackageName -> DotPayload -> IO ()
go (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 :: PackageName -> DotPayload -> IO ()
go PackageName
name DotPayload
payload = Text -> IO ()
Text.putStrLn forall a b. (a -> b) -> a -> b
$ ListDepsFormatOpts -> PackageName -> DotPayload -> Text
listDepsLine ListDepsFormatOpts
textOpts 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 (m :: * -> *) a. Monad m => a -> m a
return ()
                             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
                        -- TODO: Define this behaviour, maybe return an error?

                        Maybe (Set PackageName, DotPayload)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

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 dontPrune toPrune graph@ prunes all packages in

-- @graph@ with a name in @toPrune@ and removes resulting orphans

-- unless they are in @dontPrune@

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))

-- | Make sure that all unreachable nodes (orphans) are pruned

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')


-- | Resolve the dependency graph up to (Just depth) or until fixpoint is reached

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 (m :: * -> *) a. Monad m => a -> m a
return 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 (m :: * -> *) a. Monad m => a -> m a
return 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)

-- | Given a SourceMap and a dependency loader, load the set of dependencies for a package

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 {a}. a
noDepsErr
    (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)

    -- If package is a global package, use info from ghc-pkg (#4324, #3084)

    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 =
              let errText :: [Char]
errText = [Char]
"Invariant violated: Expected to find "
              in forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error ([Char]
errText forall a. [a] -> [a] -> [a]
++ GhcPkgId -> [Char]
ghcPkgIdString GhcPkgId
depId forall a. [a] -> [a] -> [a]
++ [Char]
" in global DB"))
                 PackageIdentifier -> PackageName
Stack.Prelude.pkgName
                 (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GhcPkgId
depId Map GhcPkgId PackageIdentifier
globalIdMap)

    noDepsErr :: a
noDepsErr = forall a. HasCallStack => [Char] -> a
error ([Char]
"Invariant violated: The '" forall a. [a] -> [a] -> [a]
++ PackageName -> [Char]
packageNameString PackageName
pkgName
                forall a. [a] -> [a] -> [a]
++ [Char]
"' package was not found in any of the dependency sources")

    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

-- | Resolve the direct (depth 0) external dependencies of the given local packages (assumed to come from project packages)

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)

-- | Print a graphviz graph of the edges in the Map and highlight the given local packages

printGraph :: (Applicative m, MonadIO m)
           => DotOpts
           -> Set PackageName -- ^ all locals

           -> 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

-- | Print the local nodes with a different style depending on options

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)

-- | Print nodes without dependencies

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

-- | @printDedges p ps@ prints an edge from p to every ps

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)

-- | Print an edge between the two package names

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
";"])

-- | Convert a package name to a graph node name.

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
"\""

-- | Print a node with no dependencies

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
"; };"]

-- | Check if the package is wired in (shipped with) ghc

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)

-- Plumbing for --test and --bench flags

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 })