module Futhark.CLI.Profile (main) where
import Control.Exception (catch)
import Data.ByteString.Lazy.Char8 qualified as BS
import Data.List qualified as L
import Data.Map qualified as M
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Futhark.Bench
import Futhark.Util (showText)
import Futhark.Util.Options
import System.Directory (createDirectoryIfMissing, removePathForcibly)
import System.Exit
import System.FilePath
import System.IO
import Text.Printf
commonPrefix :: (Eq e) => [e] -> [e] -> [e]
commonPrefix :: forall e. Eq e => [e] -> [e] -> [e]
commonPrefix [e]
_ [] = []
commonPrefix [] [e]
_ = []
commonPrefix (e
x : [e]
xs) (e
y : [e]
ys)
| e
x e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
y = e
x e -> [e] -> [e]
forall a. a -> [a] -> [a]
: [e] -> [e] -> [e]
forall e. Eq e => [e] -> [e] -> [e]
commonPrefix [e]
xs [e]
ys
| Bool
otherwise = []
longestCommonPrefix :: [FilePath] -> FilePath
longestCommonPrefix :: [FilePath] -> FilePath
longestCommonPrefix [] = FilePath
""
longestCommonPrefix (FilePath
x : [FilePath]
xs) = (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
forall e. Eq e => [e] -> [e] -> [e]
commonPrefix FilePath
x [FilePath]
xs
memoryReport :: M.Map T.Text Integer -> T.Text
memoryReport :: Map Text Integer -> Text
memoryReport = [Text] -> Text
T.unlines ([Text] -> Text)
-> (Map Text Integer -> [Text]) -> Map Text Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Peak memory usage in bytes" :) ([Text] -> [Text])
-> (Map Text Integer -> [Text]) -> Map Text Integer -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Integer) -> Text) -> [(Text, Integer)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Integer) -> Text
forall {a}. Show a => (Text, a) -> Text
f ([(Text, Integer)] -> [Text])
-> (Map Text Integer -> [(Text, Integer)])
-> Map Text Integer
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Integer -> [(Text, Integer)]
forall k a. Map k a -> [(k, a)]
M.toList
where
f :: (Text, a) -> Text
f (Text
space, a
bytes) = Text
space Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
showText a
bytes
padRight :: Int -> T.Text -> T.Text
padRight :: Int -> Text -> Text
padRight Int
k Text
s = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) Text
" "
padLeft :: Int -> T.Text -> T.Text
padLeft :: Int -> Text -> Text
padLeft Int
k Text
s = Int -> Text -> Text
T.replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
data EvSummary = EvSummary
{ EvSummary -> Integer
evCount :: Integer,
EvSummary -> Double
evSum :: Double,
EvSummary -> Double
evMin :: Double,
EvSummary -> Double
evMax :: Double
}
tabulateEvents :: [ProfilingEvent] -> T.Text
tabulateEvents :: [ProfilingEvent] -> Text
tabulateEvents = [(Text, EvSummary)] -> Text
mkRows ([(Text, EvSummary)] -> Text)
-> ([ProfilingEvent] -> [(Text, EvSummary)])
-> [ProfilingEvent]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text EvSummary -> [(Text, EvSummary)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text EvSummary -> [(Text, EvSummary)])
-> ([ProfilingEvent] -> Map Text EvSummary)
-> [ProfilingEvent]
-> [(Text, EvSummary)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EvSummary -> EvSummary -> EvSummary)
-> [(Text, EvSummary)] -> Map Text EvSummary
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith EvSummary -> EvSummary -> EvSummary
comb ([(Text, EvSummary)] -> Map Text EvSummary)
-> ([ProfilingEvent] -> [(Text, EvSummary)])
-> [ProfilingEvent]
-> Map Text EvSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProfilingEvent -> (Text, EvSummary))
-> [ProfilingEvent] -> [(Text, EvSummary)]
forall a b. (a -> b) -> [a] -> [b]
map ProfilingEvent -> (Text, EvSummary)
pair
where
pair :: ProfilingEvent -> (Text, EvSummary)
pair (ProfilingEvent Text
name Double
dur Text
_) = (Text
name, Integer -> Double -> Double -> Double -> EvSummary
EvSummary Integer
1 Double
dur Double
dur Double
dur)
comb :: EvSummary -> EvSummary -> EvSummary
comb (EvSummary Integer
xn Double
xdur Double
xmin Double
xmax) (EvSummary Integer
yn Double
ydur Double
ymin Double
ymax) =
Integer -> Double -> Double -> Double -> EvSummary
EvSummary (Integer
xn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
yn) (Double
xdur Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ydur) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
xmin Double
ymin) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
xmax Double
ymax)
numpad :: Int
numpad = Int
15
mkRows :: [(Text, EvSummary)] -> Text
mkRows [(Text, EvSummary)]
rows =
let longest :: Int
longest = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
numpad ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Text, EvSummary) -> Int) -> [(Text, EvSummary)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int)
-> ((Text, EvSummary) -> Text) -> (Text, EvSummary) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, EvSummary) -> Text
forall a b. (a, b) -> a
fst) [(Text, EvSummary)]
rows
header :: Text
header = Int -> Text
headerRow Int
longest
splitter :: Text
splitter = (Char -> Char) -> Text -> Text
T.map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
'-') Text
header
bottom :: Text
bottom =
[Text] -> Text
T.unwords
[ Integer -> Text
forall a. Show a => a -> Text
showText ([Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Text, EvSummary) -> Integer) -> [(Text, EvSummary)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (EvSummary -> Integer
evCount (EvSummary -> Integer)
-> ((Text, EvSummary) -> EvSummary) -> (Text, EvSummary) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, EvSummary) -> EvSummary
forall a b. (a, b) -> b
snd) [(Text, EvSummary)]
rows)),
Text
"events with a total runtime of",
FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%.2fμs" (Double -> FilePath) -> Double -> FilePath
forall a b. (a -> b) -> a -> b
$ [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((Text, EvSummary) -> Double) -> [(Text, EvSummary)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (EvSummary -> Double
evSum (EvSummary -> Double)
-> ((Text, EvSummary) -> EvSummary) -> (Text, EvSummary) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, EvSummary) -> EvSummary
forall a b. (a, b) -> b
snd) [(Text, EvSummary)]
rows
]
in [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
Text
header
Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
splitter
Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text, EvSummary) -> Text) -> [(Text, EvSummary)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Text, EvSummary) -> Text
mkRow Int
longest) [(Text, EvSummary)]
rows
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
splitter, Text
bottom]
headerRow :: Int -> Text
headerRow Int
longest =
[Text] -> Text
T.unwords
[ Int -> Text -> Text
padLeft Int
longest Text
"Cost centre",
Int -> Text -> Text
padLeft Int
numpad Text
"count",
Int -> Text -> Text
padLeft Int
numpad Text
"sum",
Int -> Text -> Text
padLeft Int
numpad Text
"avg",
Int -> Text -> Text
padLeft Int
numpad Text
"min",
Int -> Text -> Text
padLeft Int
numpad Text
"max"
]
mkRow :: Int -> (Text, EvSummary) -> Text
mkRow Int
longest (Text
name, EvSummary
ev) =
[Text] -> Text
T.unwords
[ Int -> Text -> Text
padRight Int
longest Text
name,
Int -> Text -> Text
padLeft Int
numpad (Integer -> Text
forall a. Show a => a -> Text
showText (EvSummary -> Integer
evCount EvSummary
ev)),
Int -> Text -> Text
padLeft Int
numpad (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%.2fμs" (EvSummary -> Double
evSum EvSummary
ev),
Int -> Text -> Text
padLeft Int
numpad (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%.2fμs" (Double -> FilePath) -> Double -> FilePath
forall a b. (a -> b) -> a -> b
$ EvSummary -> Double
evSum EvSummary
ev Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a. Num a => Integer -> a
fromInteger (EvSummary -> Integer
evCount EvSummary
ev),
Int -> Text -> Text
padLeft Int
numpad (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%.2fμs" (EvSummary -> Double
evMin EvSummary
ev),
Int -> Text -> Text
padLeft Int
numpad (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%.2fμs" (EvSummary -> Double
evMax EvSummary
ev)
]
timeline :: [ProfilingEvent] -> T.Text
timeline :: [ProfilingEvent] -> Text
timeline = [Text] -> Text
T.unlines ([Text] -> Text)
-> ([ProfilingEvent] -> [Text]) -> [ProfilingEvent] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [[Text]] -> [Text]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Text
""] ([[Text]] -> [Text])
-> ([ProfilingEvent] -> [[Text]]) -> [ProfilingEvent] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProfilingEvent -> [Text]) -> [ProfilingEvent] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ProfilingEvent -> [Text]
onEvent
where
onEvent :: ProfilingEvent -> [Text]
onEvent (ProfilingEvent Text
name Double
duration Text
description) =
[Text
name, Text
"Duration: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a. Show a => a -> Text
showText Double
duration Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" μs"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
T.lines Text
description
data TargetFiles = TargetFiles
{ TargetFiles -> FilePath
summaryFile :: FilePath,
TargetFiles -> FilePath
timelineFile :: FilePath
}
writeAnalysis :: TargetFiles -> ProfilingReport -> IO ()
writeAnalysis :: TargetFiles -> ProfilingReport -> IO ()
writeAnalysis TargetFiles
tf ProfilingReport
r = do
FilePath -> Text -> IO ()
T.writeFile (TargetFiles -> FilePath
summaryFile TargetFiles
tf) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
Map Text Integer -> Text
memoryReport (ProfilingReport -> Map Text Integer
profilingMemory ProfilingReport
r)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ProfilingEvent] -> Text
tabulateEvents (ProfilingReport -> [ProfilingEvent]
profilingEvents ProfilingReport
r)
FilePath -> Text -> IO ()
T.writeFile (TargetFiles -> FilePath
timelineFile TargetFiles
tf) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
[ProfilingEvent] -> Text
timeline (ProfilingReport -> [ProfilingEvent]
profilingEvents ProfilingReport
r)
prepareDir :: FilePath -> IO FilePath
prepareDir :: FilePath -> IO FilePath
prepareDir FilePath
json_path = do
let top_dir :: FilePath
top_dir = FilePath -> FilePath
takeFileName FilePath
json_path FilePath -> FilePath -> FilePath
-<.> FilePath
"prof"
Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Writing results to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
top_dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
FilePath -> IO ()
removePathForcibly FilePath
top_dir
FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
top_dir
analyseProfilingReport :: FilePath -> ProfilingReport -> IO ()
analyseProfilingReport :: FilePath -> ProfilingReport -> IO ()
analyseProfilingReport FilePath
json_path ProfilingReport
r = do
FilePath
top_dir <- FilePath -> IO FilePath
prepareDir FilePath
json_path
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
top_dir
let tf :: TargetFiles
tf =
TargetFiles
{ summaryFile :: FilePath
summaryFile = FilePath
top_dir FilePath -> FilePath -> FilePath
</> FilePath
"summary",
timelineFile :: FilePath
timelineFile = FilePath
top_dir FilePath -> FilePath -> FilePath
</> FilePath
"timeline"
}
TargetFiles -> ProfilingReport -> IO ()
writeAnalysis TargetFiles
tf ProfilingReport
r
analyseBenchResults :: FilePath -> [BenchResult] -> IO ()
analyseBenchResults :: FilePath -> [BenchResult] -> IO ()
analyseBenchResults FilePath
json_path [BenchResult]
bench_results = do
FilePath
top_dir <- FilePath -> IO FilePath
prepareDir FilePath
json_path
Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Stripping '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' from program paths."
(BenchResult -> IO ()) -> [BenchResult] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> BenchResult -> IO ()
onBenchResult FilePath
top_dir) [BenchResult]
bench_results
where
prefix :: FilePath
prefix = [FilePath] -> FilePath
longestCommonPrefix ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (BenchResult -> FilePath) -> [BenchResult] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map BenchResult -> FilePath
benchResultProg [BenchResult]
bench_results
escape :: Char -> Char
escape Char
'/' = Char
'_'
escape Char
c = Char
c
problem :: Text -> Text -> Text -> IO ()
problem Text
prog_name Text
name Text
what =
Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
prog_name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" dataset " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
what
onBenchResult :: FilePath -> BenchResult -> IO ()
onBenchResult FilePath
top_dir (BenchResult FilePath
prog_path [DataResult]
data_results) = do
let (FilePath
prog_path', FilePath
entry) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') FilePath
prog_path
prog_name :: FilePath
prog_name = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
prefix) FilePath
prog_path'
prog_dir :: FilePath
prog_dir = FilePath
top_dir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
dropExtension FilePath
prog_name FilePath -> FilePath -> FilePath
</> Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
entry
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
prog_dir
(DataResult -> IO ()) -> [DataResult] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> Text -> DataResult -> IO ()
onDataResult FilePath
prog_dir (FilePath -> Text
T.pack FilePath
prog_name)) [DataResult]
data_results
onDataResult :: FilePath -> Text -> DataResult -> IO ()
onDataResult FilePath
_ Text
prog_name (DataResult Text
name (Left Text
_)) =
Text -> Text -> Text -> IO ()
problem Text
prog_name Text
name Text
"execution failed"
onDataResult FilePath
prog_dir Text
prog_name (DataResult Text
name (Right Result
res)) = do
let name' :: FilePath
name' = FilePath
prog_dir FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack ((Char -> Char) -> Text -> Text
T.map Char -> Char
escape Text
name)
case Result -> Maybe Text
stdErr Result
res of
Maybe Text
Nothing -> Text -> Text -> Text -> IO ()
problem Text
prog_name Text
name Text
"no log recorded"
Just Text
text -> FilePath -> Text -> IO ()
T.writeFile (FilePath
name' FilePath -> FilePath -> FilePath
<.> FilePath
".log") Text
text
case Result -> Maybe ProfilingReport
report Result
res of
Maybe ProfilingReport
Nothing -> Text -> Text -> Text -> IO ()
problem Text
prog_name Text
name Text
"no profiling information"
Just ProfilingReport
r ->
let tf :: TargetFiles
tf =
TargetFiles
{ summaryFile :: FilePath
summaryFile = FilePath
name' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".summary",
timelineFile :: FilePath
timelineFile = FilePath
name' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".timeline"
}
in TargetFiles -> ProfilingReport -> IO ()
writeAnalysis TargetFiles
tf ProfilingReport
r
readFileSafely :: FilePath -> IO (Either String BS.ByteString)
readFileSafely :: FilePath -> IO (Either FilePath ByteString)
readFileSafely FilePath
filepath =
(ByteString -> Either FilePath ByteString
forall a b. b -> Either a b
Right (ByteString -> Either FilePath ByteString)
-> IO ByteString -> IO (Either FilePath ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile FilePath
filepath) IO (Either FilePath ByteString)
-> (IOError -> IO (Either FilePath ByteString))
-> IO (Either FilePath ByteString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Either FilePath ByteString)
forall {f :: * -> *} {b}.
Applicative f =>
IOError -> f (Either FilePath b)
couldNotRead
where
couldNotRead :: IOError -> f (Either FilePath b)
couldNotRead IOError
e = Either FilePath b -> f (Either FilePath b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath b -> f (Either FilePath b))
-> Either FilePath b -> f (Either FilePath b)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath b
forall a b. a -> Either a b
Left (FilePath -> Either FilePath b) -> FilePath -> Either FilePath b
forall a b. (a -> b) -> a -> b
$ IOError -> FilePath
forall a. Show a => a -> FilePath
show (IOError
e :: IOError)
main :: String -> [String] -> IO ()
main :: FilePath -> [FilePath] -> IO ()
main = ()
-> [FunOptDescr ()]
-> FilePath
-> ([FilePath] -> () -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> FilePath
-> ([FilePath] -> cfg -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
mainWithOptions () [] FilePath
"<file>" [FilePath] -> () -> Maybe (IO ())
f
where
f :: [FilePath] -> () -> Maybe (IO ())
f [FilePath
json_path] () = IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ do
Either FilePath ByteString
s <- FilePath -> IO (Either FilePath ByteString)
readFileSafely FilePath
json_path
case Either FilePath ByteString
s of
Left FilePath
a -> do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
a
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
Right ByteString
s' ->
case ByteString -> Either FilePath [BenchResult]
decodeBenchResults ByteString
s' of
Left FilePath
_ ->
case ByteString -> Maybe ProfilingReport
decodeProfilingReport ByteString
s' of
Maybe ProfilingReport
Nothing -> do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Cannot recognise " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
json_path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" as benchmark results or a profiling report."
Just ProfilingReport
pr ->
FilePath -> ProfilingReport -> IO ()
analyseProfilingReport FilePath
json_path ProfilingReport
pr
Right [BenchResult]
br -> FilePath -> [BenchResult] -> IO ()
analyseBenchResults FilePath
json_path [BenchResult]
br
f [FilePath]
_ ()
_ = Maybe (IO ())
forall a. Maybe a
Nothing