{- |
   Module      : Data.GraphViz.Types.Canonical
   Description : The canonical representation of Dot graphs.
   Copyright   : (c) Matthew Sackman, Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   A canonical Dot graph requires that within each graph/sub-graph,
   the statements are in the following order:

   * global attributes

   * sub-graphs/clusters

   * nodes

   * edges

   This Dot graph representation is ideally suited for converting
   other data structures to Dot form (especially with the help of
   @graphElemsToDot@ from "Data.GraphViz").

   If you require arbitrary ordering of statements, then use
   "Data.GraphViz.Types.Generalised".

   The sample graph could be implemented (this is actually the result
   of calling @canonicalise@ from "Data.GraphViz.Algorithms" on the
   generalised one) as:

   > DotGraph { strictGraph = False
   >          , directedGraph = True
   >          , graphID = Just (Str "G")
   >          , graphStatements = DotStmts { attrStmts = []
   >                                       , subGraphs = [ DotSG { isCluster = True
   >                                                             , subGraphID = Just (Int 0)
   >                                                             , subGraphStmts = DotStmts { attrStmts = [ GraphAttrs [ style filled
   >                                                                                                                   , color LightGray
   >                                                                                                                   , textLabel "process #1"]
   >                                                                                                      , NodeAttrs [style filled, color White]]}
   >                                                                                        , subGraphs = []
   >                                                                                        , nodeStmts = [ DotNode "a0" []
   >                                                                                                      , DotNode "a1" []
   >                                                                                                      , DotNode "a2" []
   >                                                                                                      , DotNode "a3" []]
   >                                                                                        , edgeStmts = [ DotEdge "a0" "a1" []
   >                                                                                                      , DotEdge "a1" "a2" []
   >                                                                                                      , DotEdge "a2" "a3" []
   >                                                                                                      , DotEdge "a3" "a0" []]}}
   >                                                     , DotSG { isCluster = True
   >                                                             , subGraphID = Just (Int 1)
   >                                                             , subGraphStmts = DotStmts { attrStmts = [ GraphAttrs [textLabel "process #2", color Blue]
   >                                                                                                      , NodeAttrs [style filled]]
   >                                                                                        , subGraphs = []
   >                                                                                        , nodeStmts = [ DotNode "b0" []
   >                                                                                                      , DotNode "b1" []
   >                                                                                                      , DotNode "b2" []
   >                                                                                                      , DotNode "b3" []]
   >                                                                                        , edgeStmts = [ DotEdge "b0" "b1" []
   >                                                                                                      , DotEdge "b1" "b2" []
   >                                                                                                      , DotEdge "b2" "b3" []]}}]
   >                                       , nodeStmts = [ DotNode "end" [shape MSquare]
   >                                                     , DotNode "start" [shape MDiamond]]
   >                                       , edgeStmts = [ DotEdge "start" "a0" []
   >                                                     , DotEdge "start" "b0" []
   >                                                     , DotEdge "a1" "b3" []
   >                                                     , DotEdge "b2" "a3" []
   >                                                     , DotEdge "a3" "end" []
   >                                                     , DotEdge "b3" "end" []]}}

   Note that whilst the above graph represents the same Dot graph as
   specified in "Data.GraphViz.Types.Generalised", etc., it /may/ be
   drawn slightly differently by the various Graphviz tools.

 -}
module Data.GraphViz.Types.Canonical
       ( DotGraph(..)
         -- * Sub-components of a @DotGraph@.
       , DotStatements(..)
       , DotSubGraph(..)
         -- * Re-exported from @Data.GraphViz.Types@
       , GraphID(..)
       , GlobalAttributes(..)
       , DotNode(..)
       , DotEdge(..)
       ) where

import Data.GraphViz.Types.Common
import Data.GraphViz.Parsing
import Data.GraphViz.Printing
import Data.GraphViz.State(AttributeType(..))
import Data.GraphViz.Util(bool)

import Control.Arrow((&&&))

-- -----------------------------------------------------------------------------

-- | A Dot graph in canonical form.
data DotGraph n = DotGraph { strictGraph     :: Bool  -- ^ If 'True', no multiple edges are drawn.
                           , directedGraph   :: Bool
                           , graphID         :: Maybe GraphID
                           , graphStatements :: DotStatements n
                           }
                deriving (Eq, Ord, Show, Read)

instance (PrintDot n) => PrintDot (DotGraph n) where
  unqtDot = printStmtBased printGraphID' (const GraphAttribute)
                           graphStatements toDot
    where
      printGraphID' = printGraphID strictGraph directedGraph graphID

instance (ParseDot n) => ParseDot (DotGraph n) where
  parseUnqt = parseGraphID DotGraph
              <*> parseBracesBased GraphAttribute parseUnqt

  parse = parseUnqt -- Don't want the option of quoting

-- | Assumed to be an injective mapping function.
instance Functor DotGraph where
  fmap f g = g { graphStatements = fmap f $ graphStatements g }

-- -----------------------------------------------------------------------------

data DotStatements n = DotStmts { attrStmts :: [GlobalAttributes]
                                , subGraphs :: [DotSubGraph n]
                                , nodeStmts :: [DotNode n]
                                , edgeStmts :: [DotEdge n]
                                }
                     deriving (Eq, Ord, Show, Read)

instance (PrintDot n) => PrintDot (DotStatements n) where
  unqtDot stmts = vcat $ sequence [ unqtDot $ attrStmts stmts
                                  , unqtDot $ subGraphs stmts
                                  , unqtDot $ nodeStmts stmts
                                  , unqtDot $ edgeStmts stmts
                                  ]

instance (ParseDot n) => ParseDot (DotStatements n) where
  parseUnqt = do atts <- tryParseList
                 newline'
                 sGraphs <- tryParseList
                 newline'
                 nodes <- tryParseList
                 newline'
                 edges <- tryParseList
                 return $ DotStmts atts sGraphs nodes edges

  parse = parseUnqt -- Don't want the option of quoting
          `adjustErr`
          ("Not a valid set of statements\n\t"++)

instance Functor DotStatements where
  fmap f stmts = stmts { subGraphs = map (fmap f) $ subGraphs stmts
                       , nodeStmts = map (fmap f) $ nodeStmts stmts
                       , edgeStmts = map (fmap f) $ edgeStmts stmts
                       }

-- -----------------------------------------------------------------------------

data DotSubGraph n = DotSG { isCluster     :: Bool
                           , subGraphID    :: Maybe GraphID
                           , subGraphStmts :: DotStatements n
                           }
                   deriving (Eq, Ord, Show, Read)

instance (PrintDot n) => PrintDot (DotSubGraph n) where
  unqtDot = printStmtBased printSubGraphID' subGraphAttrType
                           subGraphStmts toDot

  unqtListToDot = printStmtBasedList printSubGraphID' subGraphAttrType
                                     subGraphStmts toDot

  listToDot = unqtListToDot

subGraphAttrType :: DotSubGraph n -> AttributeType
subGraphAttrType = bool SubGraphAttribute ClusterAttribute . isCluster

printSubGraphID' :: DotSubGraph n -> DotCode
printSubGraphID' = printSubGraphID (isCluster &&& subGraphID)

instance (ParseDot n) => ParseDot (DotSubGraph n) where
  parseUnqt = parseSubGraph DotSG parseUnqt
              `onFail`
              -- Take "anonymous" DotSubGraphs into account.
              fmap (DotSG False Nothing)
                   (parseBracesBased SubGraphAttribute parseUnqt)

  parse = parseUnqt -- Don't want the option of quoting
          `adjustErr`
          ("Not a valid Sub Graph\n\t"++)

  parseUnqtList = sepBy (whitespace >> parseUnqt) newline'

  parseList = parseUnqtList

instance Functor DotSubGraph where
  fmap f sg = sg { subGraphStmts = fmap f $ subGraphStmts sg }