{-# OPTIONS_HADDOCK show-extensions #-}

-- | Module    :  Debug.SimpleExpr.GraphUtils
-- Copyright   :  (C) 2023 Alexey Tochin
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>
--
-- Tools for transforming simple expressions to graphs from @graphite@.
module Debug.SimpleExpr.GraphUtils
  ( -- * Conversion simple expressions to graphs
    exprToGraph,

    -- * Visualisation
    plotExpr,
    plotDGraphPng,

    -- * Auxiliary functions
    simpleExprToGraph,
    appendNodeToGraph,
  )
where

import Control.Concurrent (ThreadId)
import Data.Fix (Fix (..))
import Data.Graph.DGraph (DGraph, insertArc)
import Data.Graph.Types (Arc (..), empty, insertVertex, union)
import Data.Graph.VisualizeAlternative (plotDGraph, plotDGraphPng)
import Debug.SimpleExpr.Expr (Expr, SimpleExpr, SimpleExprF (..), content, dependencies)
import Prelude (IO, String, fmap, foldr, show, ($), (.))

-- | Transforms a simple expression to graph.
simpleExprToGraph :: SimpleExpr -> DGraph String ()
simpleExprToGraph :: SimpleExpr -> DGraph String ()
simpleExprToGraph (Fix SimpleExprF SimpleExpr
e) = case SimpleExprF SimpleExpr
e of
  NumberF Integer
n -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph (Integer -> String
forall a. Show a => a -> String
show Integer
n) [] DGraph String ()
graph
  VariableF String
c -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph String
c [] DGraph String ()
graph
  BinaryFuncF String
_ SimpleExpr
a SimpleExpr
b -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph (SimpleExpr -> String
forall a. Show a => a -> String
show (SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF SimpleExpr
e)) [SimpleExpr -> String
forall a. Show a => a -> String
show SimpleExpr
a, SimpleExpr -> String
forall a. Show a => a -> String
show SimpleExpr
b] DGraph String ()
graph
  SymbolicFuncF String
_ [SimpleExpr]
args' -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph (SimpleExpr -> String
forall a. Show a => a -> String
show (SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF SimpleExpr
e)) ((SimpleExpr -> String) -> [SimpleExpr] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleExpr -> String
forall a. Show a => a -> String
show [SimpleExpr]
args') DGraph String ()
graph
  where
    graph :: DGraph String ()
graph = [SimpleExpr] -> DGraph String ()
forall d. Expr d => d -> DGraph String ()
exprToGraph ([SimpleExpr] -> DGraph String ())
-> [SimpleExpr] -> DGraph String ()
forall a b. (a -> b) -> a -> b
$ SimpleExpr -> [SimpleExpr]
dependencies (SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF SimpleExpr
e)

-- | Appends a node to a graph using string valued keys.
--
-- The first argumet is the new node name.
--
-- The second argument is the list of dependent nodes.
appendNodeToGraph :: String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph :: String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph String
newNodeName [String]
depNodeNames DGraph String ()
graph = (String -> DGraph String () -> DGraph String ())
-> DGraph String () -> [String] -> DGraph String ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> DGraph String () -> DGraph String ()
addArc DGraph String ()
initGraph [String]
depNodeNames
  where
    addArc :: String -> DGraph String () -> DGraph String ()
addArc String
depName = Arc String () -> DGraph String () -> DGraph String ()
forall v e.
(Hashable v, Eq v) =>
Arc v e -> DGraph v e -> DGraph v e
insertArc (String -> String -> () -> Arc String ()
forall v e. v -> v -> e -> Arc v e
Arc String
depName String
newNodeName ())
    initGraph :: DGraph String ()
initGraph = String -> DGraph String () -> DGraph String ()
forall (g :: * -> * -> *) v e.
(Graph g, Hashable v, Eq v) =>
v -> g v e -> g v e
insertVertex String
newNodeName DGraph String ()
graph

-- | Transforms an expression to graph.
--
-- ==== __Examples of usage__
--
-- >>> import Debug.SimpleExpr (variable)
-- >>> import NumHask ((+), (-))
--
-- >>> x = variable "x"
-- >>> y = variable "y"
-- >>> exprToGraph [x + y, x - y]
-- fromList [("x",[("x+y",()),("x-y",())]),("x+y",[]),("x-y",[]),("y",[("x+y",()),("x-y",())])]
exprToGraph :: Expr d => d -> DGraph String ()
exprToGraph :: d -> DGraph String ()
exprToGraph d
d = case d -> [SimpleExpr]
forall inner outer. ListOf inner outer => outer -> [inner]
content d
d of
  [] -> DGraph String ()
forall (g :: * -> * -> *) v e. (Graph g, Hashable v) => g v e
empty -- insertVertex (name e) empty
  [SimpleExpr
v] -> SimpleExpr -> DGraph String ()
simpleExprToGraph SimpleExpr
v
  (SimpleExpr
v : [SimpleExpr]
vs) -> SimpleExpr -> DGraph String ()
simpleExprToGraph SimpleExpr
v DGraph String () -> DGraph String () -> DGraph String ()
forall (g :: * -> * -> *) v e.
(Graph g, Hashable v, Eq v) =>
g v e -> g v e -> g v e
`union` [SimpleExpr] -> DGraph String ()
forall d. Expr d => d -> DGraph String ()
exprToGraph [SimpleExpr]
vs -- insertArc newArcV addedV where

-- | Visualizes an expression.
--
-- ==== __Examples of usage__
--
-- >>> import Debug.SimpleExpr (number, variable)
-- >>> import NumHask ((+), (-))
-- >>> import Data.Graph.VisualizeAlternative (plotDGraphPng)
--
-- @>>> plotExpr (number 1 + variable "x")@
--
-- ![1+x](doc/images/demo1.png)
--
-- >>> x = variable "x"
-- >>> y = variable "y"
--
-- @>>> plotExpr [x + y, x - y]@
--
-- ![x+y,x-y](doc/images/demo2.png)
plotExpr :: Expr d => d -> IO ThreadId
plotExpr :: d -> IO ThreadId
plotExpr = DGraph String () -> IO ThreadId
forall v e.
(Hashable v, Ord v, PrintDot v, Show v, Show e) =>
DGraph v e -> IO ThreadId
plotDGraph (DGraph String () -> IO ThreadId)
-> (d -> DGraph String ()) -> d -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> DGraph String ()
forall d. Expr d => d -> DGraph String ()
exprToGraph