packages feed

jaeger-flamegraph 1.2.0 → 1.3.0

raw patch · 6 files changed

+137/−123 lines, 6 filesdep ~QuickCheckdep ~containersdep ~optparse-applicative

Dependency ranges changed: QuickCheck, containers, optparse-applicative

Files

exe/Main.hs view
@@ -1,16 +1,11 @@-{-# LANGUAGE DeriveAnyClass             #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DerivingStrategies         #-}-{-# LANGUAGE DuplicateRecordFields      #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE StrictData                 #-}-{-# LANGUAGE TupleSections              #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE StrictData            #-}+{-# LANGUAGE TupleSections         #-}  import           Control.Applicative ((<|>))-import           Data.Aeson          (FromJSON, FromJSONKey, eitherDecodeStrict,-                                      parseJSON, withObject, (.:))+import           Data.Aeson          (eitherDecodeStrict) import qualified Data.ByteString     as BS import           Data.Foldable       (traverse_) import           Data.List           (intersect, nub, (\\))@@ -21,9 +16,8 @@ import           Data.Maybe          (maybeToList) import           Data.Text           (Text, intercalate, map, pack) import           Data.Text.IO        (putStrLn)-import           GHC.Generics        (Generic)-import           Interval            (Interval, interval, intervalEnd,-                                      intervalStart, measure, width)+import           Jaeger.Data+import           Jaeger.Interval import qualified Options.Applicative as Opts import           Prelude             hiding (map, putStrLn) @@ -43,7 +37,7 @@  data Options = Options   { input      :: Input-  , ignoreTags :: [Tag]+  , ignoreTags :: [Text]   , annotated  :: [ProcessID]   , qualify    :: Bool   , wall       :: Bool@@ -62,7 +56,7 @@              <> Opts.short 'f'              <> Opts.metavar "FILENAME"              <> Opts.help "Input file")-    tag = Tag <$> Opts.strOption+    tag = Opts.strOption              (  Opts.short 'i'              <> Opts.long "ignore"              <> Opts.metavar "TAG-KEY"@@ -81,46 +75,6 @@              <> Opts.long "walltime"              <> Opts.help "Takes start/end times of children into account when calculating times.") -newtype Jaeger = Jaeger [Data]-instance FromJSON Jaeger where-  parseJSON = withObject "Jaeger" $ \v -> Jaeger <$> v .: "data"--newtype TraceID   = TraceID Text deriving newtype (Eq, Ord, FromJSON)-newtype SpanID    = SpanID  Text deriving newtype (Eq, Ord, FromJSON)-newtype ProcessID = ProcessID Text deriving newtype (Eq, Ord, FromJSON, FromJSONKey)-newtype Name      = Name { unName :: Text } deriving newtype (Eq, FromJSON)--data Data = Data-  { traceID   :: TraceID-  , spans     :: [Span]-  , processes :: Map.Map ProcessID Process-  } deriving (Generic, FromJSON)--data Process = Process-  { serviceName :: Text-  } deriving (Generic, FromJSON)--data Span = Span-  { spanID        :: SpanID-  , traceID       :: TraceID-  , operationName :: Name-  , references    :: [Reference]-  , startTime     :: Integer-  , duration      :: Integer-  , tags          :: [Tag]-  , processID     :: ProcessID-  } deriving (Generic, FromJSON)--data Reference = Reference-  { traceID :: TraceID-  , spanID  :: SpanID-  } deriving (Eq, Ord, Generic, FromJSON)--newtype Tag = Tag-  { key :: Text-  } deriving (Eq, Generic)-    deriving anyclass (FromJSON)- type Processes = Map (TraceID, ProcessID) Process  buildProcesses :: [Data] -> Processes@@ -141,7 +95,7 @@   , name     :: Name   , process  :: ProcessID   , children :: [Flame]-  , tags     :: [Tag]+  , tags     :: [Text]   }  selftime :: Flame -> Integer@@ -184,13 +138,13 @@                                 (qualifiedName operationName (traceID, processID))                                 processID                                 (build <$> deps i)-                                tags+                                (key <$> tags)     deps i = do refs <- maybeToList $ Map.lookup i children                 ref  <- refs                 maybeToList $ lookupSpan ref-    qualifiedName orig pid = case Map.lookup pid procs of-      Nothing -> orig-      Just p  -> Name $ (unName orig) <> "..." <> (serviceName p)+    qualifiedName (Name orig) pid = case Map.lookup pid procs of+      Nothing -> Name orig+      Just p  -> Name $ orig <> "..." <> (serviceName p)  -- https://github.com/brendangregg/FlameGraph/blob/master/flamegraph.pl --@@ -217,7 +171,7 @@   , annotated :: Bool   } -buildStacks :: Bool -> [Tag] -> [ProcessID] -> Flame -> [Stack]+buildStacks :: Bool -> [Text] -> [ProcessID] -> Flame -> [Stack] buildStacks wall banned annotate = stacks []   where     stacks :: [Name] -> Flame -> [Stack]@@ -229,7 +183,7 @@            where t = if wall then walltime f else selftime f  drawStack :: Stack -> Text-drawStack Stack{..} = intercalate ";" (map cleanup . unName <$>+drawStack Stack{..} = intercalate ";" ((\(Name n) -> map cleanup n) <$>                                        (reverse . toList $ frames))                       <> ann <> " " <> (pack . show $ samples)   where cleanup ' ' = '.'
jaeger-flamegraph.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                jaeger-flamegraph-version:             1.2.0+version:             1.3.0 synopsis:            Generate flamegraphs from Jaeger .json dumps. license:             BSD-3-Clause license-file:        LICENSE@@ -11,16 +11,19 @@ tested-with:         GHC ^>= 8.4.4 || ^>= 8.6.2 category:            Testing description:-  This is a small tool to convert JSON dumps obtained from a [Jaeger-  server] (https://www.jaegertracing.io/) into a format consumable+  This is a small tool to convert JSON dumps obtained from a Jaeger+  server (<https://www.jaegertracing.io/>) into a format consumable   by [FlameGraph](https://github.com/brendangregg/FlameGraph).   .-  Filter the traces for your SERVICE from the-  [undocumented Jaeger API](https://github.com/jaegertracing/jaeger/issues/456).+  First download the traces for your SERVICE limiting to LIMIT traces   .-  > $ curl http://jaeger/api/traces?service=SERVICE&limit=1000 |-  >   jaeger-flamegraph |-  >   flamegraph.pl > output.svg+  > $ curl http://your-jaeger-installation/api/traces?service=SERVICE&limit=LIMIT > input.json+  .+  using the [undocumented Jaeger API](https://github.com/jaegertracing/jaeger/issues/456#issuecomment-412560321)+  then use @jaeger-flamegraph@ to convert the data and send to @flamegraph.pl@+  .+  > $ jaeger-flamegraph -f input.json | flamegraph.pl > output.svg+  .  source-repository head   type: git@@ -32,25 +35,26 @@   build-depends:    , base ^>= 4.11.1.0 || ^>= 4.12.0.0   ghc-options:        -Wall                       -Werror=missing-home-modules+  build-depends:    , aeson                ^>= 1.4.1.0+                    , containers           ^>= 0.6.0.1+                    , text                 ^>= 1.2.3.1   default-language:   Haskell2010  executable jaeger-flamegraph   import:             deps   hs-source-dirs:     exe   main-is:            Main.hs-  build-depends:    , jaeger-flamegraph-lib+  build-depends:    , jaeger-flamegraph                     , bytestring           ^>= 0.10.8.2-                    , containers           ^>= 0.6.0.1                     , extra                ^>= 1.6.13-                    , aeson                ^>= 1.4.1.0                     , optparse-applicative ^>= 0.14.3.0-                    , text                 ^>= 1.2.3.1   ghc-options:        -threaded -library jaeger-flamegraph-lib+library   import:             deps   hs-source-dirs:     library-  exposed-modules:    Interval+  exposed-modules:    Jaeger.Interval+                    , Jaeger.Data   build-depends:    , QuickCheck ^>= 2.12.6.1  test-suite            tests@@ -59,7 +63,7 @@   type:               exitcode-stdio-1.0   main-is:            Driver.hs   other-modules:      IntervalTest-  build-depends:    , jaeger-flamegraph-lib+  build-depends:    , jaeger-flamegraph                     , tasty            ^>= 1.1.0.4                     , tasty-hspec      ^>= 1.1.5                     , tasty-quickcheck ^>= 0.10
− library/Interval.hs
@@ -1,44 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}--module Interval-  ( Interval-  , interval-  , intervalStart-  , intervalEnd-  , measure-  , width)-where--import           Data.List                 (sort)-import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)---- nothing on http://hackage.haskell.org/packages/search?terms=interval-data Interval = Interval-  { intervalStart :: Integer -- ^ assume start <= end-  , intervalEnd   :: Integer-  } deriving (Eq, Ord, Show)--interval :: Integer -> Integer -> Interval-interval a b | a <= b    = Interval a b-             | otherwise = Interval b a--width :: Interval -> Integer-width (Interval from to) = to - from---- idea by etorreborre-measure :: [Interval] -> Integer-measure unsorted =-  count $ sieve sorted-  where-    sorted = sort unsorted-    sieve (car@(Interval a b) : cadr@(Interval c d) : rest) =-      if a == c || c <= b-      then sieve $ Interval a (max b d) : rest-      else car : sieve (cadr : rest)-    sieve done = done-    count is = sum $ width <$> is--instance Arbitrary Interval where-  arbitrary = do a <- arbitrary-                 b <- arbitrary-                 pure $ interval a b
+ library/Jaeger/Data.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveAnyClass             #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE DuplicateRecordFields      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE StrictData                 #-}++module Jaeger.Data where++import           Data.Aeson+import           Data.Map.Strict     (Map)+import           Data.Text+import           GHC.Generics        (Generic)++newtype Jaeger = Jaeger [Data]+instance FromJSON Jaeger where+  parseJSON = withObject "Jaeger" $ \v -> Jaeger <$> v .: "data"+instance ToJSON Jaeger where+  toJSON (Jaeger dat) = object ["data" .= dat]++newtype TraceID   = TraceID Text deriving newtype (Eq, Ord, FromJSON, ToJSON)+newtype SpanID    = SpanID  Text deriving newtype (Eq, Ord, FromJSON, ToJSON)+newtype ProcessID = ProcessID Text deriving newtype (Eq, Ord, FromJSON, FromJSONKey, ToJSON, ToJSONKey)+newtype Name      = Name Text deriving newtype (Eq, FromJSON, ToJSON)++data Data = Data+  { traceID   :: TraceID+  , spans     :: [Span]+  , processes :: Map ProcessID Process+  } deriving (Generic, FromJSON, ToJSON)++data Process = Process+  { serviceName :: Text+  } deriving (Generic, FromJSON, ToJSON)++data Span = Span+  { spanID        :: SpanID+  , traceID       :: TraceID+  , operationName :: Name+  , references    :: [Reference]+  , startTime     :: Integer+  , duration      :: Integer+  , tags          :: [Tag]+  , processID     :: ProcessID+  } deriving (Generic, FromJSON, ToJSON)++data Reference = Reference+  { traceID :: TraceID+  , spanID  :: SpanID+  } deriving (Eq, Ord, Generic, FromJSON, ToJSON)++data Tag = Tag+  { key   :: Text+  , value :: Value -- arbitrary content+  } deriving (Eq, Generic, FromJSON, ToJSON)
+ library/Jaeger/Interval.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE NamedFieldPuns #-}++module Jaeger.Interval+  ( Interval+  , interval+  , intervalStart+  , intervalEnd+  , measure+  , width)+where++import           Data.List                 (sort)+import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)++-- nothing on http://hackage.haskell.org/packages/search?terms=interval+data Interval = Interval+  { intervalStart :: Integer -- ^ assume start <= end+  , intervalEnd   :: Integer+  } deriving (Eq, Ord, Show)++interval :: Integer -> Integer -> Interval+interval a b | a <= b    = Interval a b+             | otherwise = Interval b a++width :: Interval -> Integer+width (Interval from to) = to - from++-- idea by etorreborre+measure :: [Interval] -> Integer+measure unsorted =+  count $ sieve sorted+  where+    sorted = sort unsorted+    sieve (car@(Interval a b) : cadr@(Interval c d) : rest) =+      if a == c || c <= b+      then sieve $ Interval a (max b d) : rest+      else car : sieve (cadr : rest)+    sieve done = done+    count is = sum $ width <$> is++instance Arbitrary Interval where+  arbitrary = do a <- arbitrary+                 b <- arbitrary+                 pure $ interval a b
test/IntervalTest.hs view
@@ -1,7 +1,7 @@ module IntervalTest where  import           Data.List        (nub, permutations)-import           Interval+import           Jaeger.Interval import           Test.Tasty.Hspec  -- https://hspec.github.io/writing-specs.html