module Symantic.Parser.Automaton.Dump where

import Data.Function (($), (.), id)
import Data.Functor ((<$>))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Text.Show (Show(..))
import qualified Data.Tree as Tree
import qualified Data.List as List

import Symantic.Parser.Automaton.Instructions

-- * Type 'DumpInstr'
newtype DumpInstr inp (vs:: [*]) (es::Peano) a x = DumpInstr { unDumpInstr :: Tree.Tree String }

dumpInstr :: DumpInstr inp vs es a x -> DumpInstr inp vs es a x
dumpInstr = id

instance Show (DumpInstr inp vs es a x) where
  show = drawTree . unDumpInstr
    where
    drawTree :: Tree.Tree String -> String
    drawTree  = List.unlines . draw
    draw :: Tree.Tree String -> [String]
    draw (Tree.Node x ts0) = List.lines x <> drawSubTrees ts0
      where
      drawSubTrees [] = []
      drawSubTrees [t] = shift "` " "  " (draw t)
      drawSubTrees (t:ts) = shift "+ " "| " (draw t) <> drawSubTrees ts
      shift first other = List.zipWith (<>) (first : List.repeat other)
instance IsString (DumpInstr inp vs es a x) where
  fromString s = DumpInstr $ Tree.Node (fromString s) []

instance Stackable DumpInstr where
  push a k = DumpInstr $ Tree.Node ("push "<>show a) [unDumpInstr k]
  pop k = DumpInstr $ Tree.Node "pop" [unDumpInstr k]
  liftI2 f k = DumpInstr $ Tree.Node ("liftI2 "<>show f) [unDumpInstr k]
  swap k = DumpInstr $ Tree.Node "swap" [unDumpInstr k]
instance Branchable DumpInstr where
  case_ l r = DumpInstr $ Tree.Node "case" [unDumpInstr l, unDumpInstr r]
  choices ps bs d = DumpInstr $ Tree.Node ("choices "<>show ps) ((unDumpInstr <$> bs) <> [unDumpInstr d])
instance Exceptionable DumpInstr where
  fail = DumpInstr $ Tree.Node "fail" []
  commit k = DumpInstr $ Tree.Node "commit" [unDumpInstr k]
  catch l r = DumpInstr $ Tree.Node "catch" [unDumpInstr l, unDumpInstr r]
instance Inputable DumpInstr where
  seek k = DumpInstr $ Tree.Node "seek" [unDumpInstr k]
  tell k = DumpInstr $ Tree.Node "tell" [unDumpInstr k]
instance Routinable DumpInstr where
  label n k = DumpInstr $ Tree.Node ("label "<>show n) [unDumpInstr k]
  jump n = DumpInstr $ Tree.Node ("jump "<>show n) []
  call n k = DumpInstr $ Tree.Node ("call "<>show n) [unDumpInstr k]
  ret = DumpInstr $ Tree.Node "ret" []
instance Readable DumpInstr where
  read _p k = DumpInstr $ Tree.Node "read" [unDumpInstr k]