module Tessera.Graph where

import Tessera.Matrix (Key (..))
import Tessera.Tree

data Rendered = Rendered
  { renderedNext :: Int
  , renderedRoot :: Int
  , renderedNodes :: [(Int, String, String)]
  , renderedEdges :: [(Int, Int, String)]
  }

buildGraph :: Tree -> Rendered
buildGraph tree =
  let (next, root, nodes, edges) = go tree 0
  in Rendered next root nodes edges
  where
    go node next = case node of
      Success index ->
        (next + 1, next, [(next, "clause " ++ show index, "success")], [])
      Failure ->
        (next + 1, next, [(next, "fail", "failure")], [])
      Bind occurrence name inner ->
        let (next', root', nodes', edges') = go inner (next + 1)
        in (next', next, (next, "bind " ++ renderPath (occurrencePath occurrence) ++ " " ++ name, "bind") : nodes', (next, root', "bind") : edges')
      Switch occurrence branches fallback ->
        let (afterBranches, branchRoots, branchNodes, branchEdges) = goBranches branches (next + 1) [] [] []
            (afterFallback, fallbackRoots, fallbackNodes, fallbackEdges) = case fallback of
              Nothing -> (afterBranches, [], [], [])
              Just defaultTree ->
                let (finalNext, root', nodes', edges') = go defaultTree afterBranches
                in (finalNext, [(root', "default")], nodes', edges')
            node = (next, "switch " ++ renderPath (occurrencePath occurrence), "switch")
            edges = [(next, r, l) | (r, l) <- branchRoots] ++ [(next, r, l) | (r, l) <- fallbackRoots]
        in (afterFallback, next, node : branchNodes ++ fallbackNodes, edges ++ branchEdges ++ fallbackEdges)

    goBranches [] next roots nodes edges = (next, reverse roots, nodes, edges)
    goBranches ((key, subtree) : rest) next roots nodes edges =
      let (next', root', nodes', edges') = go subtree next
      in goBranches rest next' ((root', renderKey key) : roots) (nodes ++ nodes') (edges ++ edges')

renderPath :: [Int] -> String
renderPath [] = "root"
renderPath [x] = show x
renderPath (x : rest) = show x ++ "." ++ renderPath rest

renderKey :: Key -> String
renderKey key = case key of
  KeyCon name -> name
  KeyInt n -> show n
  KeyBool b -> if b then "True" else "False"
  KeyTuple n -> "tuple/" ++ show n

renderDot :: Tree -> String
renderDot tree = unlines (header ++ map renderNode (renderedNodes graph) ++ map renderEdge (renderedEdges graph) ++ ["}"])
  where
    graph = buildGraph tree
    header =
      [ "digraph tessera {"
      , "  graph [bgcolor=\"white\", rankdir=TB, nodesep=0.35, ranksep=0.5];"
      , "  node [shape=box, style=\"rounded,filled\", color=\"#444444\", fontcolor=\"#1c1c1a\", fillcolor=\"#ffffff\", fontname=\"Helvetica\", fontsize=11];"
      , "  edge [color=\"#666666\", fontcolor=\"#333333\", fontname=\"Helvetica\", fontsize=10];"
      ]
    renderNode (identifier, label, kind) =
      "  n" ++ show identifier ++ " [label=\"" ++ escape label ++ "\"" ++ fillFor kind ++ "];"
    renderEdge (from, to, label) =
      "  n" ++ show from ++ " -> n" ++ show to ++ " [label=\"" ++ escape label ++ "\"];"
    fillFor kind = case kind of
      "success" -> ", fillcolor=\"#e7efe4\""
      "failure" -> ", fillcolor=\"#f4e6e4\""
      "switch" -> ", fillcolor=\"#f7f7f5\""
      _ -> ""

escape :: String -> String
escape = concatMap escapeChar
  where
    escapeChar c = case c of
      '"' -> "\\\""
      '\\' -> "\\\\"
      '\n' -> "\\n"
      _ -> [c]