{-# 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 :: DGraph v e -> IO ThreadId
plotDGraph DGraph v e
g = IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ GraphvizCommand -> DotGraph v -> GraphvizCanvas -> IO ()
forall (dg :: * -> *) n.
PrintDotRepr dg n =>
GraphvizCommand -> dg n -> GraphvizCanvas -> IO ()
runGraphvizCanvas GraphvizCommand
Dot (Bool -> DGraph v e -> DotGraph v
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 :: DGraph v e -> FilePath -> IO FilePath
plotDGraphPng DGraph v e
g = (GraphvizOutput -> FilePath -> IO FilePath)
-> GraphvizOutput -> FilePath -> IO FilePath
forall a.
(GraphvizOutput -> FilePath -> a)
-> GraphvizOutput -> FilePath -> a
addExtension (GraphvizCommand
-> DotGraph v -> GraphvizOutput -> FilePath -> IO FilePath
forall (dg :: * -> *) n.
PrintDotRepr dg n =>
GraphvizCommand
-> dg n -> GraphvizOutput -> FilePath -> IO FilePath
runGraphvizCommand GraphvizCommand
Dot (DotGraph v -> GraphvizOutput -> FilePath -> IO FilePath)
-> DotGraph v -> GraphvizOutput -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Bool -> DGraph v e -> DotGraph v
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 :: Bool -> DGraph v e -> DotGraph v
toDirectedDot Bool
labelEdges DGraph v e
g = GraphvizParams v FilePath FilePath () FilePath
-> [(v, FilePath)] -> [(v, v, FilePath)] -> DotGraph v
forall cl n nl el l.
(Ord cl, Ord n) =>
GraphvizParams n nl el cl l
-> [(n, nl)] -> [(n, n, el)] -> DotGraph n
graphElemsToDot GraphvizParams v FilePath FilePath () FilePath
forall t l. GraphvizParams t l FilePath () l
params (DGraph v e -> [(v, FilePath)]
forall (g :: * -> * -> *) v e.
(Graph g, Show v) =>
g v e -> [(v, FilePath)]
labeledNodes DGraph v e
g) (DGraph v e -> [(v, v, FilePath)]
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 = Bool -> Bool -> GraphvizParams t l FilePath () l
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 :: Bool -> Bool -> GraphvizParams t l FilePath () l
sensibleDotParams Bool
directed Bool
edgeLabeled =
  GraphvizParams t l Any () l
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 = (t, t, FilePath) -> Attributes
forall a b. (a, b, FilePath) -> Attributes
edgeFmt
    }
  where
    edgeFmt :: (a, b, FilePath) -> Attributes
edgeFmt (a
_, b
_, FilePath
l) =
      [Label -> Attribute
Label (Label -> Attribute) -> Label -> Attribute
forall a b. (a -> b) -> a -> b
$ EscString -> Label
StrLabel (EscString -> Label) -> EscString -> Label
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 :: g v e -> [(v, FilePath)]
labeledNodes g v e
g = (\v
v -> (v
v, v -> FilePath
forall a. Show a => a -> FilePath
show v
v)) (v -> (v, FilePath)) -> [v] -> [(v, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g v e -> [v]
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 :: DGraph v e -> [(v, v, FilePath)]
labeledArcs DGraph v e
g = (\(Arc v
v1 v
v2 e
attr) -> (v
v1, v
v2, e -> FilePath
forall a. Show a => a -> FilePath
show e
attr)) (Arc v e -> (v, v, FilePath)) -> [Arc v e] -> [(v, v, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DGraph v e -> [Arc v e]
forall v e. (Hashable v, Eq v) => DGraph v e -> [Arc v e]
arcs DGraph v e
g