{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK hide #-}

{- |
   Module      : Data.GraphViz.Attributes.Internal
   Description : Internal Attribute value definitions
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : 3-Clause BSD-style
   Maintainer  : Ivan.Miljenovic@gmail.com

   This module is defined so as to avoid exposing internal functions
   in the external API.

 -}

module Data.GraphViz.Attributes.Internal
       ( PortName(..)
       , PortPos(..)
       , CompassPoint(..)
       , compassLookup
       , parseEdgeBasedPP
       ) where

import Data.GraphViz.Parsing
import Data.GraphViz.Printing

import Data.Maybe(isNothing)
import qualified Data.Map as Map
import Data.Map(Map)
import Data.Text.Lazy(Text)

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

-- Note that printing and parsing of PortName values is specific to
-- where it's being used: record- and HTML-like labels print/parse
-- them differently from when they're on they're part of PortPos; the
-- default printing and parsing is done for the latter.

-- Should this really be exported from here?  Or in another common module?

-- | Specifies a name for ports (used also in record-based and
--   HTML-like labels).  Note that it is not valid for a 'PortName'
--   value to contain a colon (@:@) character; it is assumed that it
--   doesn't.
newtype PortName = PN { portName :: Text }
                 deriving (Eq, Ord, Show, Read)

instance PrintDot PortName where
  unqtDot = unqtDot . portName

  toDot = toDot . portName

instance ParseDot PortName where
  parseUnqt = PN <$> parseEscaped False [] ['"', ':']

  parse = quotedParse parseUnqt
          `onFail`
          unqtPortName

unqtPortName :: Parse PortName
unqtPortName = PN <$> quotelessString

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

data PortPos = LabelledPort PortName (Maybe CompassPoint)
             | CompassPoint CompassPoint
             deriving (Eq, Ord, Show, Read)

instance PrintDot PortPos where
  unqtDot (LabelledPort n mc) = unqtDot n
                                <> maybe empty (colon <>) (fmap unqtDot mc)
  unqtDot (CompassPoint cp)   = unqtDot cp

  toDot (LabelledPort n Nothing) = toDot n
  toDot lp@LabelledPort{}        = dquotes $ unqtDot lp
  toDot cp                       = unqtDot cp

instance ParseDot PortPos where
  parseUnqt = do n <- parseUnqt
                 mc <- optional $ character ':' >> parseUnqt
                 return $ if isNothing mc
                          then checkPortName n
                          else LabelledPort n mc

  parse = quotedParse parseUnqt
          `onFail`
          fmap checkPortName unqtPortName

checkPortName    :: PortName -> PortPos
checkPortName pn = maybe (LabelledPort pn Nothing) CompassPoint
                   . (`Map.lookup` compassLookup)
                   $ portName pn

-- | When attached to a node in a DotEdge definition, the 'PortName'
--   and the 'CompassPoint' can be in separate quotes.
parseEdgeBasedPP :: Parse PortPos
parseEdgeBasedPP = liftA2 LabelledPort parse (fmap Just $ character ':' *> parse)
                   `onFail`
                   parse

data CompassPoint = North
                  | NorthEast
                  | East
                  | SouthEast
                  | South
                  | SouthWest
                  | West
                  | NorthWest
                  | CenterPoint
                  | NoCP
                  deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance PrintDot CompassPoint where
  unqtDot NorthEast   = text "ne"
  unqtDot NorthWest   = text "nw"
  unqtDot North       = text "n"
  unqtDot East        = text "e"
  unqtDot SouthEast   = text "se"
  unqtDot SouthWest   = text "sw"
  unqtDot South       = text "s"
  unqtDot West        = text "w"
  unqtDot CenterPoint = text "c"
  unqtDot NoCP        = text "_"

instance ParseDot CompassPoint where
  -- Have to take care of longer parsing values first.
  parseUnqt = oneOf [ stringRep NorthEast "ne"
                    , stringRep NorthWest "nw"
                    , stringRep North "n"
                    , stringRep SouthEast "se"
                    , stringRep SouthWest "sw"
                    , stringRep South "s"
                    , stringRep East "e"
                    , stringRep West "w"
                    , stringRep CenterPoint "c"
                    , stringRep NoCP "_"
                    ]

compassLookup :: Map Text CompassPoint
compassLookup = Map.fromList [ ("ne", NorthEast)
                             , ("nw", NorthWest)
                             , ("n", North)
                             , ("e", East)
                             , ("se", SouthEast)
                             , ("sw", SouthWest)
                             , ("s", South)
                             , ("w", West)
                             , ("c", CenterPoint)
                             , ("_", NoCP)
                             ]

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