1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
{-# 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. 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)
-- -----------------------------------------------------------------------------
-- 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)
]
-- -----------------------------------------------------------------------------
|
