03308d255a58a6d81932a0fc88045aec0937cc21
[gipeda.git] / src / ReportTypes.hs
1 {-# LANGUAGE DeriveGeneric, ViewPatterns, RecordWildCards, OverloadedStrings #-}
2
3 module ReportTypes where
4
5 import qualified Data.Map as M
6 import Data.Aeson
7 import Data.Aeson.Types
8 import GHC.Generics
9 import Text.Printf
10 import Data.List
11 import Data.Char
12
13 import Paths
14 import ReadResult
15 import qualified BenchmarkSettings as S
16
17 data ClientSettings = ClientSettings
18    { title :: String
19    , cgitLink :: String
20    , logLink :: String
21    }
22  deriving (Generic)
23 instance ToJSON ClientSettings
24
25 data GlobalReport = GlobalReport
26     { settings :: Maybe ClientSettings
27     , benchmarks :: Maybe (M.Map BenchName ())
28     , revisions :: Maybe (M.Map Hash RevReport)
29     , benchGroups :: Maybe [BenchGroup]
30     }
31
32 instance ToJSON GlobalReport where
33     toJSON (GlobalReport {..}) = object $
34         ( "settings"    .=? settings ) ++
35         ( "benchmarks"  .=? benchmarks ) ++
36         ( "revisions"   .=? revisions ) ++
37         ( "benchGroups" .=? benchGroups )
38       where
39         k .=? Just v  = [ k .= toJSON v ]
40         _ .=? Nothing = []
41
42
43 emptyGlobalReport :: GlobalReport
44 emptyGlobalReport = GlobalReport Nothing Nothing Nothing Nothing
45
46
47 data SummaryStats = SummaryStats
48     { totalCount :: Int
49     , improvementCount :: Int
50     , regressionCount :: Int
51     , summaryDesc :: String
52     }
53  deriving (Show, Generic)
54 instance ToJSON SummaryStats
55 instance FromJSON SummaryStats
56
57 {-
58 sumStats :: [SummaryStats] -> SummaryStats
59 sumStats = foldl' go (SummaryStats 0 0 0)
60   where go (SummaryStats a b c) (SummaryStats a' b' c') =
61             SummaryStats (a + a') (b + b') (c + c')
62 -}
63
64 data Summary = Summary
65     { hash :: Hash
66     , gitDate :: Integer
67     , gitSubject :: String
68     , stats :: SummaryStats
69     , parents :: [String]
70     }
71  deriving (Generic)
72 instance ToJSON Summary
73 instance FromJSON Summary
74
75
76 data RevReport = RevReport
77     { summary :: Summary
78     , gitLog :: String
79     , benchResults :: M.Map BenchName BenchResult
80     }
81  deriving (Generic)
82 instance ToJSON RevReport
83 instance FromJSON RevReport
84
85 data ChangeType = Improvement | Boring | Regression
86  deriving (Eq, Generic)
87 instance ToJSON ChangeType
88 instance FromJSON ChangeType
89
90 data BenchGroup = BenchGroup
91     { groupName :: String
92     , groupMembers :: [BenchName]
93     }
94  deriving (Generic)
95 instance ToJSON BenchGroup
96 instance FromJSON BenchGroup
97
98 data BenchResult = BenchResult
99     { name :: String
100     , value :: BenchValue
101     , previous :: Maybe BenchValue
102     , change :: String
103     , changeType :: ChangeType
104     , unit :: String
105     , important :: Bool
106     }
107  deriving (Generic)
108 instance ToJSON BenchResult where
109     toJSON = genericToJSON defaultOptions
110 instance FromJSON BenchResult where
111     parseJSON = genericParseJSON defaultOptions
112
113 -- A smaller BenchResult
114 data GraphPoint = GraphPoint
115     { gpValue :: BenchValue
116     , gpChangeType :: ChangeType
117     }
118  deriving (Generic)
119 instance ToJSON GraphPoint where
120     toJSON = genericToJSON (defaultOptions { fieldLabelModifier = fixup })
121 instance FromJSON GraphPoint where
122     parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = fixup })
123
124 fixup ('g':'p':c:cs) = toLower c : cs
125
126 benchResultToGraphPoint (BenchResult {..}) = GraphPoint
127     { gpValue = value
128     , gpChangeType = changeType
129     }
130
131 invertChangeType :: ChangeType -> ChangeType
132 invertChangeType Improvement = Regression
133 invertChangeType Boring = Boring
134 invertChangeType Regression = Improvement
135
136 type Explanation = (String, ChangeType)
137
138 noExplanation :: Explanation
139 noExplanation = ("", Boring)
140
141 equalExplanation :: Explanation
142 equalExplanation = ("=", Boring)
143
144 explainSmallInt :: S.BenchSettings -> Integer -> Integer -> Explanation
145 explainSmallInt _ i1 i2
146     | i2 == i1 = equalExplanation 
147     | i2 > i1 = ("+ " ++ show (i2 - i1), Improvement)
148     | i2 < i1 = ("- " ++ show (i1 - i2), Regression)
149
150 explainInt :: S.BenchSettings -> Integer -> Integer -> Explanation
151 explainInt s i1 i2 = explainFloat s (fromIntegral i1) (fromIntegral i2)
152
153 explainFloat :: S.BenchSettings -> Double -> Double -> Explanation
154 explainFloat _ 0 0 = equalExplanation
155 explainFloat _ 0 _ = ("+ ∞", Improvement)
156 explainFloat s f1 f2 = (change, typ)
157   where
158     change | abs perc < 0.01 = "="
159            | perc  >= 0 = printf "+ %.2f%%" perc
160            | perc  <  0 = printf "- %.2f%%" (-perc)
161     typ | abs perc < th = Boring
162         | perc  >= 0 = Improvement
163         | perc  <  0 = Regression
164
165     perc = 100 * ((f2 - f1) / f1)
166     th = S.threshold s
167
168 toFloat :: BenchValue -> Double
169 toFloat (I i) = fromIntegral i
170 toFloat (F f) = f
171
172 explain :: S.BenchSettings -> BenchValue -> BenchValue -> (String, ChangeType)
173 explain s@(S.numberType -> S.SmallIntegralNT) (I i1) (I i2) = explainSmallInt s i1 i2
174 explain s@(S.numberType -> S.IntegralNT)      (I i1) (I i2) = explainInt s i1 i2
175 -- Treat everything else as Floats, so that we do something sensible
176 -- even if the user did not set the numberType correctly:
177 explain s                                     v1     v2     = explainFloat s (toFloat v1) (toFloat v2)
178
179 toResult :: S.BenchSettings -> String -> BenchValue -> Maybe BenchValue -> BenchResult
180 toResult s name value prev = BenchResult
181     { name = name
182     , value = value
183     , previous = prev
184     , change = change
185     , changeType = changeType
186     , unit = S.unit s
187     , important = S.important s
188     }
189   where 
190     (change, changeType') =
191         case prev of
192             Just p -> explain s p value
193             Nothing -> noExplanation
194     changeType | S.smallerIsBetter s = invertChangeType changeType'
195                | otherwise           =                  changeType'
196
197 toSummaryStats :: [BenchResult] -> SummaryStats
198 toSummaryStats res = SummaryStats
199     { totalCount = length res
200     , improvementCount = length
201         [ ()
202         | BenchResult { changeType = Improvement, important = True } <- res
203         ]
204     , regressionCount =  length
205         [ ()
206         | BenchResult { changeType = Regression, important = True } <- res
207         ]
208     , summaryDesc = andMore 5
209         [ name r ++ ": " ++ change r
210         | r <- res, important r, changeType r `elem` [Improvement, Regression]
211         ]
212     }
213
214 andMore :: Int -> [String] -> String
215 andMore _ [] = "–"
216 andMore n xs = intercalate "\n" (take n xs) ++ rest
217   where rest | length xs > n = "\nand " ++ show (length xs - n) ++ " more"
218              | otherwise     = ""
219
220 {-
221 toGroup :: String -> [BenchResult] -> BenchGroup
222 toGroup n res = BenchGroup
223     { groupName = n
224     , benchResults = res
225     , groupStats = SummaryStats
226         { totalCount = length res
227         , improvementCount = length [ () | BenchResult { changeType = Improvement } <- res ]
228         , regressionCount =  length [ () | BenchResult { changeType = Regression } <- res ]
229         }
230     }
231 -}
232
233 createReport ::
234     S.Settings -> Hash -> [Hash] ->
235     ResultMap -> ResultMap ->
236     String -> String -> Integer ->
237     RevReport
238 createReport settings this parents thisM parentM log subject date = RevReport 
239     { summary = Summary
240         { hash = this
241         , parents = parents
242         , stats = toSummaryStats $ M.elems results
243         , gitSubject = subject
244         , gitDate = date
245         }
246     --, benchGroups = benchGroups
247     , benchResults = results
248     , gitLog = log
249     }
250   where
251     results = M.fromList
252         [ (name, toResult s name value (M.lookup name parentM))
253         | (name, value) <- M.toAscList thisM
254         , let s = S.benchSettings settings name
255         ]
256
257 summarize :: RevReport -> Summary
258 summarize (RevReport {..}) =  summary