module Compare.GraphDebugger (debugGraph) where

import           Data.Semigroup
import           Data.Tuple

import           Control.Monad.Reader
import qualified Data.Graph.Inductive.Graph as G
import           Data.Text (Text)
import qualified Data.Text as T
import           Lens.Micro
import           System.Console.Haskeline
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM

import           Compare.Types
import           Compare.Types.Lenses

data State = State
  { stGraph :: Graph Text Text
  , stNodes :: HashMap Text G.Node
  }

type M = InputT (ReaderT State IO)

debugGraph :: Graph Text Text -> IO ()
debugGraph g =
  let
    nodeMap = HM.fromList $ map swap (g^. _graph . to G.labNodes)
    state = State g nodeMap
  in
    runReaderT (runInputT defaultSettings loop) state
  where
    loop :: M ()
    loop = do
      input <- fmap words <$> getInputLine "> "
      case input of
        Nothing -> return ()
        Just [] -> loop
        Just ("help":_) -> help >> loop
        Just ("stat":args) -> stat args >> loop
        Just ("entry":args) -> entry args >> loop
        Just ("out":args) -> outEdges args >> loop
        Just ("in":args) -> inEdges args >> loop
        Just (cmd:_) -> outputStrLn ("Unknown command " <> cmd) >> loop

help :: M ()
help = outputStr $ unlines $
  [ "Available commands: "
  , "  help"
  ]

type Command = [String] -> M ()

stat :: Command
stat [] = do
  g <- lift $ asks stGraph
  outputStrLn ("Node count: " <> show (g ^. _graph . to G.noNodes))
  outputStrLn ("Edge count: " <> show (g ^. _graph . to G.size))
stat _ = outputStrLn "Invalid arguments for \"stat\""

entry :: Command
entry [] = do
  g <- lift $ asks stGraph
  outputStrLn ("Entry node " <> T.unpack (g ^. node (g ^. _point)))
entry _ = outputStrLn "Invalid arguments for \"entry\""

outEdges :: Command
outEdges [n] = do
  State g nodes <- lift ask
  case HM.lookup (T.pack n) nodes of
    Nothing -> outputStrLn "Node not found"
    Just n' -> do
      forM_ (g^..out n') $ \(_,to,l) ->
        outputStrLn ("--" <> T.unpack l <> "->  " <> T.unpack (g^?!node to))
outEdges _ = outputStrLn "Invalid arguments for \"out\""

inEdges :: Command
inEdges [n] = do
  State g nodes <- lift ask
  case HM.lookup (T.pack n) nodes of
    Nothing -> outputStrLn "Node not found"
    Just n' -> do
      forM_ (g^..inn n') $ \(_,to,l) ->
        outputStrLn ("--" <> T.unpack l <> "->  " <> T.unpack (g^?!node to))
inEdges _ = outputStrLn "Invalid arguments for \"in\""