    {-# LANGUAGE OverloadedStrings #-}
    -- Copyright 2024 United States Government as represented by the Administrator
    -- of the National Aeronautics and Space Administration. All Rights Reserved.
    --
    -- Disclaimers
    --
    -- Licensed under the Apache License, Version 2.0 (the "License"); you may
    -- not use this file except in compliance with the License. You may obtain a
    -- copy of the License at
    --
    --      https://www.apache.org/licenses/LICENSE-2.0
    --
    -- Unless required by applicable law or agreed to in writing, software
    -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
    -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
    -- License for the specific language governing permissions and limitations
    -- under the License.
    --
    -- | Parsing of diagrams from Mermaid files.
    module Data.Diagram.Parser.Mermaid
        ( parseDiagramMermaid
        )
      where

    -- External imports
    import           Control.Monad              (void, when)
    import           Data.ByteString.Lazy       (toStrict)
    import qualified Data.ByteString.Lazy       as B
    import           Data.Either                (isLeft)
    import           Data.Functor.Identity      (Identity)
    import qualified Data.Set                   as Set
    import           Data.Text                  (Text)
    import qualified Data.Text                  as T
    import qualified Data.Text.Encoding         as T
    import           Data.Void                  (Void)
    import           Text.Megaparsec            (ErrorFancy (ErrorFail), ParsecT,
                                                 choice, empty, errorBundlePretty,
                                                 fancyFailure, many, manyTill,
                                                 noneOf, parse, (<|>))
    import           Text.Megaparsec.Char       (alphaNumChar, char, digitChar,
                                                 newline, space1, string)
    import qualified Text.Megaparsec.Char.Lexer as L

    -- Internal imports: auxiliary
    import Data.Diagram  (Diagram (..))
    import Data.ExprPair (ExprPair (..), ExprPairT (..), exprPairShow)

    -- | Parse a mermaid diagram.
    parseDiagramMermaid :: B.ByteString -> ExprPair -> Either String Diagram
    parseDiagramMermaid :: ByteString -> ExprPair -> Either String Diagram
    parseDiagramMermaid ByteString
    txtDia ExprPair
    exprP =
        case Either (ParseErrorBundle Text Void) Diagram
    parsingResult of
          Left ParseErrorBundle Text Void
    e  -> String -> Either String Diagram
    forall a b. a -> Either a b
    Left (ParseErrorBundle Text Void -> String
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> String
    errorBundlePretty ParseErrorBundle Text Void
    e)
          Right Diagram
    x -> Diagram -> Either String Diagram
    forall a b. b -> Either a b
    Right Diagram
    x
      where
        txt :: Text
    txt           = ByteString -> Text
    T.decodeUtf8 (ByteString -> ByteString
    toStrict ByteString
    txtDia)
        parsingResult :: Either (ParseErrorBundle Text Void) Diagram
    parsingResult = Parsec Void Text Diagram
    -> String -> Text -> Either (ParseErrorBundle Text Void) Diagram
    forall e s a.
    Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
    parse (MermaidParser ()
    spaces MermaidParser ()
    -> Parsec Void Text Diagram -> Parsec Void Text Diagram
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ExprPair -> Parsec Void Text Diagram
    pDiagram ExprPair
    exprP) String
    "<input>" Text
    txt

    -- | Type for parser for memaid diagrams.
    type MermaidParser = ParsecT Void Text Identity

    -- | Parser for mermaid diagrams.
    pDiagram :: ExprPair -> MermaidParser Diagram
    pDiagram :: ExprPair -> Parsec Void Text Diagram
    pDiagram  ExprPair
    exprP =
          ExprPair -> Parsec Void Text Diagram
    pGraphDiagram ExprPair
    exprP
      Parsec Void Text Diagram
    -> Parsec Void Text Diagram -> Parsec Void Text Diagram
    forall a.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ExprPair -> Parsec Void Text Diagram
    pStateDiagram ExprPair
    exprP
      Parsec Void Text Diagram
    -> Parsec Void Text Diagram -> Parsec Void Text Diagram
    forall a.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ExprPair -> Parsec Void Text Diagram
    pSequenceDiagram ExprPair
    exprP

    -- | Parser for a mermaid diagram.
    --
    -- This parser depends on an auxiliary parser for the expressions associated to
    -- the edges or connections between states.
    pGraphDiagram :: ExprPair -> MermaidParser Diagram
    pGraphDiagram :: ExprPair -> Parsec Void Text Diagram
    pGraphDiagram ExprPair
    exprP = do
      _ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "graph" ParsecT Void Text Identity (Tokens Text)
    -> MermaidParser () -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* MermaidParser ()
    spaces
      _name <- T.pack <$> manyTill alphaNumChar (char ';')
      _ <- newline

      transitions <- many (pGraphTransition exprP)

      pure $ Diagram transitions

    -- | Parser for an edge in a state diagram.
    --
    -- This parser depends on an auxiliary parser for the expressions associated to
    -- the edges or connections between states.
    pGraphTransition :: ExprPair -> MermaidParser (Int, String, Int)
    pGraphTransition :: ExprPair -> ParsecT Void Text Identity (Int, String, Int)
    pGraphTransition ep :: ExprPair
    ep@(ExprPair (ExprPairT { exprTParse :: forall a. ExprPairT a -> String -> Either String a
    exprTParse = String -> Either String a
    parseProp })) = do
      _ <- MermaidParser ()
    spaces
      stateFrom <- many digitChar
      _ <- string "-->|"
      edge <- many (noneOf ("|" :: [Char]))

      let x = String -> Either String a
    parseProp String
    edge
      when (isLeft x) $ fancyFailure $ Set.singleton $
        ErrorFail $ "Edge property has incorrect format: " ++ show edge

      _ <- char '|'
      stateTo <- many digitChar
      _ <- char ';'
      _ <- newline
      return (read stateFrom, exprPairShow ep edge, read stateTo)

    -- | Parser for Mermaid diagrams of type stateDiagram-v2.
    pStateDiagram :: ExprPair -> MermaidParser Diagram
    pStateDiagram :: ExprPair -> Parsec Void Text Diagram
    pStateDiagram ExprPair
    exprPair = do
      _ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "stateDiagram-v2" ParsecT Void Text Identity (Tokens Text)
    -> MermaidParser () -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* MermaidParser ()
    spaces

      transitions <- many (pStateTransition exprPair)

      pure $ Diagram transitions

    -- | Parser for transition label in stateDiagram-v2 mermaid diagram.
    pStateTransition :: ExprPair -> MermaidParser (Int, String, Int)
    pStateTransition :: ExprPair -> ParsecT Void Text Identity (Int, String, Int)
    pStateTransition ep :: ExprPair
    ep@(ExprPair (ExprPairT { exprTParse :: forall a. ExprPairT a -> String -> Either String a
    exprTParse = String -> Either String a
    parseProp })) = do
      _ <- MermaidParser ()
    spaces
      from <- read <$> many digitChar
      _ <- spaces
      string "-->"
      _ <- spaces
      to <- read <$> many digitChar
      _ <- spaces
      _ <- char ':'
      _ <- spaces
      edge <- many (noneOf ("\n" :: [Char]))

      let x = String -> Either String a
    parseProp String
    edge
      when (isLeft x) $ fancyFailure $ Set.singleton $
        ErrorFail $ "Edge property has incorrect format: " ++ show edge

      _ <- newline

      pure $ (from, exprPairShow ep edge, to)

    -- | Parser for Mermaid diagrams of type sequenceDiagram.
    pSequenceDiagram :: ExprPair -> MermaidParser Diagram
    pSequenceDiagram :: ExprPair -> Parsec Void Text Diagram
    pSequenceDiagram ExprPair
    exprPair = do
      MermaidParser ()
    spaces
      _ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "sequenceDiagram"
      spaces

      conditions <- many (pSequenceTransition exprPair)
      let transitions = (String -> Int -> (Int, String, Int))
    -> [String] -> [Int] -> [(Int, String, Int)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\String
    t Int
    idx -> (Int
    idx, String
    t, Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) [String]
    conditions [Int
    0..]

      pure $ Diagram transitions

    -- | Parser for a connection, message or transition in a sequence diagram.
    --
    -- This parser depends on an auxiliary parser for the expressions associated to
    -- the connections or messages between elements.
    pSequenceTransition :: ExprPair -> MermaidParser String
    pSequenceTransition :: ExprPair -> ParsecT Void Text Identity String
    pSequenceTransition ep :: ExprPair
    ep@(ExprPair (ExprPairT { exprTParse :: forall a. ExprPairT a -> String -> Either String a
    exprTParse = String -> Either String a
    parseProp })) = do
      MermaidParser ()
    spaces
      stateFrom <- ParsecT Void Text Identity Char
    -> ParsecT Void Text Identity String
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    many ParsecT Void Text Identity Char
    ParsecT Void Text Identity (Token Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    digitChar
      spaces
      pSequenceArrow
      spaces
      stateTo <- many digitChar
      spaces
      _ <- char ':'
      spaces
      edge <- many (noneOf ("\n" :: [Char]))

      let x = String -> Either String a
    parseProp String
    edge
      when (isLeft x) $ fancyFailure $ Set.singleton $
        ErrorFail $ "Edge property has incorrect format: " ++ show edge

      _ <- newline

      pure (exprPairShow ep edge)

    -- | Parser for arrow in sequence diagram.
    pSequenceArrow :: MermaidParser ()
    pSequenceArrow :: MermaidParser ()
    pSequenceArrow = ParsecT Void Text Identity (Tokens Text) -> MermaidParser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT Void Text Identity (Tokens Text) -> MermaidParser ())
    -> ParsecT Void Text Identity (Tokens Text) -> MermaidParser ()
    forall a b. (a -> b) -> a -> b
    $ [ParsecT Void Text Identity (Tokens Text)]
    -> ParsecT Void Text Identity (Tokens Text)
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
      [ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "->>"
      , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "-->>"
      , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string Tokens Text
    "-)"
      ]

    -- | Consume spaces
    spaces :: MermaidParser ()
    spaces :: MermaidParser ()
    spaces = MermaidParser ()
    -> MermaidParser () -> MermaidParser () -> MermaidParser ()
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    m () -> m () -> m () -> m ()
    L.space MermaidParser ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    space1 MermaidParser ()
    forall a. ParsecT Void Text Identity a
    forall (f :: * -> *) a. Alternative f => f a
    empty MermaidParser ()
    forall a. ParsecT Void Text Identity a
    forall (f :: * -> *) a. Alternative f => f a
    empty