{-# 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 Dot files.
module Data.Diagram.Parser.Dot
    ( parseDiagramDot
    )
  where

-- External imports
import qualified Data.ByteString.Lazy              as B
import           Data.GraphViz                     (graphEdges)
import qualified Data.GraphViz                     as G
import qualified Data.GraphViz.Attributes.Complete as Attributes
import           Data.GraphViz.Commands.IO         (toUTF8)
import qualified Data.GraphViz.Parsing             as G
import           Data.GraphViz.PreProcessing       (preProcess)
import qualified Data.GraphViz.Types.Generalised   as Gs
import qualified Data.Text.Lazy                    as LT

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

-- | Parse a DOT / Graphviz diagram.
parseDiagramDot :: B.ByteString -> ExprPair -> Either String Diagram
parseDiagramDot :: ByteString -> ExprPair -> Either String Diagram
parseDiagramDot ByteString
contents ExprPair
exprP = do
    let contentsUTF8 :: Text
contentsUTF8 = ByteString -> Text
toUTF8 ByteString
contents
    dg <- (Either String (DotGraph Text), Text)
-> Either String (DotGraph Text)
forall a b. (a, b) -> a
fst ((Either String (DotGraph Text), Text)
 -> Either String (DotGraph Text))
-> (Either String (DotGraph Text), Text)
-> Either String (DotGraph Text)
forall a b. (a -> b) -> a -> b
$ Parse (DotGraph Text)
-> Text -> (Either String (DotGraph Text), Text)
forall a. Parse a -> Text -> (Either String a, Text)
G.runParser Parse (DotGraph Text)
forall a. ParseDot a => Parse a
G.parse (Text -> (Either String (DotGraph Text), Text))
-> Text -> (Either String (DotGraph Text), Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
preProcess Text
contentsUTF8
    return $ makeDiagram dg
  where
    makeDiagram :: Gs.DotGraph LT.Text -> Diagram
    makeDiagram :: DotGraph Text -> Diagram
makeDiagram DotGraph Text
g = [(Int, String, Int)] -> Diagram
Diagram [(Int, String, Int)]
links
      where
        links :: [(Int, String, Int)]
links = (DotEdge Text -> (Int, String, Int))
-> [DotEdge Text] -> [(Int, String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map DotEdge Text -> (Int, String, Int)
forall {a} {c}. (Read a, Read c) => DotEdge Text -> (a, String, c)
edgeToLink (DotGraph Text -> [DotEdge Text]
forall (dg :: * -> *) n. DotRepr dg n => dg n -> [DotEdge n]
graphEdges DotGraph Text
g)

        edgeToLink :: DotEdge Text -> (a, String, c)
edgeToLink DotEdge Text
edge =
            ( String -> a
forall a. Read a => String -> a
read (Text -> String
LT.unpack Text
o)
            , ExprPair -> String -> String
exprPairShow ExprPair
exprP (Text -> String
LT.unpack Text
e)
            , String -> c
forall a. Read a => String -> a
read (Text -> String
LT.unpack Text
d)
            )
          where
            o :: Text
o = DotEdge Text -> Text
forall n. DotEdge n -> n
G.fromNode DotEdge Text
edge
            d :: Text
d = DotEdge Text -> Text
forall n. DotEdge n -> n
G.toNode DotEdge Text
edge
            e :: Text
e = [Attribute] -> Text
getLabel (DotEdge Text -> [Attribute]
forall n. DotEdge n -> [Attribute]
G.edgeAttributes DotEdge Text
edge)

            -- Extract the label from a list of attributes. If no label is
            -- found, it's assumed that the condition is the literal true.
            getLabel :: [Attribute] -> Text
getLabel [] = Text
"true"
            getLabel ((Attributes.Label (Attributes.StrLabel Text
l)) : [Attribute]
_) = Text
l
            getLabel (Attribute
_ : [Attribute]
as) = [Attribute] -> Text
getLabel [Attribute]
as