{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Graph.Trace.Dot
( parseLogEntries
, parseLogEntry
, buildTree
, buildNexus
, graphToDot
, Key(..)
, LogEntry(..)
) where
import Control.Applicative ((<|>))
import Control.Monad
import qualified Crypto.Hash.SHA256 as Sha
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import qualified Data.Attoparsec.ByteString.Lazy as AttoL
import Data.Bifunctor
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (foldl')
import qualified Data.List as List
import qualified Data.Map.Lazy as ML
import qualified Data.Map.Strict as M
import Data.Maybe (isJust)
import Data.Monoid (Alt(..))
import Data.Ord (Down(..))
import Data.Semigroup (Min(..))
data Key = Key { Key -> Word
keyId :: !Word
, Key -> ByteString
keyName :: !BS.ByteString
}
deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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 :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show)
data LogEntry
= Entry
Key
(Maybe Key)
(Maybe SrcCodeLoc)
(Maybe SrcCodeLoc)
| Trace
Key
BS.ByteString
(Maybe SrcCodeLoc)
deriving Int -> LogEntry -> ShowS
[LogEntry] -> ShowS
LogEntry -> String
(Int -> LogEntry -> ShowS)
-> (LogEntry -> String) -> ([LogEntry] -> ShowS) -> Show LogEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogEntry] -> ShowS
$cshowList :: [LogEntry] -> ShowS
show :: LogEntry -> String
$cshow :: LogEntry -> String
showsPrec :: Int -> LogEntry -> ShowS
$cshowsPrec :: Int -> LogEntry -> ShowS
Show
data SrcCodeLoc =
SrcCodeLoc
{ SrcCodeLoc -> ByteString
srcMod :: BS.ByteString
, SrcCodeLoc -> Int
srcLine :: Int
, SrcCodeLoc -> Int
srcCol :: Int
} deriving (SrcCodeLoc -> SrcCodeLoc -> Bool
(SrcCodeLoc -> SrcCodeLoc -> Bool)
-> (SrcCodeLoc -> SrcCodeLoc -> Bool) -> Eq SrcCodeLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcCodeLoc -> SrcCodeLoc -> Bool
$c/= :: SrcCodeLoc -> SrcCodeLoc -> Bool
== :: SrcCodeLoc -> SrcCodeLoc -> Bool
$c== :: SrcCodeLoc -> SrcCodeLoc -> Bool
Eq, Eq SrcCodeLoc
Eq SrcCodeLoc
-> (SrcCodeLoc -> SrcCodeLoc -> Ordering)
-> (SrcCodeLoc -> SrcCodeLoc -> Bool)
-> (SrcCodeLoc -> SrcCodeLoc -> Bool)
-> (SrcCodeLoc -> SrcCodeLoc -> Bool)
-> (SrcCodeLoc -> SrcCodeLoc -> Bool)
-> (SrcCodeLoc -> SrcCodeLoc -> SrcCodeLoc)
-> (SrcCodeLoc -> SrcCodeLoc -> SrcCodeLoc)
-> Ord SrcCodeLoc
SrcCodeLoc -> SrcCodeLoc -> Bool
SrcCodeLoc -> SrcCodeLoc -> Ordering
SrcCodeLoc -> SrcCodeLoc -> SrcCodeLoc
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 :: SrcCodeLoc -> SrcCodeLoc -> SrcCodeLoc
$cmin :: SrcCodeLoc -> SrcCodeLoc -> SrcCodeLoc
max :: SrcCodeLoc -> SrcCodeLoc -> SrcCodeLoc
$cmax :: SrcCodeLoc -> SrcCodeLoc -> SrcCodeLoc
>= :: SrcCodeLoc -> SrcCodeLoc -> Bool
$c>= :: SrcCodeLoc -> SrcCodeLoc -> Bool
> :: SrcCodeLoc -> SrcCodeLoc -> Bool
$c> :: SrcCodeLoc -> SrcCodeLoc -> Bool
<= :: SrcCodeLoc -> SrcCodeLoc -> Bool
$c<= :: SrcCodeLoc -> SrcCodeLoc -> Bool
< :: SrcCodeLoc -> SrcCodeLoc -> Bool
$c< :: SrcCodeLoc -> SrcCodeLoc -> Bool
compare :: SrcCodeLoc -> SrcCodeLoc -> Ordering
$ccompare :: SrcCodeLoc -> SrcCodeLoc -> Ordering
$cp1Ord :: Eq SrcCodeLoc
Ord, Int -> SrcCodeLoc -> ShowS
[SrcCodeLoc] -> ShowS
SrcCodeLoc -> String
(Int -> SrcCodeLoc -> ShowS)
-> (SrcCodeLoc -> String)
-> ([SrcCodeLoc] -> ShowS)
-> Show SrcCodeLoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcCodeLoc] -> ShowS
$cshowList :: [SrcCodeLoc] -> ShowS
show :: SrcCodeLoc -> String
$cshow :: SrcCodeLoc -> String
showsPrec :: Int -> SrcCodeLoc -> ShowS
$cshowsPrec :: Int -> SrcCodeLoc -> ShowS
Show)
data NodeEntry key
= Message BS.ByteString
(Maybe SrcCodeLoc)
| Edge key
(Maybe SrcCodeLoc)
deriving Int -> NodeEntry key -> ShowS
[NodeEntry key] -> ShowS
NodeEntry key -> String
(Int -> NodeEntry key -> ShowS)
-> (NodeEntry key -> String)
-> ([NodeEntry key] -> ShowS)
-> Show (NodeEntry key)
forall key. Show key => Int -> NodeEntry key -> ShowS
forall key. Show key => [NodeEntry key] -> ShowS
forall key. Show key => NodeEntry key -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeEntry key] -> ShowS
$cshowList :: forall key. Show key => [NodeEntry key] -> ShowS
show :: NodeEntry key -> String
$cshow :: forall key. Show key => NodeEntry key -> String
showsPrec :: Int -> NodeEntry key -> ShowS
$cshowsPrec :: forall key. Show key => Int -> NodeEntry key -> ShowS
Show
type Color = BSB.Builder
type Node key =
( Min Int
, ( [NodeEntry key]
, Alt Maybe SrcCodeLoc
, Alt Maybe (Maybe key)
)
)
type Graph key = M.Map key (Node key)
type Tree = Graph Key
data NexusKey =
NexusKey { NexusKey -> ByteString
nexKeyName :: !BS.ByteString, NexusKey -> ByteString
nexKeyHash :: !BS.ByteString }
deriving (NexusKey -> NexusKey -> Bool
(NexusKey -> NexusKey -> Bool)
-> (NexusKey -> NexusKey -> Bool) -> Eq NexusKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NexusKey -> NexusKey -> Bool
$c/= :: NexusKey -> NexusKey -> Bool
== :: NexusKey -> NexusKey -> Bool
$c== :: NexusKey -> NexusKey -> Bool
Eq, Eq NexusKey
Eq NexusKey
-> (NexusKey -> NexusKey -> Ordering)
-> (NexusKey -> NexusKey -> Bool)
-> (NexusKey -> NexusKey -> Bool)
-> (NexusKey -> NexusKey -> Bool)
-> (NexusKey -> NexusKey -> Bool)
-> (NexusKey -> NexusKey -> NexusKey)
-> (NexusKey -> NexusKey -> NexusKey)
-> Ord NexusKey
NexusKey -> NexusKey -> Bool
NexusKey -> NexusKey -> Ordering
NexusKey -> NexusKey -> NexusKey
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 :: NexusKey -> NexusKey -> NexusKey
$cmin :: NexusKey -> NexusKey -> NexusKey
max :: NexusKey -> NexusKey -> NexusKey
$cmax :: NexusKey -> NexusKey -> NexusKey
>= :: NexusKey -> NexusKey -> Bool
$c>= :: NexusKey -> NexusKey -> Bool
> :: NexusKey -> NexusKey -> Bool
$c> :: NexusKey -> NexusKey -> Bool
<= :: NexusKey -> NexusKey -> Bool
$c<= :: NexusKey -> NexusKey -> Bool
< :: NexusKey -> NexusKey -> Bool
$c< :: NexusKey -> NexusKey -> Bool
compare :: NexusKey -> NexusKey -> Ordering
$ccompare :: NexusKey -> NexusKey -> Ordering
$cp1Ord :: Eq NexusKey
Ord, Int -> NexusKey -> ShowS
[NexusKey] -> ShowS
NexusKey -> String
(Int -> NexusKey -> ShowS)
-> (NexusKey -> String) -> ([NexusKey] -> ShowS) -> Show NexusKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NexusKey] -> ShowS
$cshowList :: [NexusKey] -> ShowS
show :: NexusKey -> String
$cshow :: NexusKey -> String
showsPrec :: Int -> NexusKey -> ShowS
$cshowsPrec :: Int -> NexusKey -> ShowS
Show)
type Nexus = Graph NexusKey
class Ord key => IsKey key where
getKeyName :: key -> BS.ByteString
keyStr :: key -> BSB.Builder
keyStrEsc :: key -> BSB.Builder
instance IsKey NexusKey where
getKeyName :: NexusKey -> ByteString
getKeyName = NexusKey -> ByteString
nexKeyName
keyStr :: NexusKey -> Builder
keyStr (NexusKey ByteString
name ByteString
hash) = ByteString -> Builder
BSB.byteString ByteString
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
hash
keyStrEsc :: NexusKey -> Builder
keyStrEsc NexusKey
k = NexusKey -> Builder
forall key. IsKey key => key -> Builder
keyStr NexusKey
k { nexKeyName :: ByteString
nexKeyName = ByteString -> ByteString
htmlEscape (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ NexusKey -> ByteString
nexKeyName NexusKey
k }
instance IsKey Key where
getKeyName :: Key -> ByteString
getKeyName = Key -> ByteString
keyName
keyStr :: Key -> Builder
keyStr (Key Word
i ByteString
k) = ByteString -> Builder
BSB.byteString ByteString
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
BSB.wordDec Word
i
keyStrEsc :: Key -> Builder
keyStrEsc Key
k = Key -> Builder
forall key. IsKey key => key -> Builder
keyStr Key
k { keyName :: ByteString
keyName = ByteString -> ByteString
htmlEscape (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Key -> ByteString
keyName Key
k }
parseLogEntries :: BSL.ByteString -> Either String [LogEntry]
parseLogEntries :: ByteString -> Either String [LogEntry]
parseLogEntries = Parser [LogEntry] -> ByteString -> Either String [LogEntry]
forall a. Parser a -> ByteString -> Either String a
AttoL.parseOnly (Parser ByteString LogEntry -> Parser [LogEntry]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Atto.many' Parser ByteString LogEntry
parseLogEntry Parser [LogEntry] -> Parser ByteString () -> Parser [LogEntry]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
Atto.endOfInput)
parseKey :: Atto.Parser Key
parseKey :: Parser Key
parseKey = do
ByteString
kName <- (Char -> Bool) -> Parser ByteString
Atto.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'§') Parser ByteString -> Parser ByteString Char -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto.char Char
'§'
Word
kId <- Parser Word
forall a. Integral a => Parser a
Atto.decimal Parser Word -> Parser ByteString Char -> Parser Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto.char Char
'§'
Key -> Parser Key
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> Parser Key) -> Key -> Parser Key
forall a b. (a -> b) -> a -> b
$ Key :: Word -> ByteString -> Key
Key { keyId :: Word
keyId = Word
kId, keyName :: ByteString
keyName = ByteString
kName }
parseLogEntry :: Atto.Parser LogEntry
parseLogEntry :: Parser ByteString LogEntry
parseLogEntry = (Parser ByteString LogEntry
parseEntryEvent Parser ByteString LogEntry
-> Parser ByteString LogEntry -> Parser ByteString LogEntry
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString LogEntry
parseTraceEvent) Parser ByteString LogEntry
-> Parser ByteString String -> Parser ByteString LogEntry
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char -> Parser ByteString String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Atto.many' Parser ByteString Char
Atto.space
parseEntryEvent :: Atto.Parser LogEntry
parseEntryEvent :: Parser ByteString LogEntry
parseEntryEvent = do
ByteString
_ <- ByteString -> Parser ByteString
Atto.string ByteString
"entry§"
Key
curKey <- Parser Key
parseKey
Maybe Key
mPrevKey <- Key -> Maybe Key
forall a. a -> Maybe a
Just (Key -> Maybe Key) -> Parser Key -> Parser ByteString (Maybe Key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Key
parseKey
Parser ByteString (Maybe Key)
-> Parser ByteString (Maybe Key) -> Parser ByteString (Maybe Key)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Key
forall a. Maybe a
Nothing Maybe Key -> Parser ByteString -> Parser ByteString (Maybe Key)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
Atto.string ByteString
"§§"
Maybe SrcCodeLoc
defSite <- Parser (Maybe SrcCodeLoc)
parseSrcCodeLoc
Maybe SrcCodeLoc
callSite <- Parser (Maybe SrcCodeLoc)
parseSrcCodeLoc
String
_ <- Parser ByteString Char -> Parser ByteString String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Atto.many' Parser ByteString Char
Atto.space
LogEntry -> Parser ByteString LogEntry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LogEntry -> Parser ByteString LogEntry)
-> LogEntry -> Parser ByteString LogEntry
forall a b. (a -> b) -> a -> b
$ Key
-> Maybe Key -> Maybe SrcCodeLoc -> Maybe SrcCodeLoc -> LogEntry
Entry Key
curKey Maybe Key
mPrevKey Maybe SrcCodeLoc
defSite Maybe SrcCodeLoc
callSite
parseTraceEvent :: Atto.Parser LogEntry
parseTraceEvent :: Parser ByteString LogEntry
parseTraceEvent = do
ByteString
_ <- ByteString -> Parser ByteString
Atto.string ByteString
"trace§"
Key
key <- Parser Key
parseKey
ByteString
message <- (Char -> Bool) -> Parser ByteString
Atto.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'§') Parser ByteString -> Parser ByteString Char -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto.char Char
'§'
Maybe SrcCodeLoc
callSite <- Parser (Maybe SrcCodeLoc)
parseSrcCodeLoc
String
_ <- Parser ByteString Char -> Parser ByteString String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Atto.many' Parser ByteString Char
Atto.space
let removeNewlines :: ByteString -> ByteString
removeNewlines = [ByteString] -> ByteString
BS8.unwords ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS8.lines
LogEntry -> Parser ByteString LogEntry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LogEntry -> Parser ByteString LogEntry)
-> LogEntry -> Parser ByteString LogEntry
forall a b. (a -> b) -> a -> b
$ Key -> ByteString -> Maybe SrcCodeLoc -> LogEntry
Trace Key
key (ByteString -> ByteString
htmlEscape (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
removeNewlines (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
message) Maybe SrcCodeLoc
callSite
parseSrcCodeLoc :: Atto.Parser (Maybe SrcCodeLoc)
parseSrcCodeLoc :: Parser (Maybe SrcCodeLoc)
parseSrcCodeLoc = do
let parseLoc :: Parser ByteString SrcCodeLoc
parseLoc = do
ByteString
srcMod <- (Char -> Bool) -> Parser ByteString
Atto.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'§') Parser ByteString -> Parser ByteString Char -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto.char Char
'§'
Int
srcLine <- Parser Int
forall a. Integral a => Parser a
Atto.decimal Parser Int -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto.char Char
'§'
Int
srcCol <- Parser Int
forall a. Integral a => Parser a
Atto.decimal Parser Int -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto.char Char
'§'
SrcCodeLoc -> Parser ByteString SrcCodeLoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcCodeLoc :: ByteString -> Int -> Int -> SrcCodeLoc
SrcCodeLoc{Int
ByteString
srcCol :: Int
srcLine :: Int
srcMod :: ByteString
srcCol :: Int
srcLine :: Int
srcMod :: ByteString
..}
SrcCodeLoc -> Maybe SrcCodeLoc
forall a. a -> Maybe a
Just (SrcCodeLoc -> Maybe SrcCodeLoc)
-> Parser ByteString SrcCodeLoc -> Parser (Maybe SrcCodeLoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SrcCodeLoc
parseLoc Parser (Maybe SrcCodeLoc)
-> Parser (Maybe SrcCodeLoc) -> Parser (Maybe SrcCodeLoc)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SrcCodeLoc
forall a. Maybe a
Nothing Maybe SrcCodeLoc -> Parser ByteString -> Parser (Maybe SrcCodeLoc)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
Atto.string ByteString
"§§§"
htmlEscape :: BS.ByteString -> BS.ByteString
htmlEscape :: ByteString -> ByteString
htmlEscape ByteString
bs = (ByteString -> (Char, ByteString) -> ByteString)
-> ByteString -> [(Char, ByteString)] -> ByteString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ByteString -> (Char, ByteString) -> ByteString
doReplacement ByteString
bs [(Char, ByteString)]
replacements
where
doReplacement :: ByteString -> (Char, ByteString) -> ByteString
doReplacement ByteString
acc (Char
c, ByteString
re) =
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) ByteString
acc of
(ByteString
before, ByteString
after)
| ByteString -> Bool
BS.null ByteString
after -> ByteString
acc
| Bool
otherwise -> ByteString
before ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
re ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BS8.tail ByteString
after
replacements :: [(Char, ByteString)]
replacements =
[ (Char
'&', ByteString
"&")
, (Char
'<', ByteString
"<")
, (Char
'>', ByteString
">")
, (Char
'\\', ByteString
"\\\\")
]
buildTree :: [LogEntry] -> Tree
buildTree :: [LogEntry] -> Tree
buildTree = (Tree -> LogEntry -> Tree) -> Tree -> [LogEntry] -> Tree
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Tree -> LogEntry -> Tree
build Tree
forall a. Monoid a => a
mempty where
build :: Tree -> LogEntry -> Tree
build Tree
graph LogEntry
entry =
case LogEntry
entry of
Trace Key
tag ByteString
msg Maybe SrcCodeLoc
callSite ->
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))))
-> Key
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> Tree
-> Tree
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
forall a. Semigroup a => a -> a -> a
(<>)
Key
tag
(Min Int
graphSize, ([ByteString -> Maybe SrcCodeLoc -> NodeEntry Key
forall key. ByteString -> Maybe SrcCodeLoc -> NodeEntry key
Message ByteString
msg Maybe SrcCodeLoc
callSite], Alt Maybe SrcCodeLoc
forall a. Monoid a => a
mempty, Alt Maybe (Maybe Key)
forall a. Monoid a => a
mempty))
Tree
graph
Entry Key
curTag (Just Key
prevTag) Maybe SrcCodeLoc
defSite Maybe SrcCodeLoc
callSite ->
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))))
-> Key
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> Tree
-> Tree
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
forall a. Semigroup a => a -> a -> a
(<>)
Key
curTag
(Min Int
graphSize Min Int -> Min Int -> Min Int
forall a. Num a => a -> a -> a
+ Min Int
1, ([], Maybe SrcCodeLoc -> Alt Maybe SrcCodeLoc
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt Maybe SrcCodeLoc
defSite, Maybe (Maybe Key) -> Alt Maybe (Maybe Key)
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Maybe (Maybe Key) -> Alt Maybe (Maybe Key))
-> (Maybe Key -> Maybe (Maybe Key))
-> Maybe Key
-> Alt Maybe (Maybe Key)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Key -> Maybe (Maybe Key)
forall a. a -> Maybe a
Just (Maybe Key -> Alt Maybe (Maybe Key))
-> Maybe Key -> Alt Maybe (Maybe Key)
forall a b. (a -> b) -> a -> b
$ Key -> Maybe Key
forall a. a -> Maybe a
Just Key
prevTag))
(Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ ((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))))
-> Key
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> Tree
-> Tree
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
forall a. Semigroup a => a -> a -> a
(<>)
Key
prevTag
(Min Int
graphSize, ([Key -> Maybe SrcCodeLoc -> NodeEntry Key
forall key. key -> Maybe SrcCodeLoc -> NodeEntry key
Edge Key
curTag Maybe SrcCodeLoc
callSite], Alt Maybe SrcCodeLoc
forall a. Monoid a => a
mempty, Alt Maybe (Maybe Key)
forall a. Monoid a => a
mempty))
Tree
graph
Entry Key
curTag Maybe Key
Nothing Maybe SrcCodeLoc
defSite Maybe SrcCodeLoc
_ ->
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))))
-> Key
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> Tree
-> Tree
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
forall a. Semigroup a => a -> a -> a
(<>)
Key
curTag
(Min Int
graphSize, ([], Maybe SrcCodeLoc -> Alt Maybe SrcCodeLoc
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt Maybe SrcCodeLoc
defSite, Alt Maybe (Maybe Key)
forall a. Monoid a => a
mempty))
Tree
graph
where
graphSize :: Min Int
graphSize = Int -> Min Int
forall a. a -> Min a
Min (Int -> Min Int) -> Int -> Min Int
forall a b. (a -> b) -> a -> b
$ Tree -> Int
forall k a. Map k a -> Int
M.size Tree
graph
buildNexus :: Tree -> Nexus
buildNexus :: Tree -> Nexus
buildNexus Tree
tree =
let hashes :: Map Key ByteString
hashes = Tree -> Map Key ByteString
calcHashes Tree
tree
toNexusKey :: Key -> NexusKey
toNexusKey Key
key =
case Key -> Map Key ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Key
key Map Key ByteString
hashes of
Maybe ByteString
Nothing -> String -> NexusKey
forall a. HasCallStack => String -> a
error String
"missing hash"
Just ByteString
hash ->
NexusKey :: ByteString -> ByteString -> NexusKey
NexusKey { nexKeyName :: ByteString
nexKeyName = Key -> ByteString
keyName Key
key, nexKeyHash :: ByteString
nexKeyHash = ByteString
hash }
mapNode :: ((a, (f (NodeEntry Key), b, Alt Maybe (Maybe Key))), Bool)
-> (a, (f (NodeEntry NexusKey), b, Alt Maybe (Maybe NexusKey)))
mapNode ((a
order, (f (NodeEntry Key)
entries, b
loc, Alt Maybe (Maybe Key)
mKey)), Bool
multipleParents) =
(a
order, ( NodeEntry Key -> NodeEntry NexusKey
mapEntry (NodeEntry Key -> NodeEntry NexusKey)
-> f (NodeEntry Key) -> f (NodeEntry NexusKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (NodeEntry Key)
entries
, b
loc
, if Bool
multipleParents
then Maybe (Maybe NexusKey) -> Alt Maybe (Maybe NexusKey)
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Maybe NexusKey -> Maybe (Maybe NexusKey)
forall a. a -> Maybe a
Just Maybe NexusKey
forall a. Maybe a
Nothing)
else (Key -> NexusKey) -> Maybe Key -> Maybe NexusKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Key -> NexusKey
toNexusKey (Maybe Key -> Maybe NexusKey)
-> Alt Maybe (Maybe Key) -> Alt Maybe (Maybe NexusKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Alt Maybe (Maybe Key)
mKey
)
)
mapEntry :: NodeEntry Key -> NodeEntry NexusKey
mapEntry = \case
Message ByteString
msg Maybe SrcCodeLoc
loc -> ByteString -> Maybe SrcCodeLoc -> NodeEntry NexusKey
forall key. ByteString -> Maybe SrcCodeLoc -> NodeEntry key
Message ByteString
msg Maybe SrcCodeLoc
loc
Edge Key
key Maybe SrcCodeLoc
loc ->
let nexKey :: NexusKey
nexKey = Key -> NexusKey
toNexusKey Key
key
in NexusKey -> Maybe SrcCodeLoc -> NodeEntry NexusKey
forall key. key -> Maybe SrcCodeLoc -> NodeEntry key
Edge NexusKey
nexKey
Maybe SrcCodeLoc
loc
multipleInEdges :: ((a, (a, b, Alt Maybe (Maybe Key))), Bool)
-> ((a, (a, b, Alt Maybe (Maybe Key))), Bool)
-> ((a, (a, b, Alt Maybe (Maybe Key))), Bool)
multipleInEdges
a :: ((a, (a, b, Alt Maybe (Maybe Key))), Bool)
a@((a
_, (a
_, b
_, Alt Maybe (Maybe Key)
ia)), Bool
multInA)
((a
_, (a
_, b
_, Alt Maybe (Maybe Key)
ib)), Bool
multInB) =
case NexusKey -> NexusKey -> Bool
forall a. Eq a => a -> a -> Bool
(==) (NexusKey -> NexusKey -> Bool)
-> Maybe NexusKey -> Maybe (NexusKey -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key -> NexusKey
toNexusKey (Key -> NexusKey) -> Maybe Key -> Maybe NexusKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe Key) -> Maybe Key
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe Key)
ia) Maybe (NexusKey -> Bool) -> Maybe NexusKey -> Maybe Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> NexusKey
toNexusKey (Key -> NexusKey) -> Maybe Key -> Maybe NexusKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe Key) -> Maybe Key
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe Key)
ib) of
(Just Bool
False) -> (((a, (a, b, Alt Maybe (Maybe Key))), Bool)
-> (a, (a, b, Alt Maybe (Maybe Key)))
forall a b. (a, b) -> a
fst ((a, (a, b, Alt Maybe (Maybe Key))), Bool)
a, Bool
True)
Maybe Bool
_ -> (((a, (a, b, Alt Maybe (Maybe Key))), Bool)
-> (a, (a, b, Alt Maybe (Maybe Key)))
forall a b. (a, b) -> a
fst ((a, (a, b, Alt Maybe (Maybe Key))), Bool)
a, Bool
multInA Bool -> Bool -> Bool
|| Bool
multInB)
in (((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> (Min Int,
([NodeEntry NexusKey], Alt Maybe SrcCodeLoc,
Alt Maybe (Maybe NexusKey))))
-> Map
NexusKey
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> Nexus
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> (Min Int,
([NodeEntry NexusKey], Alt Maybe SrcCodeLoc,
Alt Maybe (Maybe NexusKey)))
forall (f :: * -> *) a b.
Functor f =>
((a, (f (NodeEntry Key), b, Alt Maybe (Maybe Key))), Bool)
-> (a, (f (NodeEntry NexusKey), b, Alt Maybe (Maybe NexusKey)))
mapNode (Map
NexusKey
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> Nexus)
-> Map
NexusKey
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> Nexus
forall a b. (a -> b) -> a -> b
$
(((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> ((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> ((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool))
-> (Key -> NexusKey)
-> Map
Key
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> Map
NexusKey
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysWith
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> ((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
-> ((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
forall a a b a a b.
((a, (a, b, Alt Maybe (Maybe Key))), Bool)
-> ((a, (a, b, Alt Maybe (Maybe Key))), Bool)
-> ((a, (a, b, Alt Maybe (Maybe Key))), Bool)
multipleInEdges
Key -> NexusKey
toNexusKey
((,Bool
False) ((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> ((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool))
-> Tree
-> Map
Key
((Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key))),
Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree
tree)
calcHashes :: Tree -> M.Map Key BS.ByteString
calcHashes :: Tree -> Map Key ByteString
calcHashes Tree
tree =
let hashes :: Map Key ByteString
hashes = (Map Key ByteString
-> Key
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> Map Key ByteString)
-> Map Key ByteString -> Tree -> Map Key ByteString
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
ML.foldlWithKey Map Key ByteString
-> Key
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> Map Key ByteString
buildHash Map Key ByteString
forall a. Monoid a => a
mempty Tree
tree
buildHash :: Map Key ByteString
-> Key
-> (Min Int,
([NodeEntry Key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe Key)))
-> Map Key ByteString
buildHash Map Key ByteString
acc Key
key (Min Int
_, ([NodeEntry Key]
entries, Alt Maybe SrcCodeLoc
defSite, Alt Maybe (Maybe Key)
_)) =
let entryHashes :: Builder
entryHashes = (NodeEntry Key -> Builder) -> [NodeEntry Key] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NodeEntry Key -> Builder
hashEntry [NodeEntry Key]
entries
hash :: ByteString
hash = ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Sha.hash
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Key -> ByteString
keyName Key
key
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BSL.toStrict (Builder -> ByteString
BSB.toLazyByteString Builder
entryHashes)
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS8.pack (Alt Maybe SrcCodeLoc -> String
forall a. Show a => a -> String
show Alt Maybe SrcCodeLoc
defSite)
in Key -> ByteString -> Map Key ByteString -> Map Key ByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
ML.insert Key
key ByteString
hash Map Key ByteString
acc
hashEntry :: NodeEntry Key -> Builder
hashEntry = \case
Message ByteString
msg Maybe SrcCodeLoc
loc ->
ByteString -> Builder
BSB.byteString (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Sha.hash
(ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString
msg ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS8.pack (Maybe SrcCodeLoc -> String
forall a. Show a => a -> String
show Maybe SrcCodeLoc
loc)
Edge Key
key Maybe SrcCodeLoc
_ -> ByteString -> Builder
BSB.byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Key -> Map Key ByteString -> ByteString
forall k a. Ord k => a -> k -> Map k a -> a
ML.findWithDefault ByteString
forall a. Monoid a => a
mempty Key
key Map Key ByteString
hashes
in Map Key ByteString
hashes
graphToDot :: IsKey key => Graph key -> BSB.Builder
graphToDot :: Graph key -> Builder
graphToDot Graph key
graph = Builder
header Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
graphContent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
where
orderedEntries :: [(key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))]
orderedEntries = ((key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> (key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> [(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
-> [(key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))]
forall a b. (a -> b) -> [a] -> [b]
map (((Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
-> ([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
-> (key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> (key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
-> ([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))
forall a b. (a, b) -> b
snd)
([(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
-> [(key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))])
-> ([(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
-> [(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))])
-> [(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
-> [(key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> Down (Min Int))
-> [(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
-> [(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Min Int -> Down (Min Int)
forall a. a -> Down a
Down (Min Int -> Down (Min Int))
-> ((key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> Min Int)
-> (key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> Down (Min Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
-> Min Int
forall a b. (a, b) -> a
fst ((Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
-> Min Int)
-> ((key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> (Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> (key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> Min Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))
-> (Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
forall a b. (a, b) -> b
snd)
([(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
-> [(key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))])
-> [(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
-> [(key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))]
forall a b. (a -> b) -> a -> b
$ Graph key
-> [(key,
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key))))]
forall k a. Map k a -> [(k, a)]
M.toList Graph key
graph
graphContent :: Builder
graphContent =
let (Builder
output, [Builder]
_, Map key Builder
colorMap) =
((Builder, [Builder], Map key Builder)
-> (key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
-> (Builder, [Builder], Map key Builder))
-> (Builder, [Builder], Map key Builder)
-> [(key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))]
-> (Builder, [Builder], Map key Builder)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(Map key Builder
-> (Builder, [Builder], Map key Builder)
-> (key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
-> (Builder, [Builder], Map key Builder)
forall key (t :: * -> *) a (t :: * -> *).
(IsKey a, Foldable t, Foldable t, IsKey key) =>
Map key Builder
-> (Builder, [Builder], Map key Builder)
-> (key, ([NodeEntry key], Alt t SrcCodeLoc, Alt Maybe (t a)))
-> (Builder, [Builder], Map key Builder)
doNode Map key Builder
colorMap)
(Builder
forall a. Monoid a => a
mempty, [Builder] -> [Builder]
forall a. [a] -> [a]
cycle [Builder]
edgeColors, Map key Builder
forall a. Monoid a => a
mempty)
[(key,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))]
orderedEntries
in Builder
output
header :: BSB.Builder
header :: Builder
header = Builder
"digraph {\nnode [tooltip=\" \" shape=plaintext colorscheme=set28]\n"
doNode :: Map key Builder
-> (Builder, [Builder], Map key Builder)
-> (key, ([NodeEntry key], Alt t SrcCodeLoc, Alt Maybe (t a)))
-> (Builder, [Builder], Map key Builder)
doNode Map key Builder
finalColorMap (Builder
acc, [Builder]
colors, Map key Builder
colorMapAcc)
(key
key, ([NodeEntry key]
entries, Alt t SrcCodeLoc
mSrcLoc, Alt Maybe (t a)
mBacklink)) =
let ([Builder]
cells, [Builder]
edges, [Builder]
colors', Map key Builder
colorMapAcc')
= (([Builder], [Builder], [Builder], Map key Builder)
-> (NodeEntry key, Word)
-> ([Builder], [Builder], [Builder], Map key Builder))
-> ([Builder], [Builder], [Builder], Map key Builder)
-> [(NodeEntry key, Word)]
-> ([Builder], [Builder], [Builder], Map key Builder)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Builder], [Builder], [Builder], Map key Builder)
-> (NodeEntry key, Word)
-> ([Builder], [Builder], [Builder], Map key Builder)
doEntry ([], [], [Builder]
colors, Map key Builder
colorMapAcc) ([NodeEntry key] -> [Word] -> [(NodeEntry key, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip [NodeEntry key]
entries [Word
1..])
acc' :: Builder
acc' =
if [NodeEntry key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeEntry key]
entries Bool -> Bool -> Bool
&& Maybe (t a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (t a)
mBacklink
then Builder
acc
else Builder
tableStart
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
tableEl [Builder]
cells
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
tableEnd
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
edges
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc
in (Builder
acc', [Builder]
colors', Map key Builder
colorMapAcc')
where
quoted :: a -> a
quoted a
bs = a
"\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
bs a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""
nodeColor :: Maybe Builder
nodeColor = key -> Map key Builder -> Maybe Builder
forall k a. Ord k => k -> Map k a -> Maybe a
ML.lookup key
key Map key Builder
finalColorMap
nodeToolTip :: Builder
nodeToolTip = (SrcCodeLoc -> Builder) -> t SrcCodeLoc -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder
"defined at " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> (SrcCodeLoc -> Builder) -> SrcCodeLoc -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcCodeLoc -> Builder
pprSrcCodeLoc) t SrcCodeLoc
mSrcLoc
backHref :: Builder
backHref = ((t a -> Builder) -> Maybe (t a) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((t a -> Builder) -> Maybe (t a) -> Builder)
-> ((a -> Builder) -> t a -> Builder)
-> (a -> Builder)
-> Maybe (t a)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> t a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap) (\a
k -> Builder
"#" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall key. IsKey key => key -> Builder
keyStr a
k) Maybe (t a)
mBacklink
labelCell :: Builder
labelCell =
Builder -> [Attr] -> [Builder] -> Builder
el Builder
"TR" []
[ Builder -> [Attr] -> [Builder] -> Builder
el Builder
"TD" [ Builder
"HREF" Builder -> Builder -> Attr
.= Builder
backHref
, Builder
"TOOLTIP" Builder -> Builder -> Attr
.= Builder
nodeToolTip
, Builder
"BGCOLOR" Builder -> Maybe Builder -> Attr
.=? Maybe Builder
nodeColor
]
[ ((t a -> Builder) -> Maybe (t a) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((t a -> Builder) -> Maybe (t a) -> Builder)
-> ((a -> Builder) -> t a -> Builder)
-> (a -> Builder)
-> Maybe (t a)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> t a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap) (Builder -> a -> Builder
forall a b. a -> b -> a
const (Builder -> a -> Builder) -> Builder -> a -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Attr] -> [Builder] -> Builder
el Builder
"FONT" [Builder
"POINT-SIZE" Builder -> Builder -> Attr
.= Builder
"7"] [Builder
"←"])
Maybe (t a)
mBacklink
, Builder
" "
, Builder -> [Attr] -> [Builder] -> Builder
el Builder
"B" [] [ ByteString -> Builder
BSB.byteString (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
htmlEscape (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ key -> ByteString
forall key. IsKey key => key -> ByteString
getKeyName key
key ]
]
]
tableEl :: [Builder] -> Builder
tableEl [Builder]
cells =
Builder -> [Attr] -> [Builder] -> Builder
el Builder
"TABLE" [ Builder
"BORDER" Builder -> Builder -> Attr
.= Builder
"0"
, Builder
"CELLBORDER" Builder -> Builder -> Attr
.= Builder
"1"
, Builder
"CELLSPACING" Builder -> Builder -> Attr
.= Builder
"0"
, Builder
"CELLPADDING" Builder -> Builder -> Attr
.= Builder
"4"
]
[ Builder
labelCell
, [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
cells
]
tableStart, tableEnd :: BSB.Builder
tableStart :: Builder
tableStart = Builder -> Builder
forall a. (Semigroup a, IsString a) => a -> a
quoted (key -> Builder
forall key. IsKey key => key -> Builder
keyStr key
key) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" [label=<\n"
tableEnd :: Builder
tableEnd = Builder
">];"
doEntry :: ([Builder], [Builder], [Builder], Map key Builder)
-> (NodeEntry key, Word)
-> ([Builder], [Builder], [Builder], Map key Builder)
doEntry ([Builder]
cs, [Builder]
es, colors' :: [Builder]
colors'@(Builder
color:[Builder]
nextColors), Map key Builder
colorMap) = \case
(Message ByteString
str Maybe SrcCodeLoc
mCallSite, Word
idx) ->
let msgToolTip :: Builder
msgToolTip =
(SrcCodeLoc -> Builder) -> Maybe SrcCodeLoc -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder
"printed at " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> (SrcCodeLoc -> Builder) -> SrcCodeLoc -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcCodeLoc -> Builder
pprSrcCodeLoc) Maybe SrcCodeLoc
mCallSite
msgEl :: Builder
msgEl =
Builder -> [Attr] -> [Builder] -> Builder
el Builder
"TR" []
[ Builder -> [Attr] -> [Builder] -> Builder
el Builder
"TD" [ Builder
"HREF" Builder -> Builder -> Attr
.= Builder
""
, Builder
"TOOLTIP" Builder -> Builder -> Attr
.= Builder
msgToolTip
, Builder
"ALIGN" Builder -> Builder -> Attr
.= Builder
"LEFT"
, Builder
"PORT" Builder -> Builder -> Attr
.= Word -> Builder
BSB.wordDec Word
idx
]
[ ByteString -> Builder
BSB.byteString ByteString
str ]
]
in (Builder
msgEl Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
cs, [Builder]
es, [Builder]
colors', Map key Builder
colorMap)
(Edge key
edgeKey Maybe SrcCodeLoc
mCallSite, Word
idx) ->
let mTargetNode :: Maybe
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
mTargetNode = key
-> Graph key
-> Maybe
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup key
edgeKey Graph key
graph
edgeColor :: Builder
edgeColor =
case Maybe
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
mTargetNode of
Just (Min Int
_, ([NodeEntry key]
content, Alt Maybe SrcCodeLoc
_, Alt Maybe (Maybe key)
_))
| Bool -> Bool
not ([NodeEntry key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeEntry key]
content) ->
Builder -> key -> Map key Builder -> Builder
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Builder
color key
edgeKey Map key Builder
colorMap
Maybe
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
_ -> Builder
color
href :: Builder
href = (Builder -> Builder) -> Maybe Builder -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Builder -> Builder -> Builder
forall a b. a -> b -> a
const (Builder -> Builder -> Builder) -> Builder -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
"#" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> key -> Builder
forall key. IsKey key => key -> Builder
keyStrEsc key
edgeKey) Maybe Builder
mEdge
elToolTip :: Builder
elToolTip =
(SrcCodeLoc -> Builder) -> Maybe SrcCodeLoc -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder
"called at " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> (SrcCodeLoc -> Builder) -> SrcCodeLoc -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcCodeLoc -> Builder
pprSrcCodeLoc) Maybe SrcCodeLoc
mCallSite
edgeEl :: Builder
edgeEl =
Builder -> [Attr] -> [Builder] -> Builder
el Builder
"TR" []
[ Builder -> [Attr] -> [Builder] -> Builder
el Builder
"TD" [ Builder
"TOOLTIP" Builder -> Builder -> Attr
.= Builder
elToolTip
, Builder
"ALIGN" Builder -> Builder -> Attr
.= Builder
"LEFT"
, Builder
"CELLPADDING" Builder -> Builder -> Attr
.= Builder
"1"
, Builder
"BGCOLOR" Builder -> Builder -> Attr
.= Builder
edgeColor
, Builder
"PORT" Builder -> Builder -> Attr
.= Word -> Builder
BSB.wordDec Word
idx
, Builder
"HREF" Builder -> Builder -> Attr
.= Builder
href
]
[ Builder -> [Attr] -> [Builder] -> Builder
el Builder
"FONT" [ Builder
"POINT-SIZE" Builder -> Builder -> Attr
.= Builder
"8" ]
[ ByteString -> Builder
BSB.byteString (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
htmlEscape (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ key -> ByteString
forall key. IsKey key => key -> ByteString
getKeyName key
edgeKey ]
]
]
mEdge :: Maybe Builder
mEdge = do
(Min Int
_, ([NodeEntry key]
targetContent, Alt Maybe SrcCodeLoc
_, Alt Maybe (Maybe key)
_)) <- Maybe
(Min Int,
([NodeEntry key], Alt Maybe SrcCodeLoc, Alt Maybe (Maybe key)))
mTargetNode
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (Bool -> Bool) -> Bool -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [NodeEntry key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeEntry key]
targetContent
Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$
Builder -> Builder
forall a. (Semigroup a, IsString a) => a -> a
quoted (key -> Builder
forall key. IsKey key => key -> Builder
keyStr key
key) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
BSB.wordDec Word
idx
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" -> " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
forall a. (Semigroup a, IsString a) => a -> a
quoted (key -> Builder
forall key. IsKey key => key -> Builder
keyStr key
edgeKey)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" [tooltip=\" \" colorscheme=set28 color=" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
edgeColor Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"];"
in ( Builder
edgeEl Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
cs
, ([Builder] -> [Builder])
-> (Builder -> [Builder] -> [Builder])
-> Maybe Builder
-> [Builder]
-> [Builder]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Builder] -> [Builder]
forall a. a -> a
id (:) Maybe Builder
mEdge [Builder]
es
, [Builder]
nextColors
, key -> Builder -> Map key Builder -> Map key Builder
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert key
edgeKey Builder
edgeColor Map key Builder
colorMap
)
doEntry ([Builder], [Builder], [Builder], Map key Builder)
_ = (NodeEntry key, Word)
-> ([Builder], [Builder], [Builder], Map key Builder)
forall a. Monoid a => a
mempty
type Element = BSB.Builder
type Attr = (BSB.Builder, Maybe BSB.Builder)
(.=) :: BSB.Builder -> BSB.Builder -> Attr
Builder
name .= :: Builder -> Builder -> Attr
.= Builder
val = Builder
name Builder -> Maybe Builder -> Attr
.=? Builder -> Maybe Builder
forall a. a -> Maybe a
Just Builder
val
(.=?) :: BSB.Builder -> Maybe BSB.Builder -> Attr
Builder
name .=? :: Builder -> Maybe Builder -> Attr
.=? Maybe Builder
val = (Builder
name, Maybe Builder
val)
el :: BSB.Builder -> [Attr] -> [BSB.Builder] -> Element
el :: Builder -> [Attr] -> [Builder] -> Builder
el Builder
name [Attr]
attrs [Builder]
children =
Builder
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Attr -> Builder) -> [Attr] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Attr -> Builder
forall p. (IsString p, Monoid p) => (p, Maybe p) -> p
renderAttr [Attr]
attrs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
children Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">"
where
renderAttr :: (p, Maybe p) -> p
renderAttr (p
aName, Just p
aVal) = p
" " p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
aName p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"=\"" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
aVal p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"\""
renderAttr (p
_, Maybe p
Nothing) = p
forall a. Monoid a => a
mempty
edgeColors :: [Color]
edgeColors :: [Builder]
edgeColors = Int -> Builder
BSB.intDec (Int -> Builder) -> [Int] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1..Int
8 :: Int]
pprSrcCodeLoc :: SrcCodeLoc -> BSB.Builder
pprSrcCodeLoc :: SrcCodeLoc -> Builder
pprSrcCodeLoc SrcCodeLoc
loc
= ByteString -> Builder
BSB.byteString (SrcCodeLoc -> ByteString
srcMod SrcCodeLoc
loc) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BSB.intDec (SrcCodeLoc -> Int
srcLine SrcCodeLoc
loc) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BSB.intDec (SrcCodeLoc -> Int
srcCol SrcCodeLoc
loc)