{-# 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 Natural
n -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph (Natural -> String
forall a. Show a => a -> String
show Natural
n) [] DGraph String ()
graph
  VariableF String
c -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph String
c [] DGraph String ()
graph
  --  BinaryFuncF _ a b -> appendNodeToGraph (show (Fix e)) [show a, show b] graph
  SymbolicFuncF String
_ [Fix SimpleExprF]
args' -> String -> [String] -> DGraph String () -> DGraph String ()
appendNodeToGraph (Fix SimpleExprF -> String
forall a. Show a => a -> String
show (SimpleExprF (Fix SimpleExprF) -> Fix SimpleExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF (Fix SimpleExprF)
e)) ((Fix SimpleExprF -> String) -> [Fix SimpleExprF] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix SimpleExprF -> String
forall a. Show a => a -> String
show [Fix SimpleExprF]
args') DGraph String ()
graph
  where
    graph :: DGraph String ()
graph = [Fix SimpleExprF] -> DGraph String ()
forall d. Expr d => d -> DGraph String ()
exprToGraph ([Fix SimpleExprF] -> DGraph String ())
-> [Fix SimpleExprF] -> DGraph String ()
forall a b. (a -> b) -> a -> b
$ Fix SimpleExprF -> [Fix SimpleExprF]
dependencies (SimpleExprF (Fix SimpleExprF) -> Fix SimpleExprF
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 = (String -> DGraph String () -> DGraph String ())
-> DGraph String () -> [String] -> DGraph String ()
forall a b. (a -> b -> b) -> b -> [a] -> b
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 v e. (Hashable v, Eq v) => v -> DGraph v e -> DGraph v e
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 d -> [Fix SimpleExprF]
forall inner outer. ListOf inner outer => outer -> [inner]
content d
d of
  [] -> DGraph String ()
forall v e. Hashable v => DGraph v e
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 DGraph String () -> DGraph String () -> DGraph String ()
forall v e.
(Hashable v, Eq v) =>
DGraph v e -> DGraph v e -> DGraph v e
forall (g :: * -> * -> *) v e.
(Graph g, Hashable v, Eq v) =>
g v e -> g v e -> g v e
`union` [Fix SimpleExprF] -> DGraph String ()
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 = 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