{-# 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 :: Fix SimpleExprF -> DGraph String ()
simpleExprToGraph (Fix SimpleExprF (Fix SimpleExprF)
e) = case SimpleExprF (Fix SimpleExprF)
e of
  NumberF Integer
n -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph (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
_ Fix SimpleExprF
a Fix SimpleExprF
b -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph (forall a. Show a => a -> String
show (forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF (Fix SimpleExprF)
e)) [forall a. Show a => a -> String
show Fix SimpleExprF
a, forall a. Show a => a -> String
show Fix SimpleExprF
b] DGraph String ()
graph
  SymbolicFuncF String
_ [Fix SimpleExprF]
args' -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph (forall a. Show a => a -> String
show (forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF (Fix SimpleExprF)
e)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show [Fix SimpleExprF]
args') DGraph String ()
graph
  where
    graph :: DGraph String ()
graph = forall d. Expr d => d -> DGraph String ()
exprToGraph forall a b. (a -> b) -> a -> b
$ Fix SimpleExprF -> [Fix SimpleExprF]
dependencies (forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF (Fix SimpleExprF)
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 = 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 = forall v e.
(Hashable v, Eq v) =>
Arc v e -> DGraph v e -> DGraph v e
insertArc (forall v e. v -> v -> e -> Arc v e
Arc String
depName String
newNodeName ())
    initGraph :: DGraph String ()
initGraph = 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]
-- ...
--
-- We expect something like
-- @fromList [("y",[("x-y",()),("x+y",())]),("x-y",[]),("x",[("x-y",()),("x+y",())]),("x+y",[])]@
-- depending on the packages version version.
exprToGraph :: Expr d => d -> DGraph String ()
exprToGraph :: forall d. Expr d => d -> DGraph String ()
exprToGraph d
d = case forall inner outer. ListOf inner outer => outer -> [inner]
content d
d of
  [] -> forall (g :: * -> * -> *) v e. (Graph g, Hashable v) => g v e
empty -- insertVertex (name e) empty
  [Fix SimpleExprF
v] -> Fix SimpleExprF -> DGraph String ()
simpleExprToGraph Fix SimpleExprF
v
  (Fix SimpleExprF
v : [Fix SimpleExprF]
vs) -> Fix SimpleExprF -> DGraph String ()
simpleExprToGraph Fix SimpleExprF
v forall (g :: * -> * -> *) v e.
(Graph g, Hashable v, Eq v) =>
g v e -> g v e -> g v e
`union` forall d. Expr d => d -> DGraph String ()
exprToGraph [Fix SimpleExprF]
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 :: forall d. Expr d => d -> IO ThreadId
plotExpr = forall v e.
(Hashable v, Ord v, PrintDot v, Show v, Show e) =>
DGraph v e -> IO ThreadId
plotDGraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Expr d => d -> DGraph String ()
exprToGraph