module Main where

import DotParser
import Mealy
import MealyRefine

-- import Control.Monad.IO.Class (liftIO)
-- import Control.Monad.Trans.State.Strict
import Control.Monad (forM_)
-- import Data.Map.Strict qualified as Map
import Data.Maybe (mapMaybe)
import Data.Partition (isRefinementOf, numBlocks)
-- import Data.Semigroup (Arg(..))
-- import Data.Set qualified as Set
-- import Data.List.Ordered (nubSort)
import System.Environment
import Text.Megaparsec

{-
  Hacked together, you can view the result with:

    tred relation.dot | dot -Tpng -G"rankdir=BT" > relation.png

  tred is the graphviz tool to remove transitive edges. And the rankdir
  attribute flips the graph upside down.
-}
main :: IO ()
main = do
  -- Read dot file
  [dotFile] <- getArgs
  print dotFile
  transitions <- mapMaybe (parseMaybe parseTransFull) . lines <$> readFile dotFile

  -- convert to mealy
  let machine = convertToMealy transitions

  -- print some basic info
  putStrLn $ (show . length $ states machine) <> " states, " <> (show . length $ inputs machine) <> " inputs and " <> (show . length $ outputs machine) <> " outputs"
  putStrLn "Small sample:"
  print . take 4 . states $ machine
  print . take 4 . inputs $ machine
  print . take 4 . outputs $ machine

  -- DEBUG OUTPUT
  -- forM_ (states machine) (\s -> do
  --   print s
  --   forM_ (inputs machine) (\i -> do
  --     putStr "  "
  --     let (o, t) = behaviour machine s i
  --     putStrLn $ "--" <> (show i) <> "/" <> (show o) <> "->" <> (show t)
  --     )
  --   )

  let printPartition p = putStrLn $ "number of states = " <> show (numBlocks p)

  -- Minimise input, so we know the actual number of states
  printPartition (refineMealy (mealyMachineToEncoding machine))
  putStrLn ""

  -- Then compute each projection
  -- I did some manual preprocessing, these are the only interesting bits
  let outs = ["10", "10-O9", "2.2", "3.0", "3.1", "3.10", "3.12", "3.13", "3.14", "3.16", "3.17", "3.18", "3.19", "3.2", "3.20", "3.21", "3.3", "3.4", "3.6", "3.7", "3.8", "3.9", "5.0", "5.1", "5.12", "5.13", "5.17", "5.2", "5.21", "5.23", "5.6", "5.7", "5.8", "5.9", "quiescence"]
      -- outs = outputs machine
      projections0 = allProjections machine outs
      projections = zip outs $ fmap refineMealy projections0

  -- Print number of states of each projection
  forM_ projections (\(o, partition) -> do
    putStr $ o <> " -> "
    printPartition partition
    )

  {-

  -- Check refinement relations for all pairs
  -- This is a bit messy, it skips machines which are equivalent
  -- to earlier checked machines, so we thread some state through this
  -- computation. (And I also want some IO for debugging purposes.)
  (equiv, rel) <- flip execStateT (Map.empty, []) $ do
    forM_ projections (\(o1, b1) -> do
      (repr, _) <- get
      if o1 `Map.member` repr
        then do
          liftIO . putStrLn $ "skip " <> (show o1) <> " |-> " <> (show (repr Map.! o1))
        else do
          liftIO $ print o1
          forM_ projections (\(o2, b2) -> do
            (repr0, _) <- get
            when (o1 < o2 && o2 `Map.notMember` repr0) $ do
              case (isRefinementOf b1 b2, isRefinementOf b2 b1) of
                (True, True) -> do
                  (repr, ls) <- get
                  put (Map.insert o2 o1 repr, ls)
                (True, False) -> do
                  (repr, ls) <- get
                  put (repr, (o1, o2):ls)
                (False, True) -> do
                  (repr, ls) <- get
                  put (repr, (o2, o1):ls)
                (False, False) -> return ()

              -- liftIO $ putStr " vs. "
              -- liftIO $ print o2
            )
      )

  putStrLn ""
  putStrLn "Equivalences"
  forM_ (Map.assocs equiv) (\(o2, o1) -> do
    putStrLn $ "  " <> (show o2) <> " == " <> (show o1)
    )

  let cleanRel = [(Map.findWithDefault o1 o1 equiv, Map.findWithDefault o2 o2 equiv) | (o1, o2) <- rel]
  putStrLn ""
  putStrLn "Relation (smaller points to bigger)"
  forM_ (nubSort cleanRel) (\(o1, o2) -> do
    putStrLn $ "  " <> (show o2) <> " -> " <> (show o1)
    )

  return ()

  -}