content: {-# LANGUAGE NoImplicitPrelude   #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE OverloadedStrings   #-}
  
  {-|
  Module      : Stack.Dot
  Description : Functions related to Stack's @dot@ command.
  License     : BSD-3-Clause
  
  Functions related to Stack's @dot@ command.
  -}
  
  module Stack.Dot
    ( dotCmd
    , printGraph
    ) where
  
  import qualified Data.Foldable as F
  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           Stack.Constants ( wiredInPackages )
  import           Stack.DependencyGraph ( createPrunedDependencyGraph )
  import           Stack.Prelude
  import           Stack.Types.Compiler ( ActualCompiler )
  import           Stack.Types.DependencyTree ( DependencyGraph )
  import           Stack.Types.DotOpts ( DotOpts (..) )
  import           Stack.Types.Runner ( Runner )
  
  -- | Visualize the project's dependencies as a graphviz graph
  dotCmd :: DotOpts -> RIO Runner ()
  dotCmd dotOpts = do
    (compiler, localNames, prunedGraph) <- createPrunedDependencyGraph dotOpts
    printGraph dotOpts compiler localNames prunedGraph
  
  -- | Print a graphviz graph of the edges in the Map and highlight the given
  -- project packages
  printGraph ::
       (Applicative m, MonadIO m)
    => DotOpts
    -> ActualCompiler
    -> Set PackageName -- ^ All project packages.
    -> DependencyGraph
    -> m ()
  printGraph dotOpts compiler locals graph = do
    liftIO $ Text.putStrLn "strict digraph deps {"
    printLocalNodes dotOpts filteredLocals
    printLeaves compiler graph
    let allNodes = Map.keysSet graph
    void (Map.traverseWithKey (printEdges allNodes) (fst <$> graph))
    liftIO $ Text.putStrLn "}"
   where
    filteredLocals =
      Set.filter (\local' -> local' `Set.notMember` dotOpts.prune) locals
  
  -- | Print the project packages 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 dotOpts.includeExternal
                     then n <> " [style=dashed];"
                     else n <> " [style=solid];"
    lpNodes :: [Text]
    lpNodes = map (applyStyle . nodeName) (F.toList locals)
  
  -- | Print relevant nodes, based on their relevant attributes.
  printLeaves :: MonadIO m => ActualCompiler -> DependencyGraph -> m ()
  printLeaves compiler graph =
    F.mapM_ printLeaf (Map.mapWithKey nodeAttributes graph)
   where
    allNodes = Map.keysSet graph
    hasNoNodes = F.all (`Set.notMember` allNodes)
    nodeAttributes package (deps, _) =
      let isWiredInPackage = isWiredIn compiler package
          isBottomRow = hasNoNodes deps
      in  (package, isWiredInPackage, isBottomRow)
  
  -- | @printDedges ps p ps'@ prints an edge from @p@ to every @ps'@, if it is a
  -- member of @ps@.
  printEdges ::
       MonadIO m
    => Set PackageName
       -- ^ The nodes in the graph.
    -> PackageName
       -- ^ The node in question.
    -> Set PackageName
       -- ^ The dependencies of the node in question.
    -> m ()
  printEdges nodes package deps = F.forM_ deps $ \dep ->
    when (dep `elem` nodes) $ printEdge package dep
  
  -- | 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 if it (a) is a GHC wired-in package or (b) has no dependencies
  -- that are also nodes.
  printLeaf ::
       MonadIO m
    =>  ( PackageName
        , Bool
          -- Is package a GHC wired-in package?
        , Bool
          -- Does package have no dependencies that are are also nodes in the
          -- graph?
        )
    -> m ()
  printLeaf (package, isWiredInPackage, isBottomRow) =
    when (isWiredInPackage || isBottomRow) $
      liftIO . Text.putStrLn . Text.concat $
           [ "{"]
        <> [ "rank=max; " | isBottomRow ]
        <> [ nodeName package ]
        <> [ " [shape=box]" | isWiredInPackage ]
        <> [ "; };" ]
  
  -- | Check if the package is a GHC wired-in package
  isWiredIn :: ActualCompiler -> PackageName -> Bool
  isWiredIn compiler package =
    package `Set.member` wiredInPackages compiler
  