module Language.Lexer.Tlex.Plugin.Debug (
    outputDfaToDot,
    Graphviz.outputAst,
) where

import           Language.Lexer.Tlex.Prelude

import qualified Data.EnumMap.Strict                       as EnumMap
import qualified Data.HashMap.Strict                       as HashMap
import qualified Data.IntMap.Strict                        as IntMap
import qualified Data.IntSet                               as IntSet
import qualified Language.Lexer.Tlex.Machine.DFA           as DFA
import qualified Language.Lexer.Tlex.Machine.State         as MState
import qualified Language.Lexer.Tlex.Plugin.Debug.Graphviz as Graphviz
import qualified Prelude


newtype EdgeBuilder = EdgeBuilder
    { EdgeBuilder -> HashMap (StateNum, StateNum) IntSet
unEdgeBuilder :: HashMap.HashMap
        (MState.StateNum, MState.StateNum)
        IntSet.IntSet
    }

instance Semigroup EdgeBuilder where
    EdgeBuilder HashMap (StateNum, StateNum) IntSet
m1 <> :: EdgeBuilder -> EdgeBuilder -> EdgeBuilder
<> EdgeBuilder HashMap (StateNum, StateNum) IntSet
m2 = HashMap (StateNum, StateNum) IntSet -> EdgeBuilder
EdgeBuilder do forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith forall a. Semigroup a => a -> a -> a
(<>) HashMap (StateNum, StateNum) IntSet
m1 HashMap (StateNum, StateNum) IntSet
m2

instance Monoid EdgeBuilder where
    mempty :: EdgeBuilder
mempty = HashMap (StateNum, StateNum) IntSet -> EdgeBuilder
EdgeBuilder forall k v. HashMap k v
HashMap.empty

edgeBuilder :: MState.StateNum -> Int -> MState.StateNum -> EdgeBuilder
edgeBuilder :: StateNum -> Key -> StateNum -> EdgeBuilder
edgeBuilder StateNum
sf Key
lb StateNum
st = HashMap (StateNum, StateNum) IntSet -> EdgeBuilder
EdgeBuilder do forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (StateNum
sf, StateNum
st) do Key -> IntSet
IntSet.singleton Key
lb

outputDfaToDot :: DFA.DFA a -> Graphviz.Ast
outputDfaToDot :: forall a. DFA a -> Ast
outputDfaToDot DFA a
dfa = Graphviz.Ast
    { $sel:nodes:Ast :: [Node]
Graphviz.nodes = Node
initialNode forall a. a -> [a] -> [a]
:
        [ forall {a} {a}. Enum a => a -> DFAState a -> Node
node StateNum
sn DFAState a
dst
        | (StateNum
sn, DFAState a
dst) <- forall a. StateArray a -> [(StateNum, a)]
MState.arrayAssocs do forall a. DFA a -> StateArray (DFAState a)
DFA.dfaTrans DFA a
dfa
        ]
    , $sel:edges:Ast :: [Edge]
Graphviz.edges = [Edge]
initialEdges forall a. [a] -> [a] -> [a]
++
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            do \(StateNum
sn, DFAState a
dst) -> forall {a}. StateNum -> DFAState a -> [Edge]
edges StateNum
sn DFAState a
dst
            do forall a. StateArray a -> [(StateNum, a)]
MState.arrayAssocs do forall a. DFA a -> StateArray (DFAState a)
DFA.dfaTrans DFA a
dfa
    }
    where
        initialNode :: Node
initialNode = Graphviz.Node
            { $sel:nodeId:Node :: NodeId
Graphviz.nodeId = NodeId
"init"
            , $sel:nodeLabel:Node :: Maybe NodeId
Graphviz.nodeLabel = forall a. Maybe a
Nothing
            , $sel:nodeShape:Node :: Maybe NodeShape
Graphviz.nodeShape = forall a. Maybe a
Nothing
            }

        node :: a -> DFAState a -> Node
node a
sn DFAState a
dst = Graphviz.Node
            { $sel:nodeId:Node :: NodeId
Graphviz.nodeId = forall a. Show a => a -> NodeId
show do forall a. Enum a => a -> Key
fromEnum a
sn
            , $sel:nodeLabel:Node :: Maybe NodeId
Graphviz.nodeLabel = forall a. Maybe a
Nothing
            , $sel:nodeShape:Node :: Maybe NodeShape
Graphviz.nodeShape = case forall a. DFAState a -> [Accept a]
DFA.dstAccepts DFAState a
dst of
                [] -> forall a. Maybe a
Nothing
                [Accept a]
_  -> forall a. a -> Maybe a
Just NodeShape
Graphviz.DoubleCircle
            }

        initialEdges :: [Edge]
initialEdges =
            [ Graphviz.Edge
                { $sel:edgeFrom:Edge :: NodeId
Graphviz.edgeFrom = NodeId
"init"
                , $sel:edgeTo:Edge :: NodeId
Graphviz.edgeTo = forall a. Show a => a -> NodeId
show do forall a. Enum a => a -> Key
fromEnum StateNum
sn
                , $sel:edgeLabel:Edge :: Maybe NodeId
Graphviz.edgeLabel = forall a. Maybe a
Nothing
                }
            | (StartState
_, StateNum
sn) <- forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.assocs do forall a. DFA a -> EnumMap StartState StateNum
DFA.dfaInitials DFA a
dfa
            ]

        edges :: StateNum -> DFAState a -> [Edge]
edges StateNum
sn DFAState a
dst =
            let builder :: EdgeBuilder
builder =
                    do case forall a. DFAState a -> Maybe StateNum
DFA.dstOtherTrans DFAState a
dst of
                        Maybe StateNum
Nothing -> forall a. Monoid a => a
mempty
                        Just StateNum
ot -> StateNum -> Key -> StateNum -> EdgeBuilder
edgeBuilder StateNum
sn Key
-1 StateNum
ot
                    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                        do \(Key
lb, StateNum
to) -> StateNum -> Key -> StateNum -> EdgeBuilder
edgeBuilder StateNum
sn Key
lb StateNum
to
                        do forall a. IntMap a -> [(Key, a)]
IntMap.assocs do forall a. DFAState a -> IntMap StateNum
DFA.dstTrans DFAState a
dst
            in
                [ StateNum -> IntSet -> StateNum -> Edge
edge StateNum
fr IntSet
lb StateNum
to
                | ((StateNum
fr, StateNum
to), IntSet
lb) <- forall k v. HashMap k v -> [(k, v)]
HashMap.toList do EdgeBuilder -> HashMap (StateNum, StateNum) IntSet
unEdgeBuilder EdgeBuilder
builder
                ]

        edge :: MState.StateNum -> IntSet.IntSet -> MState.StateNum -> Graphviz.Edge
        edge :: StateNum -> IntSet -> StateNum -> Edge
edge StateNum
fr IntSet
lb StateNum
to = Graphviz.Edge
            { $sel:edgeFrom:Edge :: NodeId
Graphviz.edgeFrom = forall a. Show a => a -> NodeId
show do forall a. Enum a => a -> Key
fromEnum StateNum
fr
            , $sel:edgeTo:Edge :: NodeId
Graphviz.edgeTo = forall a. Show a => a -> NodeId
show do forall a. Enum a => a -> Key
fromEnum StateNum
to
            , $sel:edgeLabel:Edge :: Maybe NodeId
Graphviz.edgeLabel = IntSet -> Maybe NodeId
edgeLabel IntSet
lb
            }

edgeLabel :: IntSet.IntSet -> Maybe Prelude.String
edgeLabel :: IntSet -> Maybe NodeId
edgeLabel IntSet
xs0 = case IntSet -> [Key]
IntSet.toAscList IntSet
xs0 of
    []    -> forall a. Maybe a
Nothing
    Key
x0:[Key]
xs ->
        let endPrevRange :: (NodeId -> c, a, Bool) -> NodeId -> c
endPrevRange (NodeId -> c
s, a
p, Bool
b) = case Bool
b of
                Bool
True  -> NodeId -> c
s
                Bool
False -> NodeId -> c
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeId
"-" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Show a => a -> NodeId
show a
p forall a. [a] -> [a] -> [a]
++)
            s0 :: NodeId -> NodeId
s0 = forall {a} {c}. Show a => (NodeId -> c, a, Bool) -> NodeId -> c
endPrevRange
                do forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                    do \ctx :: (NodeId -> NodeId, Key, Bool)
ctx@(!NodeId -> NodeId
s, !Key
p, Bool
_) Key
x -> if
                        | Key
x forall a. Eq a => a -> a -> Bool
== Key
p forall a. Num a => a -> a -> a
+ Key
1 -> (NodeId -> NodeId
s, Key
x, Bool
False)
                        | Bool
otherwise  ->
                            ( forall {a} {c}. Show a => (NodeId -> c, a, Bool) -> NodeId -> c
endPrevRange (NodeId -> NodeId, Key, Bool)
ctx forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeId
"," forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Show a => a -> NodeId
show Key
x forall a. [a] -> [a] -> [a]
++)
                            , Key
x
                            , Bool
True
                            )
                    do ((forall a. Show a => a -> NodeId
show Key
x0 forall a. [a] -> [a] -> [a]
++), Key
x0, Bool
True)
                    do [Key]
xs
        in forall a. a -> Maybe a
Just do NodeId
"[" forall a. [a] -> [a] -> [a]
++ NodeId -> NodeId
s0 NodeId
"]"