{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_HADDOCK hide #-}

-- | Module    :  Data.Graph.VisualizeAlternative
-- Copyright   :  (C) 2023 Alexey Tochin
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>
--
-- Copies of some methods from @graphite@ package with only purpose
-- to replace the parameter 'Sfdp' by 'Dot' in 'plotDGraph' term.
module Data.Graph.VisualizeAlternative (plotDGraph, plotDGraphPng, toDirectedDot, sensibleDotParams) where

import Control.Concurrent (ThreadId, forkIO)
import Data.Graph.DGraph (DGraph, arcs)
import Data.Graph.Types (Arc (Arc), Graph, vertices)
import Data.GraphViz
  ( DotGraph,
    GlobalAttributes (GraphAttrs),
    GraphvizCanvas (Xlib),
    GraphvizCommand (Dot, Sfdp),
    GraphvizOutput (Png),
    GraphvizParams,
    PrintDot,
    addExtension,
    fmtEdge,
    globalAttributes,
    graphElemsToDot,
    isDirected,
    nonClusteredParams,
    runGraphvizCanvas,
    runGraphvizCommand,
  )
import Data.GraphViz.Attributes.Complete (Attribute (Label, Overlap), Label (StrLabel), Overlap (ScaleOverlaps))
import Data.Hashable (Hashable)
import qualified Data.Text.Lazy as TL
import Prelude (Bool (False, True), FilePath, IO, Ord, Show, String, show, ($), (<$>))

-- | A copy of @plotDGraph@ method from 'Data.Graph.Visualize' but the parameter 'Sfdp' is replaced by 'Dot'.
plotDGraph ::
  (Hashable v, Ord v, PrintDot v, Show v, Show e) =>
  DGraph v e ->
  IO ThreadId
plotDGraph :: forall v e.
(Hashable v, Ord v, PrintDot v, Show v, Show e) =>
DGraph v e -> IO ThreadId
plotDGraph DGraph v e
g = IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall (dg :: * -> *) n.
PrintDotRepr dg n =>
GraphvizCommand -> dg n -> GraphvizCanvas -> IO ()
runGraphvizCanvas GraphvizCommand
Dot (forall v e.
(Hashable v, Ord v, Show v, Show e) =>
Bool -> DGraph v e -> DotGraph v
toDirectedDot Bool
False DGraph v e
g) GraphvizCanvas
Xlib

-- | A copy of @toDirectedDot@ method from 'Data.Graph.Visualize' but the parameter 'Sfdp' is replaced by 'Dot'.
plotDGraphPng ::
  (Hashable v, Ord v, PrintDot v, Show v, Show e) =>
  DGraph v e ->
  FilePath ->
  IO FilePath
plotDGraphPng :: forall v e.
(Hashable v, Ord v, PrintDot v, Show v, Show e) =>
DGraph v e -> FilePath -> IO FilePath
plotDGraphPng DGraph v e
g = forall a.
(GraphvizOutput -> FilePath -> a)
-> GraphvizOutput -> FilePath -> a
addExtension (forall (dg :: * -> *) n.
PrintDotRepr dg n =>
GraphvizCommand
-> dg n -> GraphvizOutput -> FilePath -> IO FilePath
runGraphvizCommand GraphvizCommand
Dot forall a b. (a -> b) -> a -> b
$ forall v e.
(Hashable v, Ord v, Show v, Show e) =>
Bool -> DGraph v e -> DotGraph v
toDirectedDot Bool
False DGraph v e
g) GraphvizOutput
Png

-- | A copy of @toDirectedDot@ method from 'Data.Graph.Visualize'.
toDirectedDot ::
  (Hashable v, Ord v, Show v, Show e) =>
  Bool ->
  DGraph v e ->
  DotGraph v
toDirectedDot :: forall v e.
(Hashable v, Ord v, Show v, Show e) =>
Bool -> DGraph v e -> DotGraph v
toDirectedDot Bool
labelEdges DGraph v e
g = forall cl n nl el l.
(Ord cl, Ord n) =>
GraphvizParams n nl el cl l
-> [(n, nl)] -> [(n, n, el)] -> DotGraph n
graphElemsToDot forall {t} {l}. GraphvizParams t l FilePath () l
params (forall (g :: * -> * -> *) v e.
(Graph g, Show v) =>
g v e -> [(v, FilePath)]
labeledNodes DGraph v e
g) (forall v e.
(Hashable v, Show e) =>
DGraph v e -> [(v, v, FilePath)]
labeledArcs DGraph v e
g)
  where
    params :: GraphvizParams t l FilePath () l
params = forall t l. Bool -> Bool -> GraphvizParams t l FilePath () l
sensibleDotParams Bool
True Bool
labelEdges

-- | A copy of @sensibleDotParams@ method from 'Data.Graph.Visualize'.
sensibleDotParams ::
  Bool ->
  Bool ->
  GraphvizParams t l String () l
sensibleDotParams :: forall t l. Bool -> Bool -> GraphvizParams t l FilePath () l
sensibleDotParams Bool
directed Bool
edgeLabeled =
  forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams
    { isDirected :: Bool
isDirected = Bool
directed,
      globalAttributes :: [GlobalAttributes]
globalAttributes =
        [ Attributes -> GlobalAttributes
GraphAttrs [Overlap -> Attribute
Overlap Overlap
ScaleOverlaps]
        ],
      fmtEdge :: (t, t, FilePath) -> Attributes
fmtEdge = forall {a} {b}. (a, b, FilePath) -> Attributes
edgeFmt
    }
  where
    edgeFmt :: (a, b, FilePath) -> Attributes
edgeFmt (a
_, b
_, FilePath
l) =
      [Label -> Attribute
Label forall a b. (a -> b) -> a -> b
$ EscString -> Label
StrLabel forall a b. (a -> b) -> a -> b
$ FilePath -> EscString
TL.pack FilePath
l | Bool
edgeLabeled]

-- | A copy of @labeledNodes@ method from 'Data.Graph.Visualize'.
labeledNodes :: (Graph g, Show v) => g v e -> [(v, String)]
labeledNodes :: forall (g :: * -> * -> *) v e.
(Graph g, Show v) =>
g v e -> [(v, FilePath)]
labeledNodes g v e
g = (\v
v -> (v
v, forall a. Show a => a -> FilePath
show v
v)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: * -> * -> *) v e. Graph g => g v e -> [v]
vertices g v e
g

-- | A copy of @labeledNodes@ method from 'Data.Graph.Visualize'.
labeledArcs :: (Hashable v, Show e) => DGraph v e -> [(v, v, String)]
labeledArcs :: forall v e.
(Hashable v, Show e) =>
DGraph v e -> [(v, v, FilePath)]
labeledArcs DGraph v e
g = (\(Arc v
v1 v
v2 e
attr) -> (v
v1, v
v2, forall a. Show a => a -> FilePath
show e
attr)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v e. (Hashable v, Eq v) => DGraph v e -> [Arc v e]
arcs DGraph v e
g