File: Noninteractive.hs

package info (click to toggle)
bustle 0.7.4-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 720 kB
  • sloc: haskell: 3,938; ansic: 939; makefile: 110; sh: 8
file content (86 lines) | stat: -rw-r--r-- 2,833 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
{-
Bustle.Noninteractive: driver for ASCII-art statistics generation
Copyright © 2008–2012 Collabora Ltd.

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
-}
module Bustle.Noninteractive
  ( runCount
  , runTime
  , runDot
  )
where

import Prelude hiding (log)

import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import Data.Maybe (mapMaybe)
import Data.List (nub)
import Control.Monad.Except
import Text.Printf

import Bustle.Loader
import Bustle.Translation (__)
import Bustle.Types
import Bustle.Stats

warn :: String -> IO ()
warn = hPutStrLn stderr

process :: FilePath -> (Log -> [a]) -> (a -> String) -> IO ()
process filepath analyze format = do
    ret <- runExceptT $ readLog filepath
    case ret of
        Left (LoadError _ err) -> do
            warn $ printf (__ "Couldn't parse '%s': %s") filepath err
            exitFailure
        Right (warnings, log) -> do
            mapM_ warn warnings
            mapM_ (putStrLn . format) $ analyze log

formatInterface :: Maybe InterfaceName -> String
formatInterface = maybe (__ "(no interface)") formatInterfaceName

runCount :: FilePath -> IO ()
runCount filepath = process filepath frequencies format
  where
    format :: FrequencyInfo -> String
    format (FrequencyInfo c t i m) =
        printf " %4d %6s %s.%s" c (typeName t) (formatInterface i) (formatMemberName m)

    typeName TallyMethod = "method"
    typeName TallySignal = "signal"

runTime :: FilePath -> IO ()
runTime filepath = process filepath methodTimes format
  where
    format :: TimeInfo -> String
    format (TimeInfo interface method total ncalls mean) =
        printf " %9.4f %3d %9.4f %s.%s" total ncalls mean
           (formatInterface interface) (formatMemberName method)

runDot :: FilePath -> IO ()
runDot filepath = process filepath makeDigraph id
  where
    makeDigraph log = ["digraph bustle {"] ++ makeDigraph' log ++ ["}"]

    makeDigraph' log =
        [ concat ["  \"", unBusName s, "\" -> \"", unBusName d, "\";"]
        | (s, d) <- nub . mapMaybe (methodCall . deEvent) $ log
        ]

    methodCall (MessageEvent MethodCall {sender = s, destination = d}) = Just (s, d)
    methodCall _ = Nothing