module DotParser where

import Data.Char (isAlphaNum)
import Data.List.Ordered qualified as OrdList
import Data.Map.Strict qualified as Map
import Data.Void (Void)
import Mealy
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L

{-
   Parser for Dot files generated by the RERS LearnLib learner. This is not
   a fully fledged parser. It is specific to our models.

   Really only parses a single transition. We just collect all succesfull
   transitions. This gives all transitions.

   Usage:
     transitions <- mapMaybe (parseMaybe parseTransFull) . lines <$> readFile dotFile
-}

type Stat = String
type Input = String
type Output = String
type Trans = (Stat, Stat, Input, Output)

type Parser = Parsec Void String

parseTrans :: Parser Trans
parseTrans = assoc <$> identifierQ <* symbol "->" <*> identifierQ <*> brackets parseLabel <* optional (symbol ";")
  where
    -- defines whitespace and lexemes
    sc = L.space space1 empty empty
    lexeme = L.lexeme sc
    symbol = L.symbol sc
    -- state, input, output is any string of alphaNumChar's
    isAlphaNumExtra c = isAlphaNum c || c == '_' || c == '+' || c == '.' || c == ',' || c == '-' || c == '(' || c == ')'
    alphaNumCharExtra = satisfy isAlphaNumExtra <?> "alphanumeric character or extra"
    identifier = lexeme (some alphaNumCharExtra)
    identifierQ = identifier <|> between (symbol "\"") (symbol "\"") identifier
    -- The label has the shape [label="i/o"]
    brackets = between (symbol "[") (symbol "]")
    parseLabel = (,) <$> (symbol "label=\"" *> identifier <* symbol "/") <*> (identifier <* symbol "\"")
    -- re-associate different parts of the parser
    assoc from to (i, o) = (from, to, i, o)

parseTransFull :: Parser Trans
parseTransFull = space *> parseTrans <* eof

convertToMealy :: [Trans] -> MealyMachine String String String
convertToMealy l = MealyMachine
  { states = states
  , inputs = ins
  , outputs = outs
  , behaviour = \s i -> base Map.! (s, i)
  , initialState = (\(a,_,_,_) -> a) . head $ l
  -- ^ Assumption: first transition in the file belongs to the initial state
  }
  where
    froms = OrdList.nubSort . fmap (\(a,_,_,_) -> a) $ l
    tos   = OrdList.nubSort . fmap (\(_,a,_,_) -> a) $ l
    ins   = OrdList.nubSort . fmap (\(_,_,i,_) -> i) $ l
    outs  = OrdList.nubSort . fmap (\(_,_,_,o) -> o) $ l
    states = froms `OrdList.union` tos
    base = Map.fromList . fmap (\(from, to, i, o) -> ((from, i), (o, to))) $ l