Dot.hs

{-# 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
    { dotIncludeExternal :: !Bool
    -- ^ Include external dependencies
    , dotIncludeBase :: !Bool
    -- ^ Include dependencies on base
    , dotDependencyDepth :: !(Maybe Int)
    -- ^ Limit the depth of dependency resolution to (Just n) or continue until fixpoint
    , dotPrune :: !(Set PackageName)
    -- ^ Package names to prune from the graph
    , dotTargets :: [Text]
    -- ^ stack TARGETs to trace dependencies for
    , dotFlags :: !(Map ApplyCLIFlag (Map FlagName Bool))
    -- ^ Flags to apply when calculating dependencies
    , dotTestTargets :: Bool
    -- ^ Like the "--test" flag for build, affects the meaning of 'dotTargets'.
    , dotBenchTargets :: Bool
    -- ^ Like the "--bench" flag for build, affects the meaning of 'dotTargets'.
    , dotGlobalHints :: Bool
    -- ^ Use global hints instead of relying on an actual GHC installation.
    }

data ListDepsFormatOpts = ListDepsFormatOpts { listDepsSep :: !Text
                                             -- ^ Separator between the package name and details.
                                             , listDepsLicense :: !Bool
                                             -- ^ Print dependency licenses instead of versions.
                                             }

data ListDepsFormat = ListDepsText ListDepsFormatOpts
                    | ListDepsTree ListDepsFormatOpts
                    | ListDepsJSON

data ListDepsOpts = ListDepsOpts
    { listDepsFormat :: !ListDepsFormat
    -- ^ Format of printing dependencies
    , listDepsDotOpts :: !DotOpts
    -- ^ The normal dot options.
    }

-- | Visualize the project's dependencies as a graphviz graph
dot :: DotOpts -> RIO Runner ()
dot dotOpts = do
  (localNames, prunedGraph) <- createPrunedDependencyGraph dotOpts
  printGraph dotOpts localNames prunedGraph

-- | Information about a package in the dependency graph, when available.
data DotPayload = DotPayload
  { payloadVersion :: Maybe Version
  -- ^ The package version.
  , payloadLicense :: Maybe (Either SPDX.License License)
  -- ^ The license the package was released under.
  , payloadLocation :: Maybe PackageLocation
  -- ^ The location of the package.
  } deriving (Eq, 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 = withDotConfig dotOpts $ do
  localNames <- view $ buildConfigL.to (Map.keysSet . smwProject . bcSMWanted)
  logDebug "Creating dependency graph"
  resultGraph <- createDependencyGraph dotOpts
  let pkgsToPrune = if dotIncludeBase dotOpts
                       then dotPrune dotOpts
                       else Set.insert "base" (dotPrune dotOpts)
      prunedGraph = pruneGraph localNames pkgsToPrune resultGraph
  logDebug "Returning pruned dependency graph"
  return (localNames, 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 = do
  sourceMap <- view sourceMapL
  locals <- for (toList $ smProject sourceMap) loadLocalPackage
  let graph = Map.fromList $ projectPackageDependencies dotOpts (filter lpWanted locals)
  globalDump <- view $ to dcGlobalDump
  -- TODO: Can there be multiple entries for wired-in-packages? If so,
  -- this will choose one arbitrarily..
  let globalDumpMap = Map.fromList $ map (\dp -> (Stack.Prelude.pkgName (dpPackageIdent dp), dp)) globalDump
      globalIdMap = Map.fromList $ map (\dp -> (dpGhcPkgId dp, dpPackageIdent dp)) globalDump
  let depLoader = createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps
      loadPackageDeps name version loc flags ghcOptions cabalConfigOpts
          -- Skip packages that can't be loaded - see
          -- https://github.com/commercialhaskell/stack/issues/2967
          | name `elem` [mkPackageName "rts", mkPackageName "ghc"] =
              return (Set.empty, DotPayload (Just version) (Just $ Right BSD3) Nothing)
          | otherwise =
              fmap (packageAllDeps &&& makePayload loc) (loadPackage loc flags ghcOptions cabalConfigOpts)
  resolveDependencies (dotDependencyDepth dotOpts) graph depLoader
  where makePayload loc pkg = DotPayload (Just $ packageVersion pkg) (Just $ packageLicense pkg) (Just $ PLImmutable loc)

listDependencies
  :: ListDepsOpts
  -> RIO Runner ()
listDependencies opts = do
  let dotOpts = listDepsDotOpts opts
  (pkgs, resultGraph) <- createPrunedDependencyGraph dotOpts
  liftIO $ case listDepsFormat opts of
      ListDepsTree treeOpts -> Text.putStrLn "Packages" >> printTree treeOpts dotOpts 0 [] (treeRoots opts pkgs) resultGraph
      ListDepsJSON -> printJSON pkgs resultGraph
      ListDepsText textOpts -> void (Map.traverseWithKey go (snd <$> resultGraph))
        where go name payload = Text.putStrLn $ listDepsLine textOpts name payload

data DependencyTree = DependencyTree (Set PackageName) (Map PackageName (Set PackageName, DotPayload))

instance ToJSON DependencyTree where
  toJSON (DependencyTree _ dependencyMap) =
    toJSON $ foldToList dependencyToJSON dependencyMap

foldToList :: (k -> a -> b) -> Map k a -> [b]
foldToList f = Map.foldrWithKey (\k a bs -> bs ++ [f k a]) []

dependencyToJSON :: PackageName -> (Set PackageName, DotPayload) -> Value
dependencyToJSON pkg (deps, payload) =  let fieldsAlwaysPresent = [ "name" .= packageNameString pkg
                                                                  , "license" .= licenseText payload
                                                                  , "version" .= versionText payload
                                                                  , "dependencies" .= Set.map packageNameString deps
                                                                  ]
                                            loc = catMaybes [("location" .=) . pkgLocToJSON <$> payloadLocation payload]
                                        in object $ fieldsAlwaysPresent ++ loc

pkgLocToJSON :: PackageLocation -> Value
pkgLocToJSON (PLMutable (ResolvedPath _ dir)) = object [ "type" .= ("project package" :: Text)
                                              , "url" .= ("file://" ++ Path.toFilePath dir)]
pkgLocToJSON (PLImmutable (PLIHackage pkgid _ _)) = object [ "type" .= ("hackage" :: Text)
                                                  , "url" .= ("https://hackage.haskell.org/package/" ++ display pkgid)]
pkgLocToJSON (PLImmutable (PLIArchive archive _)) = let url = case archiveLocation archive of
                                                                ALUrl u -> u
                                                                ALFilePath (ResolvedPath _ path) -> Text.pack $ "file://" ++ Path.toFilePath path
                                                    in object [ "type" .= ("archive" :: Text)
                                                              , "url" .= url
                                                              , "sha256" .= archiveHash archive
                                                              , "size" .= archiveSize archive ]
pkgLocToJSON (PLImmutable (PLIRepo repo _)) = object [ "type" .= case repoType repo of
                                                                   RepoGit -> "git" :: Text
                                                                   RepoHg -> "hg" :: Text
                                                     , "url" .= repoUrl repo
                                                     , "commit" .= repoCommit repo
                                                     , "subdir" .= repoSubdir repo
                                                     ]

printJSON :: Set PackageName
          -> Map PackageName (Set PackageName, DotPayload)
          -> IO ()
printJSON pkgs dependencyMap = LBC8.putStrLn $ encode $ DependencyTree pkgs dependencyMap

treeRoots :: ListDepsOpts -> Set PackageName -> Set PackageName
treeRoots opts projectPackages' =
  let targets = dotTargets $ listDepsDotOpts opts
   in if null targets
        then projectPackages'
        else Set.fromList $ map (mkPackageName . Text.unpack) targets

printTree :: ListDepsFormatOpts
          -> DotOpts
          -> Int
          -> [Int]
          -> Set PackageName
          -> Map PackageName (Set PackageName, DotPayload)
          -> IO ()
printTree opts dotOpts depth remainingDepsCounts packages dependencyMap =
  F.sequence_ $ Seq.mapWithIndex go (toSeq packages)
  where
    toSeq = Seq.fromList . Set.toList
    go index name = let newDepsCounts = remainingDepsCounts ++ [Set.size packages - index - 1]
                     in
                      case Map.lookup name dependencyMap of
                        Just (deps, payload) -> do
                          printTreeNode opts dotOpts depth newDepsCounts deps payload name
                          if Just depth == dotDependencyDepth dotOpts
                             then return ()
                             else printTree opts dotOpts (depth + 1) newDepsCounts deps dependencyMap
                        -- TODO: Define this behaviour, maybe return an error?
                        Nothing -> return ()

printTreeNode :: ListDepsFormatOpts
              -> DotOpts
              -> Int
              -> [Int]
              -> Set PackageName
              -> DotPayload
              -> PackageName
              -> IO ()
printTreeNode opts dotOpts depth remainingDepsCounts deps payload name =
  let remainingDepth = fromMaybe 999 (dotDependencyDepth dotOpts) - depth
      hasDeps = not $ null deps
   in Text.putStrLn $ treeNodePrefix "" remainingDepsCounts hasDeps  remainingDepth  <> " " <> listDepsLine opts name payload

treeNodePrefix :: Text -> [Int] -> Bool -> Int -> Text
treeNodePrefix t [] _ _      = t
treeNodePrefix t [0] True  0 = t <> "└──"
treeNodePrefix t [_] True  0 = t <> "├──"
treeNodePrefix t [0] True  _ = t <> "└─┬"
treeNodePrefix t [_] True  _ = t <> "├─┬"
treeNodePrefix t [0] False _ = t <> "└──"
treeNodePrefix t [_] False _ = t <> "├──"
treeNodePrefix t (0:ns) d remainingDepth = treeNodePrefix (t <> "  ") ns d remainingDepth
treeNodePrefix t (_:ns) d remainingDepth = treeNodePrefix (t <> "│ ") ns d remainingDepth

listDepsLine :: ListDepsFormatOpts -> PackageName -> DotPayload -> Text
listDepsLine opts name payload = Text.pack (packageNameString name) <> listDepsSep opts <> payloadText opts payload

payloadText :: ListDepsFormatOpts -> DotPayload -> Text
payloadText opts payload =
  if listDepsLicense opts
    then licenseText payload
    else versionText payload

licenseText :: DotPayload -> Text
licenseText payload = maybe "<unknown>" (Text.pack . display . either licenseFromSPDX id) (payloadLicense payload)

versionText :: DotPayload -> Text
versionText payload = maybe "<unknown>" (Text.pack . display) (payloadVersion 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 dontPrune names =
  pruneUnreachable dontPrune . Map.mapMaybeWithKey (\pkg (pkgDeps,x) ->
    if pkg `F.elem` names
      then Nothing
      else let filtered = Set.filter (\n -> n `F.notElem` names) pkgDeps
           in if Set.null filtered && not (Set.null pkgDeps)
                then Nothing
                else Just (filtered,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 dontPrune = fixpoint prune
  where fixpoint :: Eq a => (a -> a) -> a -> a
        fixpoint f v = if f v == v then v else fixpoint f (f v)
        prune graph' = Map.filterWithKey (\k _ -> reachable k) graph'
          where reachable k = k `F.elem` dontPrune || k `Set.member` reachables
                reachables = F.fold (fst <$> 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 (Just 0) graph _ = return graph
resolveDependencies limit graph loadPackageDeps = do
  let values = Set.unions (fst <$> Map.elems graph)
      keys = Map.keysSet graph
      next = Set.difference values keys
  if Set.null next
     then return graph
     else do
       x <- T.traverse (\name -> (name,) <$> loadPackageDeps name) (F.toList next)
       resolveDependencies (subtract 1 <$> limit)
                      (Map.unionWith unifier graph (Map.fromList x))
                      loadPackageDeps
  where unifier (pkgs1,v1) (pkgs2,_) = (Set.union pkgs1 pkgs2, 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 globalDumpMap globalIdMap loadPackageDeps pkgName = do
  fromMaybe noDepsErr
    (projectPackageDeps <|> dependencyDeps <|> globalDeps)
  where
    projectPackageDeps =
      loadDeps <$> Map.lookup pkgName (smProject sourceMap)
      where
        loadDeps pp = do
          pkg <- loadCommonPackage (ppCommon pp)
          pure (packageAllDeps pkg, payloadFromLocal pkg Nothing)

    dependencyDeps =
      loadDeps <$> Map.lookup pkgName (smDeps sourceMap)
      where
        loadDeps DepPackage{dpLocation=PLMutable dir} = do
              pp <- mkProjectPackage YesPrintWarnings dir False
              pkg <- loadCommonPackage (ppCommon pp)
              pure (packageAllDeps pkg, payloadFromLocal pkg (Just $ PLMutable dir))

        loadDeps dp@DepPackage{dpLocation=PLImmutable loc} = do
          let common = dpCommon dp
          gpd <- liftIO $ cpGPD common
          let PackageIdentifier name version = PD.package $ PD.packageDescription gpd
              flags = cpFlags common
              ghcOptions = cpGhcOptions common
              cabalConfigOpts = cpCabalConfigOpts common
          assert (pkgName == name) (loadPackageDeps pkgName version loc flags ghcOptions cabalConfigOpts)

    -- If package is a global package, use info from ghc-pkg (#4324, #3084)
    globalDeps =
      pure . getDepsFromDump <$> Map.lookup pkgName globalDumpMap
      where
        getDepsFromDump dump =
          (Set.fromList deps, payloadFromDump dump)
          where
            deps = map ghcIdToPackageName (dpDepends dump)
            ghcIdToPackageName depId =
              let errText = "Invariant violated: Expected to find "
              in maybe (error (errText ++ ghcPkgIdString depId ++ " in global DB"))
                 Stack.Prelude.pkgName
                 (Map.lookup depId globalIdMap)

    noDepsErr = error ("Invariant violated: The '" ++ packageNameString pkgName
                ++ "' package was not found in any of the dependency sources")

    payloadFromLocal pkg loc = DotPayload (Just $ packageVersion pkg) (Just $ packageLicense pkg) loc
    payloadFromDump dp = DotPayload (Just $ pkgVersion $ dpPackageIdent dp) (Right <$> dpLicense dp) 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 locals =
    map (\lp -> let pkg = localPackageToPackage lp
                    pkgDir = Path.parent $ lpCabalFile lp
                    loc = PLMutable $ ResolvedPath (RelFilePath "N/A") pkgDir
                 in (packageName pkg, (deps pkg, lpPayload pkg loc)))
        locals
  where deps pkg =
          if dotIncludeExternal dotOpts
            then Set.delete (packageName pkg) (packageAllDeps pkg)
            else Set.intersection localNames (packageAllDeps pkg)
        localNames = Set.fromList $ map (packageName . lpPackage) locals
        lpPayload pkg loc = DotPayload (Just $ packageVersion pkg) (Just $ packageLicense pkg) (Just 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 dotOpts locals graph = do
  liftIO $ Text.putStrLn "strict digraph deps {"
  printLocalNodes dotOpts filteredLocals
  printLeaves graph
  void (Map.traverseWithKey printEdges (fst <$> graph))
  liftIO $ Text.putStrLn "}"
  where filteredLocals = Set.filter (\local' ->
          local' `Set.notMember` dotPrune dotOpts) locals

-- | Print the local nodes with a different style depending on options
printLocalNodes :: (F.Foldable t, MonadIO m)
                => DotOpts
                -> t PackageName
                -> m ()
printLocalNodes dotOpts locals = liftIO $ Text.putStrLn (Text.intercalate "\n" lpNodes)
  where applyStyle :: Text -> Text
        applyStyle n = if dotIncludeExternal dotOpts
                         then n <> " [style=dashed];"
                         else n <> " [style=solid];"
        lpNodes :: [Text]
        lpNodes = map (applyStyle . nodeName) (F.toList locals)

-- | Print nodes without dependencies
printLeaves :: MonadIO m
            => Map PackageName (Set PackageName, DotPayload)
            -> m ()
printLeaves = F.mapM_ printLeaf . Map.keysSet . Map.filter Set.null . fmap fst

-- | @printDedges p ps@ prints an edge from p to every ps
printEdges :: MonadIO m => PackageName -> Set PackageName -> m ()
printEdges package deps = F.forM_ deps (printEdge package)

-- | Print an edge between the two package names
printEdge :: MonadIO m => PackageName -> PackageName -> m ()
printEdge from to' = liftIO $ Text.putStrLn (Text.concat [ nodeName from, " -> ", nodeName to', ";"])

-- | Convert a package name to a graph node name.
nodeName :: PackageName -> Text
nodeName name = "\"" <> Text.pack (packageNameString name) <> "\""

-- | Print a node with no dependencies
printLeaf :: MonadIO m => PackageName -> m ()
printLeaf package = liftIO . Text.putStrLn . Text.concat $
  if isWiredIn package
    then ["{rank=max; ", nodeName package, " [shape=box]; };"]
    else ["{rank=max; ", nodeName package, "; };"]

-- | Check if the package is wired in (shipped with) ghc
isWiredIn :: PackageName -> Bool
isWiredIn = (`Set.member` wiredInPackages)

localPackageToPackage :: LocalPackage -> Package
localPackageToPackage lp =
  fromMaybe (lpPackage lp) (lpTestBench lp)

-- Plumbing for --test and --bench flags
withDotConfig
    :: DotOpts
    -> RIO DotConfig a
    -> RIO Runner a
withDotConfig opts inner =
  local (over globalOptsL modifyGO) $
    if dotGlobalHints opts
      then withConfig NoReexec $ withBuildConfig withGlobalHints
      else withConfig YesReexec withReal
  where
    withGlobalHints = do
      bconfig <- view buildConfigL
      globals <- globalsFromHints $ smwCompiler $ bcSMWanted bconfig
      fakeGhcPkgId <- parseGhcPkgId "ignored"
      actual <- either throwIO pure $
                wantedToActual $ smwCompiler $
                bcSMWanted bconfig
      let smActual = SMActual
            { smaCompiler = actual
            , smaProject = smwProject $ bcSMWanted bconfig
            , smaDeps = smwDeps $ bcSMWanted bconfig
            , smaGlobal = Map.mapWithKey toDump globals
            }
          toDump :: PackageName -> Version -> DumpPackage
          toDump name version = DumpPackage
            { dpGhcPkgId = fakeGhcPkgId
            , dpPackageIdent = PackageIdentifier name version
            , dpParentLibIdent = Nothing
            , dpLicense = Nothing
            , dpLibDirs = []
            , dpLibraries = []
            , dpHasExposedModules = True
            , dpExposedModules = mempty
            , dpDepends = []
            , dpHaddockInterfaces = []
            , dpHaddockHtml = Nothing
            , dpIsExposed = True
            }
          actualPkgs = Map.keysSet (smaDeps smActual) <>
                       Map.keysSet (smaProject smActual)
          prunedActual = smActual { smaGlobal = pruneGlobals (smaGlobal smActual) actualPkgs }
      targets <- parseTargets NeedTargets False boptsCLI prunedActual
      logDebug "Loading source map"
      sourceMap <- loadSourceMap targets boptsCLI smActual
      let dc = DotConfig
                  { dcBuildConfig = bconfig
                  , dcSourceMap = sourceMap
                  , dcGlobalDump = toList $ smaGlobal smActual
                  }
      logDebug "DotConfig fully loaded"
      runRIO dc inner

    withReal = withEnvConfig NeedTargets boptsCLI $ do
      envConfig <- ask
      let sourceMap = envConfigSourceMap envConfig
      installMap <- toInstallMap sourceMap
      (_, globalDump, _, _) <- getInstalled installMap
      let dc = DotConfig
            { dcBuildConfig = envConfigBuildConfig envConfig
            , dcSourceMap = sourceMap
            , dcGlobalDump = globalDump
            }
      runRIO dc inner

    boptsCLI = defaultBuildOptsCLI
        { boptsCLITargets = dotTargets opts
        , boptsCLIFlags = dotFlags opts
        }
    modifyGO =
        (if dotTestTargets opts then set (globalOptsBuildOptsMonoidL.buildOptsMonoidTestsL) (Just True) else id) .
        (if dotBenchTargets opts then set (globalOptsBuildOptsMonoidL.buildOptsMonoidBenchmarksL) (Just True) else id)

data DotConfig = DotConfig
  { dcBuildConfig :: !BuildConfig
  , dcSourceMap :: !SourceMap
  , dcGlobalDump :: ![DumpPackage]
  }
instance HasLogFunc DotConfig where
  logFuncL = runnerL.logFuncL
instance HasPantryConfig DotConfig where
  pantryConfigL = configL.pantryConfigL
instance HasTerm DotConfig where
  useColorL = runnerL.useColorL
  termWidthL = runnerL.termWidthL
instance HasStylesUpdate DotConfig where
  stylesUpdateL = runnerL.stylesUpdateL
instance HasGHCVariant DotConfig
instance HasPlatform DotConfig
instance HasRunner DotConfig where
  runnerL = configL.runnerL
instance HasProcessContext DotConfig where
  processContextL = runnerL.processContextL
instance HasConfig DotConfig
instance HasBuildConfig DotConfig where
  buildConfigL = lens dcBuildConfig (\x y -> x { dcBuildConfig = y })
instance HasSourceMap DotConfig where
  sourceMapL = lens dcSourceMap (\x y -> x { dcSourceMap = y })