module UDrawGraph.Types(
DaVinciCmd(..), GraphCmd(..), MultiCmd(..), MenuCmd(..), FileMenuCmd(..),
ViewMenuCmd(..), NavigationMenuCmd(..), AbstractionMenuCmd(..), LayoutMenuCmd(..),
AppMenuCmd(..), SetCmd(..), WindowCmd(..), TclCmd(..), SpecialCmd(..),
VisualCmd(..), DragAndDropCmd(..),
DaVinciAnswer(..),
Node(..), Edge(..), Attribute(..),
NodeUpdate(..), EdgeUpdate(..), AttrChange(..),
MixedUpdate(..), TypeChange(..),
MenuEntry(..), IconEntry(..),
VisualRule(..),
NodeId(..), EdgeId(..), MenuId(..), MenuLabel(..), MenuMne(..),
MenuAcc(..), IconId(..), Type(..), Filename(..), ContextId(..),
WindowId(..),
Orient(..), Direction(..), Btype(..), MenuMod(..)
)
where
data DaVinciCmd =
Graph GraphCmd
| Multi MultiCmd
| Menu MenuCmd
| AppMenu AppMenuCmd
| DVSet SetCmd
| Window WindowCmd
| Tcl TclCmd
| Special SpecialCmd
| DVNothing
| Visual VisualCmd
| DragAndDrop DragAndDropCmd
deriving Eq
data GraphCmd =
New [Node]
| NewPlaced [Node]
| Update [NodeUpdate] [EdgeUpdate]
| ChangeAttr [AttrChange]
| UpdateAndChangeAttr [NodeUpdate] [EdgeUpdate] [AttrChange]
| UpdateMixed [MixedUpdate]
| UpdateAndChangeAttrMixed [MixedUpdate] [AttrChange]
| ChangeType [TypeChange]
deriving Eq
data MultiCmd =
NewContext
| OpenContext ContextId
| SetContext ContextId
| SetContextWindow ContextId WindowId
deriving Eq
data MenuCmd =
File FileMenuCmd
| View ViewMenuCmd
| Navigation NavigationMenuCmd
| Abstraction AbstractionMenuCmd
| Layout LayoutMenuCmd
deriving Eq
data FileMenuCmd =
ClearGraph
| OpenGraph Filename
| OpenGraphPlaced Filename
| OpenStatus Filename
| SaveGraph Filename
| SaveStatus Filename
| Print (Maybe Filename)
| Close
| Exit
deriving Eq
data ViewMenuCmd =
OpenNewView
| OpenSurveyView
| FullScale
| FitScaleToWindow
| Scale (Maybe Int)
| GraphInfo
| DaVinciInfo
deriving Eq
data NavigationMenuCmd =
SelectParents [NodeId]
| SelectSiblings [NodeId]
| SelectChilds [NodeId]
| SelectChildren [NodeId]
| Navigator (Maybe (NodeId,Direction,Bool))
| Find (Maybe (String,Bool,Bool))
deriving Eq
data AbstractionMenuCmd =
HideSubgraph [NodeId]
| ShowSubgraph [NodeId]
| RestoreAllSubgraphs
| HideEdges [NodeId]
| ShowEdges [NodeId]
| RestoreAllEdges
deriving Eq
data LayoutMenuCmd =
ImproveAll
| ImproveVisible
| CompactAll
| Orientation Orient
deriving Eq
data AppMenuCmd =
CreateMenus [MenuEntry]
| CreateIcons [IconEntry]
| ActivateMenus [MenuId]
| ActivateIcons [IconId]
| ControlFileEvents
deriving Eq
data SetCmd =
LayoutAccuracy Int
| KeepNodesAtLevels Bool
| FontSize Int
| GapWidth Int
| GapHeight Int
| MultiEdgeGap Int
| SelfEdgeRadius Int
| ScrollingOnSelection Bool
| AnimationSpeed Int
| NoCache Bool
| RulesFirst Bool
deriving Eq
data WindowCmd =
Title String
| ShowMessage String
| ShowStatus String
| Position Int Int
| Size Int Int
| Raise
| Iconify
| Deiconify
| Activate
| Deactivate
| FileBrowser Bool String String String String [Btype] Bool
deriving Eq
data TclCmd =
DVEval String
| EvalFile Filename
deriving Eq
data SpecialCmd =
SelectNodes [NodeId]
| SelectEdge EdgeId
| FocusNode NodeId
| FocusNodeAnimated NodeId
| ShowUrl String
| Version
deriving Eq
data VisualCmd =
NewRules [VisualRule]
| AddRules [VisualRule]
deriving Eq
data DragAndDropCmd =
DraggingOn
| DragAndDropOn
| DraggingOff
| NewNodeAtCoord NodeUpdate
| NewEdgeAndNodeAtCoord NodeUpdate EdgeUpdate
deriving Eq
data DaVinciAnswer =
Ok
| CommunicationError String
| NodeSelectionsLabels [NodeId]
| NodeDoubleClick
| EdgeSelectionLabel EdgeId
| EdgeSelectionLabels NodeId NodeId
| EdgeDoubleClick
| MenuSelection MenuId
| IconSelection IconId
| Context ContextId
| TclAnswer String
| BrowserAnswer String String
| Disconnect
| Closed
| Quit
| PopupSelectionNode NodeId MenuId
| PopupSelectionEdge EdgeId MenuId
| CreateNode
| CreateNodeAndEdge NodeId
| CreateEdge NodeId NodeId
| DropNode NodeId ContextId WindowId NodeId
| ContextWindow ContextId WindowId
| OpenWindow
| CloseWindow WindowId
| Versioned String
deriving (Eq,Ord)
data Node =
N NodeId Type [Attribute] [Edge]
| R NodeId
deriving Eq
data Edge = E EdgeId Type [Attribute] Node
deriving Eq
data Attribute =
A String String
| M [MenuEntry]
deriving Eq
data NodeUpdate =
DeleteNode NodeId
| NewNode NodeId Type [Attribute]
deriving Eq
data EdgeUpdate =
DeleteEdge EdgeId
| NewEdge EdgeId Type [Attribute] NodeId NodeId
| NewEdgeBehind EdgeId EdgeId Type [Attribute] NodeId NodeId
deriving Eq
data MixedUpdate =
NU NodeUpdate
| EU EdgeUpdate
deriving Eq
data AttrChange =
Node NodeId [Attribute]
| Edge EdgeId [Attribute]
deriving Eq
data TypeChange =
NodeType NodeId Type
| EdgeType EdgeId Type
deriving Eq
data MenuEntry =
MenuEntry MenuId MenuLabel
| MenuEntryMne MenuId MenuLabel MenuMne MenuMod MenuAcc
| SubmenuEntry MenuId MenuLabel [MenuEntry]
| SubmenuEntryMne MenuId MenuLabel [MenuEntry] MenuMne
| BlankMenuEntry
| MenuEntryDisabled MenuId MenuLabel
| SubmenuEntryDisabled MenuId MenuLabel [MenuEntry]
deriving Eq
data IconEntry =
IconEntry IconId Filename String
| BlankIconEntry
deriving Eq
data VisualRule =
NR Type [Attribute]
| ER Type [Attribute]
deriving Eq
newtype NodeId = NodeId String deriving (Eq,Ord)
newtype EdgeId = EdgeId String deriving (Eq,Ord)
newtype MenuId = MenuId String deriving (Eq,Ord)
newtype MenuLabel = MenuLabel String deriving Eq
newtype MenuMne = MenuMne String deriving Eq
newtype MenuAcc = MenuAcc String deriving Eq
newtype IconId = IconId String deriving (Eq,Ord)
newtype Type = Type String deriving (Eq,Ord)
newtype Filename = Filename String deriving Eq
newtype ContextId = ContextId String deriving (Eq,Ord)
newtype WindowId = WindowId String deriving (Eq,Ord)
data Orient = TopDown | BottomUp | LeftRight | RightLeft deriving Eq
data Direction = Up | Down | DVLeft | DVRight deriving Eq
data Btype = Bt String String String deriving Eq
data MenuMod = Alternate | Shift | Control | Meta | None deriving Eq
instance Show DaVinciCmd where
showsPrec _ (Graph graphCmd) = showFunc1 "graph" graphCmd
showsPrec _ (Multi multiCmd) = showFunc1 "multi" multiCmd
showsPrec _ (Menu menuCmd) = showFunc1 "menu" menuCmd
showsPrec _ (AppMenu appMenuCmd) = showFunc1 "app_menu" appMenuCmd
showsPrec _ (DVSet setCmd) = showFunc1 "set" setCmd
showsPrec _ (Window windowCmd) = showFunc1 "window" windowCmd
showsPrec _ (Tcl tclCmd) = showFunc1 "tcl" tclCmd
showsPrec _ (Special specialCmd) = showFunc1 "special" specialCmd
showsPrec _ DVNothing = showString "nothing"
showsPrec _ (Visual visualCmd) = showFunc1 "visual" visualCmd
showsPrec _ (DragAndDrop dragAndDropCmd) = showFunc1 "drag_and_drop" dragAndDropCmd
instance Show GraphCmd where
showsPrec _ (New nodes) = showFunc1 "new" nodes
showsPrec _ (NewPlaced nodes) = showFunc1 "new_placed" nodes
showsPrec _ (Update nUpds eUpds) = showFunc2 "update" nUpds eUpds
showsPrec _ (ChangeAttr aChs) = showFunc1 "change_attr" aChs
showsPrec _ (UpdateAndChangeAttr nUpds eUpds aChs)
= showFunc3 "update_and_change_attr" nUpds eUpds aChs
showsPrec _ (UpdateMixed mUpds) = showFunc1 "mixed_update" mUpds
showsPrec _ (UpdateAndChangeAttrMixed mUpds aChs)= showFunc2 "update_and_change_attr" mUpds aChs
showsPrec _ (ChangeType tChs) = showFunc1 "change_type" tChs
instance Show MultiCmd where
showsPrec _ NewContext = showString "new_context"
showsPrec _ (OpenContext contextId) = showFunc1 "open_context" contextId
showsPrec _ (SetContext contextId) = showFunc1 "set_context" contextId
showsPrec _ (SetContextWindow contextId windowId)= showFunc2 "set_context" contextId windowId
instance Show MenuCmd where
showsPrec _ (File fCmd) = showFunc1 "file" fCmd
showsPrec _ (View vCmd) = showFunc1 "view" vCmd
showsPrec _ (Navigation nCmd) = showFunc1 "navigation" nCmd
showsPrec _ (Abstraction aCmd) = showFunc1 "abstraction" aCmd
showsPrec _ (Layout lCmd) = showFunc1 "layout" lCmd
instance Show FileMenuCmd where
showsPrec _ ClearGraph = showString "new"
showsPrec _ (OpenGraph fname) = showFunc1 "open_graph" fname
showsPrec _ (OpenGraphPlaced fname) = showFunc1 "open_graph_placed" fname
showsPrec _ (OpenStatus fname) = showFunc1 "open_status" fname
showsPrec _ (SaveGraph fname) = showFunc1 "save_graph" fname
showsPrec _ (SaveStatus fname) = showFunc1 "save_status" fname
showsPrec _ (Print Nothing) = showString "print"
showsPrec _ (Print (Just fname)) = showFunc1 "print" fname
showsPrec _ Close = showString "close"
showsPrec _ Exit = showString "exit"
instance Show ViewMenuCmd where
showsPrec _ OpenNewView = showString "open_new_view"
showsPrec _ OpenSurveyView = showString "open_survey_view"
showsPrec _ FullScale = showString "full_scale"
showsPrec _ FitScaleToWindow = showString "fit_scale_to_window"
showsPrec _ (Scale Nothing) = showString "scale"
showsPrec _ (Scale (Just scale)) = showFunc1 "scale" scale
showsPrec _ GraphInfo = showString "graph_info"
showsPrec _ DaVinciInfo = showString "daVinci_info"
instance Show NavigationMenuCmd where
showsPrec _ (SelectParents nodeIds) = showFunc1 "select_parents" nodeIds
showsPrec _ (SelectSiblings nodeIds) = showFunc1 "select_siblings" nodeIds
showsPrec _ (SelectChilds nodeIds) = showFunc1 "select_childs" nodeIds
showsPrec _ (SelectChildren nodeIds) = showFunc1 "select_childs" nodeIds
showsPrec _ (Navigator Nothing) = showString "navigator"
showsPrec _ (Navigator (Just (nodeId,dir,flag))) = showFunc3 "navigator" nodeId dir flag
showsPrec _ (Find Nothing) = showString "find"
showsPrec _ (Find (Just (txt,cas,exact))) = showFunc3 "find" txt cas exact
instance Show AbstractionMenuCmd where
showsPrec _ (HideSubgraph nodeIds) = showFunc1 "hide_subgraph" nodeIds
showsPrec _ (ShowSubgraph nodeIds) = showFunc1 "show_subgraph" nodeIds
showsPrec _ RestoreAllSubgraphs = showString "restore_all_subgraphs"
showsPrec _ (HideEdges nodeIds) = showFunc1 "hide_edges" nodeIds
showsPrec _ (ShowEdges nodeIds) = showFunc1 "show_edges" nodeIds
showsPrec _ RestoreAllEdges = showString "restore_all_edges"
instance Show LayoutMenuCmd where
showsPrec _ ImproveAll = showString "improve_all"
showsPrec _ ImproveVisible = showString "improve_visible"
showsPrec _ CompactAll = showString "compact_all"
showsPrec _ (Orientation orient) = showFunc1 "orientation" orient
instance Show AppMenuCmd where
showsPrec _ (CreateMenus menuEntries) = showFunc1 "create_menus" menuEntries
showsPrec _ (CreateIcons iconEntries) = showFunc1 "create_icons" iconEntries
showsPrec _ (ActivateMenus menuIds) = showFunc1 "activate_menus" menuIds
showsPrec _ (ActivateIcons iconIds) = showFunc1 "activate_icons" iconIds
showsPrec _ ControlFileEvents = showString "control_file_events"
instance Show SetCmd where
showsPrec _ (LayoutAccuracy x) = showFunc1 "layout_accuracy" x
showsPrec _ (KeepNodesAtLevels x) = showBoolFunc "keep_nodes_at_levels" x
showsPrec _ (FontSize x) = showFunc1 "font_size" x
showsPrec _ (GapWidth x) = showFunc1 "gap_width" x
showsPrec _ (GapHeight x) = showFunc1 "gap_height" x
showsPrec _ (MultiEdgeGap x) = showFunc1 "multi_edge_gap" x
showsPrec _ (SelfEdgeRadius x) = showFunc1 "self_edge_radius" x
showsPrec _ (ScrollingOnSelection x) = showBoolFunc "scrolling_on_selection" x
showsPrec _ (AnimationSpeed x) = showFunc1 "animation_speed" x
showsPrec _ (NoCache x) = showBoolFunc "no_cache" x
showsPrec _ (RulesFirst x) = showBoolFunc "rules_first" x
instance Show WindowCmd where
showsPrec _ (Title str) = showFunc1 "title" str
showsPrec _ (ShowMessage str) = showFunc1 "show_message" str
showsPrec _ (ShowStatus str) = showFunc1 "show_status" str
showsPrec _ (Position x y) = showFunc2 "position" x y
showsPrec _ (Size w h) = showFunc2 "size" w h
showsPrec _ Raise = showString "raise"
showsPrec _ Iconify = showString "iconify"
showsPrec _ Deiconify = showString "deiconify"
showsPrec _ Activate = showString "activate"
showsPrec _ Deactivate = showString "deactivate"
showsPrec _ (FileBrowser open title btn dir file tps hid)
= showFunc7 "file_browser" open title btn dir file tps hid
instance Show TclCmd where
showsPrec _ (DVEval str) = showFunc1 "eval" str
showsPrec _ (EvalFile fname) = showFunc1 "eval_file" fname
instance Show SpecialCmd where
showsPrec _ (SelectNodes nodes) = showFunc1 "select_nodes" nodes
showsPrec _ (SelectEdge edges) = showFunc1 "select_edges" edges
showsPrec _ (FocusNode nodeIds) = showFunc1 "focus_node" nodeIds
showsPrec _ (FocusNodeAnimated nodeIds) = showFunc1 "focus_node_animated" nodeIds
showsPrec _ (ShowUrl url) = showFunc1 "show_url" url
showsPrec _ Version = showString "version"
instance Show VisualCmd where
showsPrec _ (NewRules visualRules) = showFunc1 "new_rules" visualRules
showsPrec _ (AddRules visualRules) = showFunc1 "add_rules" visualRules
instance Show DragAndDropCmd where
showsPrec _ DraggingOn = showString "dragging_on"
showsPrec _ DragAndDropOn = showString "drag_and_drop_on"
showsPrec _ DraggingOff = showString "dragging_off"
showsPrec _ (NewNodeAtCoord nUpd) = showFunc1 "new_node_at_coord" nUpd
showsPrec _ (NewEdgeAndNodeAtCoord nUpd eUpd) = showFunc2 "new_edge_and_node_at_coord" nUpd eUpd
instance Show DaVinciAnswer where
showsPrec _ Ok = showString "ok"
showsPrec _ (CommunicationError msg) = showFunc1 "communication_error" msg
showsPrec _ (NodeSelectionsLabels nodeIds) = showFunc1 "node_selections_labels" nodeIds
showsPrec _ NodeDoubleClick = showString "node_double_click"
showsPrec _ (EdgeSelectionLabel edgeId) = showFunc1 "edge_selection_label" edgeId
showsPrec _ (EdgeSelectionLabels parent child) = showFunc2 "edge_selection_labels" parent child
showsPrec _ EdgeDoubleClick = showString "edge_double_click"
showsPrec _ (MenuSelection menuId) = showFunc1 "menu_selection" menuId
showsPrec _ (IconSelection iconId) = showFunc1 "icon_selection" iconId
showsPrec _ (Context contextId) = showFunc1 "context" contextId
showsPrec _ (TclAnswer retVal) = showFunc1 "tcl_answer" retVal
showsPrec _ (BrowserAnswer file typ) = showFunc2 "browser_answer" file typ
showsPrec _ Disconnect = showString "disconnect"
showsPrec _ Closed = showString "close"
showsPrec _ Quit = showString "quit"
showsPrec _ (PopupSelectionNode nId mId) = showFunc2 "popup_selection_node" nId mId
showsPrec _ (PopupSelectionEdge eId mId) = showFunc2 "popup_selection_edge" eId mId
showsPrec _ CreateNode = showString "create_node"
showsPrec _ (CreateNodeAndEdge nId) = showFunc1 "create_node_and_edge" nId
showsPrec _ (CreateEdge nId1 nId2) = showFunc2 "create_edge" nId1 nId2
showsPrec _ (DropNode nId1 cId2 wId2 nId2) = showFunc4 "drop_node" nId1 cId2 wId2 nId2
showsPrec _ (ContextWindow cId wId) = showFunc2 "context_window" cId wId
showsPrec _ OpenWindow = showString "open_window"
showsPrec _ (CloseWindow wId) = showFunc1 "close_window" wId
showsPrec _ (Versioned string) = showFunc1 "version" string
instance Read DaVinciAnswer where
readsPrec _ r =
[ (Ok, s) | ("ok", s) <- lexR ] ++
[ (CommunicationError m, t) | ("communication_error", s) <- lexR ,
([m], t) <- readArgs s ] ++
[ (Versioned m , t) | ("version", s) <- lexR ,
([m], t) <- readArgs s ] ++
[ (NodeSelectionsLabels (map NodeId n), t) | ("node_selections_labels", s) <- lexR ,
(n, t) <- readStrs s ] ++
[ (NodeDoubleClick, s) | ("node_double_click", s) <- lexR ] ++
[ (EdgeSelectionLabel (EdgeId e), t) | ("edge_selection_label", s) <- lexR ,
([e], t) <- readArgs s ] ++
[ (EdgeSelectionLabels (NodeId p) (NodeId c), t) | ("edge_selection_labels", s) <- lexR ,
([p,c], t) <- readArgs s ] ++
[ (EdgeDoubleClick, s) | ("edge_double_click", s) <- lexR ] ++
[ (MenuSelection (MenuId m), t) | ("menu_selection", s) <- lexR ,
([m], t) <- readArgs s ] ++
[ (IconSelection (IconId i), t) | ("icon_selection", s) <- lexR ,
([i], t) <- readArgs s ] ++
[ (Context (ContextId c), t) | ("context", s) <- lexR ,
([c], t) <- readArgs s ] ++
[ (TclAnswer a, t) | ("tcl_answer", s) <- lexR ,
([a], t) <- readArgs s ] ++
[ (BrowserAnswer f y, t) | ("browser_answer", s) <- lexR ,
([f,y], t) <- readArgs s ] ++
[ (Disconnect, s) | ("disconnect", s) <- lexR ] ++
[ (Closed, s) | ("close", s) <- lexR ] ++
[ (Quit, s) | ("quit", s) <- lexR ] ++
[ (PopupSelectionNode (NodeId n) (MenuId m), t) | ("popup_selection_node", s) <- lexR ,
([n,m], t) <- readArgs s ] ++
[ (PopupSelectionEdge (EdgeId e) (MenuId m), t) | ("popup_selection_edge", s) <- lexR ,
([e,m], t) <- readArgs s ] ++
[ (CreateNode, s) | ("create_node", s) <- lexR ] ++
[ (CreateNodeAndEdge (NodeId n), t) | ("create_node_and_edge", s) <- lexR ,
([n], t) <- readArgs s ] ++
[ (CreateEdge (NodeId n1) (NodeId n2), t) | ("create_edge", s) <- lexR ,
([n1, n2], t) <- readArgs s ] ++
[ (DropNode (NodeId n1) (ContextId c2) (WindowId w2) (NodeId n2), t)
| ("drop_node", s) <- lexR ,
([n1,c2,w2,n2], t) <- readArgs s ] ++
[ (ContextWindow (ContextId c) (WindowId w), t)| ("context_window", s) <- lexR ,
([c,w], t) <- readArgs s ] ++
[ (OpenWindow, s) | ("open_window", s) <- lexR ] ++
[ (CloseWindow (WindowId w), t) | ("close_window", s) <- lexR ,
([w], t) <- readArgs s ]
where lexR = lex r
readArgs :: ReadS [String]
readArgs s = [ (x:xs, v) | ("(", t) <- lex s,
(x, u) <- reads t,
(xs, v) <- readArgs2 u ]
readArgs2 :: ReadS [String]
readArgs2 s = [ ([], t) | (")",t) <- lex s ] ++
[ (x:xs, v) | (",",t) <- lex s,
(x, u) <- reads t,
(xs, v) <- readArgs2 u ]
readStrs :: ReadS [String]
readStrs = reads
instance Show Node where
showsPrec _ (N nodeId typ attrs edges) = showLabeled nodeId (showFunc3 "n" typ attrs edges)
showsPrec _ (R nodeId) = showFunc1 "r" nodeId
showList = showLst
instance Show Edge where
showsPrec _ (E edgeId typ attrs node) = showLabeled edgeId (showFunc3 "e" typ attrs node)
showList = showLst
instance Show Attribute where
showsPrec _ (A key value) = showFunc2 "a" key value
showsPrec _ (M menuEntries) = showFunc1 "m" menuEntries
showList = showLst
instance Show NodeUpdate where
showsPrec _ (DeleteNode nodeId) = showFunc1 "delete_node" nodeId
showsPrec _ (NewNode nodeId typ attrs) = showFunc3 "new_node" nodeId typ attrs
showList = showLst
instance Show EdgeUpdate where
showsPrec _ (DeleteEdge edgeId) = showFunc1 "delete_edge" edgeId
showsPrec _ (NewEdge edgeId typ attrs nodeId1 nodeId2) = showFunc5 "new_edge" edgeId typ attrs nodeId1 nodeId2
showsPrec _ (NewEdgeBehind edgeId1 edgeId2 typ attrs nodeId1 nodeId2) = showFunc6 "new_edge_behind" edgeId1 edgeId2 typ attrs nodeId1 nodeId2
showList = showLst
instance Show MixedUpdate where
showsPrec _ (NU nUpd) = shows nUpd
showsPrec _ (EU eUpd) = shows eUpd
showList = showLst
instance Show AttrChange where
showsPrec _ (Node nodeId attrs) = showFunc2 "node" nodeId attrs
showsPrec _ (Edge edgeId attrs) = showFunc2 "edge" edgeId attrs
showList = showLst
instance Show TypeChange where
showsPrec _ (NodeType nodeId typ) = showFunc2 "node" nodeId typ
showsPrec _ (EdgeType edgeId typ) = showFunc2 "edge" edgeId typ
showList = showLst
instance Show MenuEntry where
showsPrec _ (MenuEntry menuId menuLabel) = showFunc2 "menu_entry" menuId menuLabel
showsPrec _ (MenuEntryMne menuId menuLabel menuMne menuMod menuAcc) = showFunc5 "menu_entry_mne" menuId menuLabel menuMne menuMod menuAcc
showsPrec _ (SubmenuEntry menuId menuLabel menuEntries) = showFunc3 "submenu_entry" menuId menuLabel menuEntries
showsPrec _ (SubmenuEntryMne menuId menuLabel menuEntries menuMne) = showFunc4 "submenu_entry_mne" menuId menuLabel menuEntries menuMne
showsPrec _ BlankMenuEntry = showString "blank"
showsPrec _ (MenuEntryDisabled menuId menuLabel) = showFunc2 "menu_entry_disabled" menuId menuLabel
showsPrec _ (SubmenuEntryDisabled menuId menuLabel menuEntries) = showFunc3 "submenu_entry_disabled" menuId menuLabel menuEntries
instance Show IconEntry where
showsPrec _ (IconEntry iconId filename descr) = showFunc3 "icon_entry" iconId filename descr
showsPrec _ BlankIconEntry = showString "blank"
instance Show VisualRule where
showsPrec _ (NR typ attrs) = showFunc2 "nr" typ attrs
showsPrec _ (ER typ attrs) = showFunc2 "er" typ attrs
showList = showLst
instance Show NodeId where
showsPrec _ (NodeId s) = shows s
showList = showLst
instance Show EdgeId where
showsPrec _ (EdgeId s) = shows s
showList = showLst
instance Show MenuId where
showsPrec _ (MenuId s) = shows s
showList = showLst
instance Show MenuLabel where
showsPrec _ (MenuLabel s) = shows s
showList = showLst
instance Show MenuMne where
showsPrec _ (MenuMne s) = shows s
showList = showLst
instance Show MenuAcc where
showsPrec _ (MenuAcc s) = shows s
showList = showLst
instance Show IconId where
showsPrec _ (IconId s) = shows s
showList = showLst
instance Show Type where
showsPrec _ (Type s) = shows s
showList = showLst
instance Show Filename where
showsPrec _ (Filename s) = shows s
showList = showLst
instance Show ContextId where
showsPrec _ (ContextId s) = shows s
showList = showLst
instance Show WindowId where
showsPrec _ (WindowId s) = shows s
showList = showLst
instance Show Orient where
showsPrec _ TopDown = showString "top_down"
showsPrec _ BottomUp = showString "bottom_up"
showsPrec _ LeftRight = showString "left_right"
showsPrec _ RightLeft = showString "right_left"
instance Show Direction where
showsPrec _ Up = showString "up"
showsPrec _ Down = showString "down"
showsPrec _ DVLeft = showString "left"
showsPrec _ DVRight = showString "right"
instance Show Btype where
showsPrec _ (Bt txt pat post) = showFunc3 "bt" txt pat post
instance Show MenuMod where
showsPrec _ Alternate = showString "alt"
showsPrec _ Shift = showString "shift"
showsPrec _ Control = showString "control"
showsPrec _ Meta = showString "meta"
showsPrec _ None = showString "none"
showFunc1 :: Show a => String -> a -> ShowS
showFunc1 funcName arg1 =
showString funcName . showParen True (shows arg1)
showFunc2 :: (Show a,Show b) => String -> a -> b -> ShowS
showFunc2 funcName arg1 arg2 =
showString funcName . showParen True (shows arg1 . showChar ',' .
shows arg2)
showFunc3 :: (Show a,Show b,Show c) => String -> a -> b -> c -> ShowS
showFunc3 funcName arg1 arg2 arg3 =
showString funcName . showParen True (shows arg1 . showChar ',' .
shows arg2 . showChar ',' .
shows arg3)
showFunc4 :: (Show a,Show b,Show c,Show d) => String -> a -> b -> c -> d -> ShowS
showFunc4 funcName arg1 arg2 arg3 arg4 =
showString funcName . showParen True (shows arg1 . showChar ',' .
shows arg2 . showChar ',' .
shows arg3 . showChar ',' .
shows arg4)
showFunc5 :: (Show a,Show b,Show c,Show d,Show e) => String -> a -> b -> c -> d -> e -> ShowS
showFunc5 funcName arg1 arg2 arg3 arg4 arg5 =
showString funcName . showParen True (shows arg1 . showChar ',' .
shows arg2 . showChar ',' .
shows arg3 . showChar ',' .
shows arg4 . showChar ',' .
shows arg5)
showFunc6 :: (Show a,Show b,Show c,Show d,Show e,Show f) => String -> a -> b -> c -> d -> e -> f -> ShowS
showFunc6 funcName arg1 arg2 arg3 arg4 arg5 arg6 =
showString funcName . showParen True (shows arg1 . showChar ',' .
shows arg2 . showChar ',' .
shows arg3 . showChar ',' .
shows arg4 . showChar ',' .
shows arg5 . showChar ',' .
shows arg6)
showFunc7 :: (Show a,Show b,Show c,Show d,Show e,Show f,Show g) => String -> a -> b -> c -> d -> e -> f -> g -> ShowS
showFunc7 funcName arg1 arg2 arg3 arg4 arg5 arg6 arg7 =
showString funcName . showParen True (shows arg1 . showChar ',' .
shows arg2 . showChar ',' .
shows arg3 . showChar ',' .
shows arg4 . showChar ',' .
shows arg5 . showChar ',' .
shows arg6 . showChar ',' .
shows arg7)
showLabeled :: Show a => a -> ShowS -> ShowS
showLabeled iD arg = showChar 'l' . showParen True (shows iD . showChar ',' . arg)
showLst :: Show a => [a] -> ShowS
showLst [] = showString "[]"
showLst (x:xs) = showChar '[' . shows x . showl xs
where showl [] = showChar ']'
showl (y:ys) = showChar ',' . shows y . showl ys
showBoolFunc :: String -> Bool -> ShowS
showBoolFunc funcName flag =
showString funcName . showParen True (showString (if flag then "true" else "false"))