{-# LANGUAGE CPP, 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.  These are those that are needed for the
   testsuite.

 -}

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

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

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

#if !MIN_VERSION_base (4,13,0)
import Data.Monoid ((<>))
#endif

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

-- 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
portName :: Text }
                 deriving (PortName -> PortName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortName -> PortName -> Bool
$c/= :: PortName -> PortName -> Bool
== :: PortName -> PortName -> Bool
$c== :: PortName -> PortName -> Bool
Eq, Eq PortName
PortName -> PortName -> Bool
PortName -> PortName -> Ordering
PortName -> PortName -> PortName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PortName -> PortName -> PortName
$cmin :: PortName -> PortName -> PortName
max :: PortName -> PortName -> PortName
$cmax :: PortName -> PortName -> PortName
>= :: PortName -> PortName -> Bool
$c>= :: PortName -> PortName -> Bool
> :: PortName -> PortName -> Bool
$c> :: PortName -> PortName -> Bool
<= :: PortName -> PortName -> Bool
$c<= :: PortName -> PortName -> Bool
< :: PortName -> PortName -> Bool
$c< :: PortName -> PortName -> Bool
compare :: PortName -> PortName -> Ordering
$ccompare :: PortName -> PortName -> Ordering
Ord, Int -> PortName -> ShowS
[PortName] -> ShowS
PortName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortName] -> ShowS
$cshowList :: [PortName] -> ShowS
show :: PortName -> String
$cshow :: PortName -> String
showsPrec :: Int -> PortName -> ShowS
$cshowsPrec :: Int -> PortName -> ShowS
Show, ReadPrec [PortName]
ReadPrec PortName
Int -> ReadS PortName
ReadS [PortName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PortName]
$creadListPrec :: ReadPrec [PortName]
readPrec :: ReadPrec PortName
$creadPrec :: ReadPrec PortName
readList :: ReadS [PortName]
$creadList :: ReadS [PortName]
readsPrec :: Int -> ReadS PortName
$creadsPrec :: Int -> ReadS PortName
Read)

instance PrintDot PortName where
  unqtDot :: PortName -> DotCode
unqtDot = forall a. PrintDot a => a -> DotCode
unqtDot forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortName -> Text
portName

  toDot :: PortName -> DotCode
toDot = forall a. PrintDot a => a -> DotCode
toDot forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortName -> Text
portName

instance ParseDot PortName where
  parseUnqt :: Parse PortName
parseUnqt = Text -> PortName
PN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String -> String -> Parse Text
parseEscaped Bool
False [] [Char
'"', Char
':']

  parse :: Parse PortName
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          Parse PortName
unqtPortName

unqtPortName :: Parse PortName
unqtPortName :: Parse PortName
unqtPortName = Text -> PortName
PN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Text
quotelessString

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

data PortPos = LabelledPort PortName (Maybe CompassPoint)
             | CompassPoint CompassPoint
             deriving (PortPos -> PortPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortPos -> PortPos -> Bool
$c/= :: PortPos -> PortPos -> Bool
== :: PortPos -> PortPos -> Bool
$c== :: PortPos -> PortPos -> Bool
Eq, Eq PortPos
PortPos -> PortPos -> Bool
PortPos -> PortPos -> Ordering
PortPos -> PortPos -> PortPos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PortPos -> PortPos -> PortPos
$cmin :: PortPos -> PortPos -> PortPos
max :: PortPos -> PortPos -> PortPos
$cmax :: PortPos -> PortPos -> PortPos
>= :: PortPos -> PortPos -> Bool
$c>= :: PortPos -> PortPos -> Bool
> :: PortPos -> PortPos -> Bool
$c> :: PortPos -> PortPos -> Bool
<= :: PortPos -> PortPos -> Bool
$c<= :: PortPos -> PortPos -> Bool
< :: PortPos -> PortPos -> Bool
$c< :: PortPos -> PortPos -> Bool
compare :: PortPos -> PortPos -> Ordering
$ccompare :: PortPos -> PortPos -> Ordering
Ord, Int -> PortPos -> ShowS
[PortPos] -> ShowS
PortPos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortPos] -> ShowS
$cshowList :: [PortPos] -> ShowS
show :: PortPos -> String
$cshow :: PortPos -> String
showsPrec :: Int -> PortPos -> ShowS
$cshowsPrec :: Int -> PortPos -> ShowS
Show, ReadPrec [PortPos]
ReadPrec PortPos
Int -> ReadS PortPos
ReadS [PortPos]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PortPos]
$creadListPrec :: ReadPrec [PortPos]
readPrec :: ReadPrec PortPos
$creadPrec :: ReadPrec PortPos
readList :: ReadS [PortPos]
$creadList :: ReadS [PortPos]
readsPrec :: Int -> ReadS PortPos
$creadsPrec :: Int -> ReadS PortPos
Read)

instance PrintDot PortPos where
  unqtDot :: PortPos -> DotCode
unqtDot (LabelledPort PortName
n Maybe CompassPoint
mc) = forall a. PrintDot a => a -> DotCode
unqtDot PortName
n
                                forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *). Applicative m => m Doc
empty (forall (m :: * -> *). Applicative m => m Doc
colon forall a. Semigroup a => a -> a -> a
<>) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PrintDot a => a -> DotCode
unqtDot Maybe CompassPoint
mc)
  unqtDot (CompassPoint CompassPoint
cp)   = forall a. PrintDot a => a -> DotCode
unqtDot CompassPoint
cp

  toDot :: PortPos -> DotCode
toDot (LabelledPort PortName
n Maybe CompassPoint
Nothing) = forall a. PrintDot a => a -> DotCode
toDot PortName
n
  toDot lp :: PortPos
lp@LabelledPort{}        = forall (m :: * -> *). Functor m => m Doc -> m Doc
dquotes forall a b. (a -> b) -> a -> b
$ forall a. PrintDot a => a -> DotCode
unqtDot PortPos
lp
  toDot PortPos
cp                       = forall a. PrintDot a => a -> DotCode
unqtDot PortPos
cp

instance ParseDot PortPos where
  parseUnqt :: Parse PortPos
parseUnqt = do PortName
n <- forall a. ParseDot a => Parse a
parseUnqt
                 Maybe CompassPoint
mc <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Char -> Parse Char
character Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. ParseDot a => Parse a
parseUnqt
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isNothing Maybe CompassPoint
mc
                          then PortName -> PortPos
checkPortName PortName
n
                          else PortName -> Maybe CompassPoint -> PortPos
LabelledPort PortName
n Maybe CompassPoint
mc

  parse :: Parse PortPos
parse = forall a. Parse a -> Parse a
quotedParse forall a. ParseDot a => Parse a
parseUnqt
          forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PortName -> PortPos
checkPortName Parse PortName
unqtPortName

checkPortName    :: PortName -> PortPos
checkPortName :: PortName -> PortPos
checkPortName PortName
pn = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PortName -> Maybe CompassPoint -> PortPos
LabelledPort PortName
pn forall a. Maybe a
Nothing) CompassPoint -> PortPos
CompassPoint
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Text CompassPoint
compassLookup)
                   forall a b. (a -> b) -> a -> b
$ PortName -> Text
portName 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 :: Parse PortPos
parseEdgeBasedPP = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 PortName -> Maybe CompassPoint -> PortPos
LabelledPort forall a. ParseDot a => Parse a
parse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Parse Char
character Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ParseDot a => Parse a
parse)
                   forall s a. Parser s a -> Parser s a -> Parser s a
`onFail`
                   forall a. ParseDot a => Parse a
parse

data CompassPoint = North
                  | NorthEast
                  | East
                  | SouthEast
                  | South
                  | SouthWest
                  | West
                  | NorthWest
                  | CenterPoint
                  | NoCP
                  deriving (CompassPoint -> CompassPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompassPoint -> CompassPoint -> Bool
$c/= :: CompassPoint -> CompassPoint -> Bool
== :: CompassPoint -> CompassPoint -> Bool
$c== :: CompassPoint -> CompassPoint -> Bool
Eq, Eq CompassPoint
CompassPoint -> CompassPoint -> Bool
CompassPoint -> CompassPoint -> Ordering
CompassPoint -> CompassPoint -> CompassPoint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompassPoint -> CompassPoint -> CompassPoint
$cmin :: CompassPoint -> CompassPoint -> CompassPoint
max :: CompassPoint -> CompassPoint -> CompassPoint
$cmax :: CompassPoint -> CompassPoint -> CompassPoint
>= :: CompassPoint -> CompassPoint -> Bool
$c>= :: CompassPoint -> CompassPoint -> Bool
> :: CompassPoint -> CompassPoint -> Bool
$c> :: CompassPoint -> CompassPoint -> Bool
<= :: CompassPoint -> CompassPoint -> Bool
$c<= :: CompassPoint -> CompassPoint -> Bool
< :: CompassPoint -> CompassPoint -> Bool
$c< :: CompassPoint -> CompassPoint -> Bool
compare :: CompassPoint -> CompassPoint -> Ordering
$ccompare :: CompassPoint -> CompassPoint -> Ordering
Ord, CompassPoint
forall a. a -> a -> Bounded a
maxBound :: CompassPoint
$cmaxBound :: CompassPoint
minBound :: CompassPoint
$cminBound :: CompassPoint
Bounded, Int -> CompassPoint
CompassPoint -> Int
CompassPoint -> [CompassPoint]
CompassPoint -> CompassPoint
CompassPoint -> CompassPoint -> [CompassPoint]
CompassPoint -> CompassPoint -> CompassPoint -> [CompassPoint]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CompassPoint -> CompassPoint -> CompassPoint -> [CompassPoint]
$cenumFromThenTo :: CompassPoint -> CompassPoint -> CompassPoint -> [CompassPoint]
enumFromTo :: CompassPoint -> CompassPoint -> [CompassPoint]
$cenumFromTo :: CompassPoint -> CompassPoint -> [CompassPoint]
enumFromThen :: CompassPoint -> CompassPoint -> [CompassPoint]
$cenumFromThen :: CompassPoint -> CompassPoint -> [CompassPoint]
enumFrom :: CompassPoint -> [CompassPoint]
$cenumFrom :: CompassPoint -> [CompassPoint]
fromEnum :: CompassPoint -> Int
$cfromEnum :: CompassPoint -> Int
toEnum :: Int -> CompassPoint
$ctoEnum :: Int -> CompassPoint
pred :: CompassPoint -> CompassPoint
$cpred :: CompassPoint -> CompassPoint
succ :: CompassPoint -> CompassPoint
$csucc :: CompassPoint -> CompassPoint
Enum, Int -> CompassPoint -> ShowS
[CompassPoint] -> ShowS
CompassPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompassPoint] -> ShowS
$cshowList :: [CompassPoint] -> ShowS
show :: CompassPoint -> String
$cshow :: CompassPoint -> String
showsPrec :: Int -> CompassPoint -> ShowS
$cshowsPrec :: Int -> CompassPoint -> ShowS
Show, ReadPrec [CompassPoint]
ReadPrec CompassPoint
Int -> ReadS CompassPoint
ReadS [CompassPoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompassPoint]
$creadListPrec :: ReadPrec [CompassPoint]
readPrec :: ReadPrec CompassPoint
$creadPrec :: ReadPrec CompassPoint
readList :: ReadS [CompassPoint]
$creadList :: ReadS [CompassPoint]
readsPrec :: Int -> ReadS CompassPoint
$creadsPrec :: Int -> ReadS CompassPoint
Read)

instance PrintDot CompassPoint where
  unqtDot :: CompassPoint -> DotCode
unqtDot CompassPoint
NorthEast   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"ne"
  unqtDot CompassPoint
NorthWest   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"nw"
  unqtDot CompassPoint
North       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"n"
  unqtDot CompassPoint
East        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"e"
  unqtDot CompassPoint
SouthEast   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"se"
  unqtDot CompassPoint
SouthWest   = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"sw"
  unqtDot CompassPoint
South       = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"s"
  unqtDot CompassPoint
West        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"w"
  unqtDot CompassPoint
CenterPoint = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"c"
  unqtDot CompassPoint
NoCP        = forall (m :: * -> *). Applicative m => Text -> m Doc
text Text
"_"

instance ParseDot CompassPoint where
  -- Have to take care of longer parsing values first.
  parseUnqt :: Parser GraphvizState CompassPoint
parseUnqt = forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ forall a. a -> String -> Parse a
stringRep CompassPoint
NorthEast String
"ne"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
NorthWest String
"nw"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
North String
"n"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
SouthEast String
"se"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
SouthWest String
"sw"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
South String
"s"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
East String
"e"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
West String
"w"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
CenterPoint String
"c"
                    , forall a. a -> String -> Parse a
stringRep CompassPoint
NoCP String
"_"
                    ]

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

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