{-# LANGUAGE PartialTypeSignatures, MultiParamTypeClasses, DeriveGeneric, DefaultSignatures, FlexibleContexts, StrictData #-}


{-# OPTIONS_HADDOCK hide #-}


module OutputGeneration.CallGraph where

import Base

import WithAbstractPredicates.ControlFlow
import Binary.FunctionNames

import Data.L0
import Data.CFG
import Data.JumpTarget
import Data.VerificationCondition
import Data.Indirection
import Data.X86.Opcode (isCall,isJump)
import Data.X86.Instruction


import Binary.Generic
import Data.SymbolicExpression



import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Set.NonEmpty as NES
import Data.List
import Data.List.Split (chunksOf)
import Data.List.Extra (groupSort)
import Data.Maybe (fromJust)
import Debug.Trace

mk_callgraph :: (bin, Config, L0 pred finit v) -> (finit -> String) -> String
mk_callgraph l :: (bin, Config, L0 pred finit v)
l@(bin
bin,Config
_,L0 pred finit v
l0) finit -> String
pp_finit =
  let cfgs :: IntMap CFG
cfgs  = L0 pred finit v -> IntMap CFG
forall pred finit v. L0 pred finit v -> IntMap CFG
l0_get_cfgs L0 pred finit v
l0
      g :: Graph
g     = IntMap IntSet -> Graph
Edges (IntMap IntSet -> Graph) -> IntMap IntSet -> Graph
forall a b. (a -> b) -> a -> b
$ (CFG -> IntSet) -> IntMap CFG -> IntMap IntSet
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map ((bin, Config, L0 pred finit v) -> CFG -> IntSet
forall {bin} {pred} {finit} {v}.
BinaryClass bin =>
(bin, Config, L0 pred finit v) -> CFG -> IntSet
calls_of_cfg (bin, Config, L0 pred finit v)
l) IntMap CFG
cfgs
      fptrs :: Graph
fptrs = IntMap IntSet -> Graph
Edges (IntMap IntSet -> Graph) -> IntMap IntSet -> Graph
forall a b. (a -> b) -> a -> b
$ ((finit, Maybe (FResult pred v)) -> IntSet)
-> IntMap (finit, Maybe (FResult pred v)) -> IntMap IntSet
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (finit, Maybe (FResult pred v)) -> IntSet
forall {a} {pred} {v}. (a, Maybe (FResult pred v)) -> IntSet
get_function_pointer_intros (IntMap (finit, Maybe (FResult pred v)) -> IntMap IntSet)
-> IntMap (finit, Maybe (FResult pred v)) -> IntMap IntSet
forall a b. (a -> b) -> a -> b
$ L0 pred finit v -> IntMap (finit, Maybe (FResult pred v))
forall pred finit v.
L0 pred finit v -> IntMap (finit, Maybe (FResult pred v))
l0_functions L0 pred finit v
l0 in
    (bin, Config, L0 pred finit v)
-> (finit -> String) -> Graph -> Graph -> String
forall bin pred finit v.
BinaryClass bin =>
Lifting bin pred finit v
-> (finit -> String) -> Graph -> Graph -> String
callgraph_to_dot (bin, Config, L0 pred finit v)
l finit -> String
pp_finit Graph
g Graph
fptrs


get_function_pointer_intros :: (a, Maybe (FResult pred v)) -> IntSet
get_function_pointer_intros = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions ([IntSet] -> IntSet)
-> ((a, Maybe (FResult pred v)) -> [IntSet])
-> (a, Maybe (FResult pred v))
-> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationCondition v -> IntSet)
-> [VerificationCondition v] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map VerificationCondition v -> IntSet
forall {v}. VerificationCondition v -> IntSet
get_ptrs ([VerificationCondition v] -> [IntSet])
-> ((a, Maybe (FResult pred v)) -> [VerificationCondition v])
-> (a, Maybe (FResult pred v))
-> [IntSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (VerificationCondition v) -> [VerificationCondition v]
forall a. Set a -> [a]
S.toList (Set (VerificationCondition v) -> [VerificationCondition v])
-> ((a, Maybe (FResult pred v)) -> Set (VerificationCondition v))
-> (a, Maybe (FResult pred v))
-> [VerificationCondition v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FResult pred v -> Set (VerificationCondition v)
forall pred v. FResult pred v -> Set (VerificationCondition v)
result_vcs (FResult pred v -> Set (VerificationCondition v))
-> ((a, Maybe (FResult pred v)) -> FResult pred v)
-> (a, Maybe (FResult pred v))
-> Set (VerificationCondition v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (FResult pred v) -> FResult pred v
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (FResult pred v) -> FResult pred v)
-> ((a, Maybe (FResult pred v)) -> Maybe (FResult pred v))
-> (a, Maybe (FResult pred v))
-> FResult pred v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Maybe (FResult pred v)) -> Maybe (FResult pred v)
forall a b. (a, b) -> b
snd
 where
  get_ptrs :: VerificationCondition v -> IntSet
get_ptrs (FunctionPointers Word64
_ IntSet
ptrs) = IntSet
ptrs


calls_of_cfg :: (bin, Config, L0 pred finit v) -> CFG -> IntSet
calls_of_cfg (bin, Config, L0 pred finit v)
l CFG
cfg = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions ([IntSet] -> IntSet) -> [IntSet] -> IntSet
forall a b. (a -> b) -> a -> b
$ ([Instruction] -> IntSet) -> [[Instruction]] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map [Instruction] -> IntSet
get_call_target ([[Instruction]] -> [IntSet]) -> [[Instruction]] -> [IntSet]
forall a b. (a -> b) -> a -> b
$ IntMap [Instruction] -> [[Instruction]]
forall a. IntMap a -> [a]
IM.elems (IntMap [Instruction] -> [[Instruction]])
-> IntMap [Instruction] -> [[Instruction]]
forall a b. (a -> b) -> a -> b
$ CFG -> IntMap [Instruction]
cfg_instrs CFG
cfg
 where
  get_call_target :: [Instruction] -> IntSet
get_call_target [Instruction]
instrs
    | Opcode -> Bool
isCall (Instruction -> Opcode
inOperation (Instruction -> Opcode) -> Instruction -> Opcode
forall a b. (a -> b) -> a -> b
$ [Instruction] -> Instruction
forall a. HasCallStack => [a] -> a
last [Instruction]
instrs) = [Key] -> IntSet
IS.fromList ([Key] -> IntSet) -> [Key] -> IntSet
forall a b. (a -> b) -> a -> b
$ (ResolvedJumpTarget -> [Key]) -> [ResolvedJumpTarget] -> [Key]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ResolvedJumpTarget -> [Key]
forall {a}. Num a => ResolvedJumpTarget -> [a]
get_internal_address ([ResolvedJumpTarget] -> [Key]) -> [ResolvedJumpTarget] -> [Key]
forall a b. (a -> b) -> a -> b
$ (bin, Config, L0 pred finit v)
-> Instruction -> [ResolvedJumpTarget]
forall bin pred finit v.
BinaryClass bin =>
Lifting bin pred finit v -> Instruction -> [ResolvedJumpTarget]
get_known_jump_targets (bin, Config, L0 pred finit v)
l (Instruction -> [ResolvedJumpTarget])
-> Instruction -> [ResolvedJumpTarget]
forall a b. (a -> b) -> a -> b
$ [Instruction] -> Instruction
forall a. HasCallStack => [a] -> a
last [Instruction]
instrs
    | Opcode -> Bool
isJump (Instruction -> Opcode
inOperation (Instruction -> Opcode) -> Instruction -> Opcode
forall a b. (a -> b) -> a -> b
$ [Instruction] -> Instruction
forall a. HasCallStack => [a] -> a
last [Instruction]
instrs) Bool -> Bool -> Bool
&& (bin, Config, L0 pred finit v) -> Instruction -> Bool
forall bin pred finit v.
BinaryClass bin =>
Lifting bin pred finit v -> Instruction -> Bool
jump_is_actually_a_call (bin, Config, L0 pred finit v)
l ([Instruction] -> Instruction
forall a. HasCallStack => [a] -> a
last [Instruction]
instrs) = [Key] -> IntSet
IS.fromList ([Key] -> IntSet) -> [Key] -> IntSet
forall a b. (a -> b) -> a -> b
$ (ResolvedJumpTarget -> [Key]) -> [ResolvedJumpTarget] -> [Key]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ResolvedJumpTarget -> [Key]
forall {a}. Num a => ResolvedJumpTarget -> [a]
get_internal_address ([ResolvedJumpTarget] -> [Key]) -> [ResolvedJumpTarget] -> [Key]
forall a b. (a -> b) -> a -> b
$ (bin, Config, L0 pred finit v)
-> Instruction -> [ResolvedJumpTarget]
forall bin pred finit v.
BinaryClass bin =>
Lifting bin pred finit v -> Instruction -> [ResolvedJumpTarget]
get_known_jump_targets (bin, Config, L0 pred finit v)
l (Instruction -> [ResolvedJumpTarget])
-> Instruction -> [ResolvedJumpTarget]
forall a b. (a -> b) -> a -> b
$ [Instruction] -> Instruction
forall a. HasCallStack => [a] -> a
last [Instruction]
instrs
    | Bool
otherwise = IntSet
IS.empty
  get_internal_address :: ResolvedJumpTarget -> [a]
get_internal_address (ImmediateAddress Word64
a) = [Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a]
  get_internal_address ResolvedJumpTarget
_ = []




callgraph_to_dot :: BinaryClass bin => Lifting bin pred finit v -> (finit -> String) -> Graph -> Graph -> String
callgraph_to_dot :: forall bin pred finit v.
BinaryClass bin =>
Lifting bin pred finit v
-> (finit -> String) -> Graph -> Graph -> String
callgraph_to_dot (bin
bin,Config
_,L0 pred finit v
l0) finit -> String
pp_finit (Edges IntMap IntSet
es) (Edges IntMap IntSet
fptrs) =
 let name :: String
name  = bin -> String
forall a. BinaryClass a => a -> String
binary_file_name bin
bin in
  String
"diGraph " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{\n"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ((Key -> String) -> [Key] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Key -> String
node_to_dot ([Key] -> [String]) -> [Key] -> [String]
forall a b. (a -> b) -> a -> b
$ IntMap IntSet -> [Key]
forall a. IntMap a -> [Key]
IM.keys IntMap IntSet
es)
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (((Key, IntSet) -> String) -> [(Key, IntSet)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> (Key, IntSet) -> String
forall {a}. Integral a => String -> (a, IntSet) -> String
edge_to_dot' String
"") ([(Key, IntSet)] -> [String]) -> [(Key, IntSet)] -> [String]
forall a b. (a -> b) -> a -> b
$ IntMap IntSet -> [(Key, IntSet)]
forall a. IntMap a -> [(Key, a)]
IM.assocs IntMap IntSet
es)
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (((Key, IntSet) -> String) -> [(Key, IntSet)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> (Key, IntSet) -> String
forall {a}. Integral a => String -> (a, IntSet) -> String
edge_to_dot' String
"[style=dotted]") ([(Key, IntSet)] -> [String]) -> [(Key, IntSet)] -> [String]
forall a b. (a -> b) -> a -> b
$ IntMap IntSet -> [(Key, IntSet)]
forall a. IntMap a -> [(Key, a)]
IM.assocs IntMap IntSet
fptrs)
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n}"
 where
  node_to_dot :: Key -> String
node_to_dot Key
v =
    let bgcolor :: String
bgcolor = Key -> String
node_color Key
v
        fgcolor :: String
fgcolor = String -> String
hex_color_of_text String
bgcolor in
       String
"\t"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Key -> String
forall {a}. Integral a => a -> String
mk_node Key
v
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  [shape=plaintext,label=<<TABLE BORDER=\"0\" CELLBORDER=\"1\" CELLSPACING=\"0\">"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String -> String
mk_row String
fgcolor String
bgcolor) (Key -> [String]
mk_node_lines Key
v)
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</TABLE>>]"

  mk_node_lines :: Key -> [String]
mk_node_lines Key
v = 
    let finit_printed :: String
finit_printed = finit -> String
pp_finit (finit -> String) -> finit -> String
forall a b. (a -> b) -> a -> b
$ Key -> finit
finit Key
v in
      [ bin -> Word64 -> String
forall bin. BinaryClass bin => bin -> Word64 -> String
function_name_of_entry bin
bin (Key -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
v) ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
lines String
finit_printed

  mk_row :: String -> String -> String -> String
mk_row String
fgcolor String
bgcolor String
str = String
"<TR><TD BGCOLOR=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bgcolor String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"><FONT COLOR=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fgcolor String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</FONT></TD></TR>"
  

  edge_to_dot' :: String -> (a, IntSet) -> String
edge_to_dot'  String
style (a
v,IntSet
vs) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Key -> String) -> [Key] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> a -> Key -> String
forall {a} {a}.
(Integral a, Integral a) =>
String -> a -> a -> String
edge_to_dot'' String
style a
v) ([Key] -> [String]) -> [Key] -> [String]
forall a b. (a -> b) -> a -> b
$ IntSet -> [Key]
IS.toList IntSet
vs
  edge_to_dot'' :: String -> a -> a -> String
edge_to_dot'' String
style a
v a
v'   = String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
mk_node a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
mk_node a
v'  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
style

  mk_node :: a -> String
mk_node a
v = bin -> String
forall a. BinaryClass a => a -> String
binary_file_name bin
bin String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
showHex a
v

  node_shape :: Key -> String
node_shape Key
v =
    case Key -> Maybe (Postcondition pred)
result Key
v of
      Just (ReturnsWith pred
_) -> String
"Mrecord"
      Just (Postcondition pred
Terminates)    -> String
"Mrecord"
      Maybe (Postcondition pred)
_                    -> String
"Mrecord"


  result :: Key -> Maybe (Postcondition pred)
result Key
v = Maybe (Postcondition pred) -> Postcondition pred
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Postcondition pred) -> Postcondition pred)
-> ((finit, Maybe (FResult pred v)) -> Maybe (Postcondition pred))
-> (finit, Maybe (FResult pred v))
-> Postcondition pred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FResult pred v -> Postcondition pred)
-> Maybe (FResult pred v) -> Maybe (Postcondition pred)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FResult pred v -> Postcondition pred
forall pred v. FResult pred v -> Postcondition pred
result_post (Maybe (FResult pred v) -> Maybe (Postcondition pred))
-> ((finit, Maybe (FResult pred v)) -> Maybe (FResult pred v))
-> (finit, Maybe (FResult pred v))
-> Maybe (Postcondition pred)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (finit, Maybe (FResult pred v)) -> Maybe (FResult pred v)
forall a b. (a, b) -> b
snd ((finit, Maybe (FResult pred v)) -> Postcondition pred)
-> Maybe (finit, Maybe (FResult pred v))
-> Maybe (Postcondition pred)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key
-> IntMap (finit, Maybe (FResult pred v))
-> Maybe (finit, Maybe (FResult pred v))
forall a. Key -> IntMap a -> Maybe a
IM.lookup Key
v (IntMap (finit, Maybe (FResult pred v))
 -> Maybe (finit, Maybe (FResult pred v)))
-> IntMap (finit, Maybe (FResult pred v))
-> Maybe (finit, Maybe (FResult pred v))
forall a b. (a -> b) -> a -> b
$ L0 pred finit v -> IntMap (finit, Maybe (FResult pred v))
forall pred finit v.
L0 pred finit v -> IntMap (finit, Maybe (FResult pred v))
l0_functions L0 pred finit v
l0)
  finit :: Key -> finit
finit Key
v = Maybe finit -> finit
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe finit -> finit) -> Maybe finit -> finit
forall a b. (a -> b) -> a -> b
$ (finit, Maybe (FResult pred v)) -> finit
forall a b. (a, b) -> a
fst ((finit, Maybe (FResult pred v)) -> finit)
-> Maybe (finit, Maybe (FResult pred v)) -> Maybe finit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key
-> IntMap (finit, Maybe (FResult pred v))
-> Maybe (finit, Maybe (FResult pred v))
forall a. Key -> IntMap a -> Maybe a
IM.lookup Key
v (IntMap (finit, Maybe (FResult pred v))
 -> Maybe (finit, Maybe (FResult pred v)))
-> IntMap (finit, Maybe (FResult pred v))
-> Maybe (finit, Maybe (FResult pred v))
forall a b. (a -> b) -> a -> b
$ L0 pred finit v -> IntMap (finit, Maybe (FResult pred v))
forall pred finit v.
L0 pred finit v -> IntMap (finit, Maybe (FResult pred v))
l0_functions L0 pred finit v
l0)

  node_color :: Key -> String
node_color Key
v =
    case Key -> Maybe (Postcondition pred)
result Key
v of
      Maybe (Postcondition pred)
Nothing -> String
"#FF7F7F" -- light red
      Just (ReturnsWith pred
_) -> String
"#90EE90" -- light green
      Just (Postcondition pred
TimeOut) -> String
"#FF7F7F" -- light red
      Just (Postcondition pred
Terminates) ->  String
"#006400" -- dark green
      Just (HasUnresolvedIndirections [Key]
_) ->  String
"#CBC3E3" -- light purple
      Just (VerificationError [(Key, pred)]
_) ->  String
"#FF7F7F" -- light red

  entry_has_unresolved_indirections :: Key -> Bool
entry_has_unresolved_indirections Key
v = 
    let Just CFG
cfg = Key -> IntMap CFG -> Maybe CFG
forall a. Key -> IntMap a -> Maybe a
IM.lookup Key
v (IntMap CFG -> Maybe CFG) -> IntMap CFG -> Maybe CFG
forall a b. (a -> b) -> a -> b
$ L0 pred finit v -> IntMap CFG
forall pred finit v. L0 pred finit v -> IntMap CFG
l0_get_cfgs L0 pred finit v
l0
        blocks :: [[Instruction]]
blocks = IntMap [Instruction] -> [[Instruction]]
forall a. IntMap a -> [a]
IM.elems (IntMap [Instruction] -> [[Instruction]])
-> IntMap [Instruction] -> [[Instruction]]
forall a b. (a -> b) -> a -> b
$ CFG -> IntMap [Instruction]
cfg_instrs CFG
cfg in
      ([Instruction] -> Bool) -> [[Instruction]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Instruction] -> Bool
block_has_unresolved_instruction [[Instruction]]
blocks

  block_has_unresolved_instruction :: [Instruction] -> Bool
block_has_unresolved_instruction [Instruction]
instrs = Maybe (Set Indirection) -> Bool
contains_unresolved_indirections (Maybe (Set Indirection) -> Bool)
-> Maybe (Set Indirection) -> Bool
forall a b. (a -> b) -> a -> b
$ Word64 -> L0 pred finit v -> Maybe (Set Indirection)
forall {a} {pred} {finit} {v}.
Integral a =>
a -> L0 pred finit v -> Maybe (Set Indirection)
l0_lookup_indirection (Instruction -> Word64
inAddress (Instruction -> Word64) -> Instruction -> Word64
forall a b. (a -> b) -> a -> b
$ [Instruction] -> Instruction
forall a. HasCallStack => [a] -> a
last [Instruction]
instrs) L0 pred finit v
l0

  contains_unresolved_indirections :: Maybe (Set Indirection) -> Bool
contains_unresolved_indirections (Just Set Indirection
inds) = Indirection
Indirection_Unresolved Indirection -> Set Indirection -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Indirection
inds
  contains_unresolved_indirections Maybe (Set Indirection)
Nothing = Bool
False

  markup :: String -> String
markup String
vcs = Key -> String -> String
forall a. Key -> [a] -> [a]
take Key
max_limit_node_text_size_as_indicated_by_graphviz (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replace [Char
c | Char
c <- String
vcs, Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|']

  replace :: Char -> Char
replace Char
'\n' = Char
'|'
  replace Char
c    = Char
c

  max_limit_node_text_size_as_indicated_by_graphviz :: Key
max_limit_node_text_size_as_indicated_by_graphviz = Key
15000