hsbencher-codespeed (empty) → 0.1

raw patch · 4 files changed

+312/−0 lines, 4 filesdep +HTTPdep +basedep +bytestringsetup-changed

Dependencies added: HTTP, base, bytestring, containers, data-default, directory, filepath, hsbencher, http-conduit, http-types, json, mtl, network, resourcet, time

Files

• HSBencher/Backend/Codespeed.hs +246/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• hsbencher-codespeed.cabal +34/−0

@@ -0,0 +1,246 @@+{-# LANGUAGE NamedFieldPuns, RecordWildCards, ScopedTypeVariables, CPP, BangPatterns #-}+{-# LANGUAGE TupleSections, DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}++-- | CodeSpeed website upload of benchmark data.+-- +--   This module must be used in conjunction with the main "hsbencher" package,+--   e.g. "import HSBencher", and then "import HSBencher.Backend.CodeSpeed" and +--   add the plugin ++module HSBencher.Backend.Codespeed+       ( -- * The plugin itself, what you probably want +         defaultCodespeedPlugin++         -- * Details and configuration options.+       , CodespeedConfig(..)+       -- , stdRetry, getTableId+       -- , fusionSchema, resultToTuple+       -- , uploadBenchResult+       , CodespeedPlug(), CodespeedCmdLnFlag(..),+       )+       where++import Control.Monad.Reader+import Control.Concurrent (threadDelay)+import qualified Control.Exception as E+import Data.Maybe (isJust, fromJust, catMaybes, fromMaybe)+import Data.Dynamic+import Data.Default (Default(..))+import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.List as L+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Char8 as BS+import Data.Time.Clock+import Data.Time.Calendar+import Data.Time.Format ()++import Network.HTTP.Types (renderQuery, urlEncode, urlDecode)+import Network.HTTP (simpleHTTP, postRequestWithBody)++import Control.Monad.Trans.Resource (runResourceT)+import Text.JSON -- (encodeStrict, toJSObject)++import HSBencher.Types+import HSBencher.Internal.Logging (log)+import Prelude hiding (log)+import System.IO (hPutStrLn, stderr)+import System.IO.Unsafe (unsafePerformIO)+import System.Console.GetOpt (getOpt, ArgOrder(Permute), OptDescr(Option), ArgDescr(..), usageInfo)+import System.Directory (doesFileExist, doesDirectoryExist, getAppUserDataDirectory,+                         createDirectory, renameFile, removeFile)+import System.FilePath ((</>),(<.>), splitExtension)+import System.IO.Unsafe (unsafePerformIO)+import System.Environment (getEnvironment)+import System.Exit+import Control.Concurrent.MVar+--------------------------------------------------------------------------------+++-- | A default plugin.  This binding provides future-proof way to get+--   a default instance of the plugin, in the eventuality that more+--   configuration options are added in the future.+defaultCodespeedPlugin :: CodespeedPlug+defaultCodespeedPlugin = CodespeedPlug++-- | This is the same as defaultCodespeedPlugin+instance Default CodespeedPlug where +  def = defaultCodespeedPlugin++-- TODO: may need to grab stdRetry / retryIORequest from the Fusion plugin..++-- | Configuration options for Codespeed uploading.+data CodespeedConfig = +  CodespeedConfig { codespeedURL :: URL+                  , projName     :: String }+  deriving (Show,Read,Ord,Eq, Typeable)++-- | Note, the default config may not be complete and thus may have+--   some required fields to fill in, or errors will ensue.+instance Default CodespeedConfig where +  def = CodespeedConfig +    { codespeedURL  = error "incomplete CodespeedConfig: Must set Codespeed URL (--codespeed) to use this plugin!"+    , projName      = error "incomplete CodespeedConfig: Must set Codespeed --projname to use this plugin!"+    }++-- | Parsed command line options provided by the user that initiaties benchmarking.+data CodespeedCmdLnFlag = CodespeedURL URL+                        | CodespeedProjName String+ -- TODO: Authentication!+ deriving (Show,Read,Ord,Eq, Typeable)++type URL = String+++getDateTime :: IO String+getDateTime = do +  utc <- getCurrentTime+  return $ show utc+++-- | Push the results from a single benchmark to the server.+uploadBenchResult :: BenchmarkResult -> BenchM ()+uploadBenchResult br = do +  lift$ putStrLn " [codespeed] Begin upload of one benchmark result."+  conf <- ask+  -- Look up our configuration dynamically based the plugin type:+  let codespeedConfig = getMyConf CodespeedPlug conf++  -- lift$ putStrLn$ " [codespeed] Running with config: \n"++show conf+  lift$ putStrLn$ " [codespeed] Running with plugin config: \n"++show codespeedConfig++  let CodespeedConfig {codespeedURL} = codespeedConfig+      contentType = "application/x-www-form-urlencoded"+--      contentType = "application/json"+      addURL = (codespeedURL ++ "/result/add/json/")++-- Version that uses HTTP pkg:+  let json = renderJSONResult codespeedConfig br+      bod = urlEncode False $ BS.pack json+  let req = postRequestWithBody addURL contentType $ BS.unpack bod+  lift$ putStrLn$ " [codespeed] Uploading json: "++ json+  lift$ putStrLn$ " [codespeed] URl-encoded json POST body: "++ BS.unpack bod+  lift$ putStrLn$ " [codespeed] Submitting HTTP Post request: \n"++show req+  resp <- lift$ simpleHTTP req+  case resp of +    Left err -> lift$ putStrLn$ " [codespeed] ERROR uploading: \n"++show err+    Right x  -> lift$ putStrLn$ " [codespeed] Got response from server:\n"++show x+  return ()+++renderJSONResult :: CodespeedConfig -> BenchmarkResult -> String+renderJSONResult CodespeedConfig{projName} benchRes = +   -- _PROGNAME _VARIANT _ARGS _HOSTNAME _RUNID _CI_BUILD_ID _THREADS+   -- _DATETIME _MINTIME _MEDIANTIME _MAXTIME _MINTIME_PRODUCTIVITY+   -- _MEDIANTIME_PRODUCTIVITY _MAXTIME_PRODUCTIVITY _ALLTIMES _TRIALS+   -- _COMPILER _COMPILE_FLAGS _RUNTIME_FLAGS _ENV_VARS _BENCH_VERSION+   -- _BENCH_FILE _UNAME _PROCESSOR _TOPOLOGY _GIT_BRANCH _GIT_HASH+   -- _GIT_DEPTH _WHO _ETC_ISSUE _LSPCI _FULL_LOG _MEDIANTIME_ALLOCRATE+   -- _MEDIANTIME_MEMFOOTPRINT _ALLJITTIMES _CUSTOM+  simpleFormat+  [ +    -- A working example:+       --     ("project",     S "MyProject2")+       --   , ("executable",  S "myexe 04 32bits")+       --   , ("benchmark",   S "float")+       --   , ("commitid",    S "8")+       --   , ("environment", S "cutter")+       --   , ("result_value", D 2500.1)+       --   , ("branch",      S "default")++     ("project",     S projName)+   , ("executable",  S exec)+   , ("benchmark",   S bench)+   , ("commitid",    S _GIT_HASH)+   -- , ("environment", S "129-79-241-98") -- Results in 400 / BAD REQUEST+   -- , ("environment", S "1297924198") -- Results in 400 / BAD REQUEST+   -- Apparently this is the error on the server:+     -- Exception Value:	+     -- Expecting ',' delimiter: line 1 column 235 (char 234)+     -- Exception Location: /opt/python/2.7.8/lib/python2.7/json/decoder.py in raw_decode, line 382+   -- , ("environment", S "hello1297924198") -- Results in 400 / BAD REQUEST+   -- , ("environment", S "hello") -- Also 400 / BAD REQUEST +         -- Seems to fail if the environment is not REGISTERED already+         -- on the website.  Does not create on demand?+   , ("environment",  S _HOSTNAME) +   , ("result_value", D _MEDIANTIME)+   , ("branch",       S _GIT_BRANCH)+   -- Plus add optional fields:+--   , ("revision_date", s "")  -- Optional. Default is taken either+--                            -- from VCS integration or from current date+--   , ("result_date", s "")    -- Optional, default is current date+--   , ("std_dev", showJSON (1.11111 :: Double))  -- Optional. Default is blank+   , ("max", D _MAXTIME)  -- Optional. Default is blank+   , ("min", D _MINTIME)  -- Optional. Default is blank    +   -- RRN: Question: are max and min the *observed* max and min presumably?+   ]+ where +  -- Populate the CodeSpeed fields using the HSBencher fields:+  BenchmarkResult{..} = benchRes+  exec  = combine $ [_VARIANT] ++ if _THREADS==0 then [] +                                  else [show _THREADS ++ "T"]+  bench = combine [_PROGNAME, unwords _ARGS]++-- | This is a hacky way to pack multiple fields into one field of the+-- destination schema.  There is a tradeoff here between readability+-- and ease of dissection.+combine :: [String] -> String+combine fields = +  let fields' = filter (not . null) fields in+  L.concat (L.intersperse "|" fields')++data RHS = S String | D Double++-- | The Django-based codespeed server is a bit finicky in exactly+-- what JSON formattincg and URL encodings it accepts.  Thus, rather+-- than using any of the existing frameworks, we just use a particular+-- format we know works.+simpleFormat :: [(String,RHS)] -> String+simpleFormat prs = "json=[{" ++ bod ++"}]"+ where+  bod = L.concat $ L.intersperse ", " $ L.map fn prs+  fn (l,r) = show l ++ ": " ++ rhs r+  rhs (S s) = show s+  rhs (D d) = show d++++-- | The type of Codespeed table plugins.  Currently this is a singleton type; there is+-- really only one Codespeed plugin.+data CodespeedPlug = CodespeedPlug+  deriving (Eq,Show,Ord,Read)++instance Plugin CodespeedPlug where+  -- These configs are stored in a dynamically typed list within the global BenchM config:+  type PlugConf CodespeedPlug = CodespeedConfig+  type PlugFlag CodespeedPlug = CodespeedCmdLnFlag++  -- | Better be globally unique!  Careful.+  plugName _    = "codespeed"+  plugCmdOpts _ = codespeed_cli_options+  plugUploadRow p cfg row = runReaderT (uploadBenchResult row) cfg+  plugInitialize p gconf = do+   putStrLn " [codespeed] Codespeed table plugin initializing.. (which is a NOOP)"+   return gconf++  foldFlags p flgs cnf0 = +      foldr ($) cnf0 (map doFlag flgs)+    where      +      doFlag (CodespeedURL url)     r = r { codespeedURL = url} +      doFlag (CodespeedProjName nm) r = r { projName = nm }++theEnv :: [(String,String)] +theEnv = unsafePerformIO getEnvironment++-- | All the command line options understood by this plugin.+codespeed_cli_options :: (String, [OptDescr CodespeedCmdLnFlag])+codespeed_cli_options =+  ("Codespeed Table Options:",+      [ Option [] ["codespeed"] (ReqArg CodespeedURL "URL")+        "specify the root URL of the Codespeed installation"+      , Option [] ["projname"] (ReqArg CodespeedProjName "NAME")+        "specify which Codespeed Project receives the uploaded results"+      ])+

@@ -0,0 +1,30 @@+Copyright (c) 2013, Ryan Newton++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ryan Newton nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,34 @@++name:                hsbencher-codespeed+version:             0.1+synopsis:            Backend for uploading benchmark data to CodeSpeed+description:         The CodeSpeed project provides a performance dashboard and+                     is described at 'https://github.com/tobami/codespeed'.+license:             BSD3+license-file:        LICENSE+author:              Ryan Newton+maintainer:          rrnewton@gmail.com+-- copyright:           +-- category:            +build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.18++library+  exposed-modules:     HSBencher.Backend.Codespeed+  build-depends:  base >=4.5 && < 4.8, +                  containers >=0.5, bytestring >=0.10,+                  time >=1.4, directory >=1.2, filepath >=1.3,+                  mtl,+-- TODO: need to come forward to modern http-conduit:+--                  http-conduit >=2.0 && <2.1, +                  http-conduit >= 1.9.0,+                  HTTP         >= 4000.2.18,+                  http-types   >= 0.8,+                  resourcet    >= 0.4,+                  json         >= 0.7,+                  network      == 2.5.0.0,+                  data-default >= 0.5.3,+                  hsbencher    >= 1.11 && < 2.0+  default-language:    Haskell2010+