Add database handling (#27)

.gitignore

@@ -1,6 +1,6 @@
 *.lock
 *.orig
-*.sqlite3*
+*.sqlite
 *.tar
 *.tix
 .ghc.environment.*

app/Main.hs

@@ -66,16 +66,15 @@ arguments :: Parser Args
 arguments = Args <$> environment <*> verbosity <*> devel
 
 environment :: Parser Environment
-environment = Environment
-    <$> strOption (long "repo-slug" <> short 'r'
-                   <> envHelp "GitHub repository slug (owner/repo)"
-                              repoSlugEnvVars <> metavar "REPOSLUG" <> value "")
-    <*> strOption (long "commit" <> short 'c'
-                   <> envHelp "Commit hash" commitEnvVars <> metavar "COMMIT"
-                   <> value "")
+environment = Environment <$> strOption (long "commit" <> short 'c'
+                                         <> envHelp "Commit hash" commitEnvVars
+                                         <> metavar "COMMIT" <> value "")
     <*> strOption (long "pull-request" <> short 'p'
                    <> envHelp "Pull request number" pullRequestEnvVars
                    <> metavar "PULL_REQUEST" <> value "")
+    <*> strOption (long "repo-slug" <> short 'r'
+                   <> envHelp "GitHub repository slug (owner/repo)"
+                              repoSlugEnvVars <> metavar "REPOSLUG" <> value "")
     <*> strOption (long "token" <> short 't' <> envHelp "Token" tokenEnvVars
                    <> metavar "TOKEN" <> value "") <**> helper
   where

nix/default.nix

@@ -1,7 +1,7 @@
 { mkDerivation, aeson, ansi-terminal, base, hpack, hslogger, lens
 , megaparsec, optparse-applicative, persistent, persistent-sqlite
-, persistent-template, split, stdenv, tasty, tasty-hspec
-, tasty-quickcheck, temporary, text, time
+, persistent-template, regex-compat, split, stdenv, tasty
+, tasty-hspec, tasty-quickcheck, text, time
 }:
 mkDerivation {
   pname = "performabot";
@@ -11,7 +11,7 @@ mkDerivation {
   isExecutable = true;
   libraryHaskellDepends = [
     aeson ansi-terminal base hslogger lens megaparsec persistent
-    persistent-sqlite persistent-template split temporary text time
+    persistent-sqlite persistent-template regex-compat split text time
   ];
   libraryToolDepends = [ hpack ];
   executableHaskellDepends = [

package.yaml

@@ -63,8 +63,8 @@ library:
     - persistent
     - persistent-sqlite
     - persistent-template
+    - regex-compat
     - split
-    - temporary
     - text
     - time
   when:

performabot.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 78812b67fb634b70ac93b92d47f01a0f4fbabb2234f2c82f01904e75ad697fe1
+-- hash: 7b4271c5f25eb1fc060842b0673460b631c6ed5e1ea28a244b5546a597ae7d70
 
 name:           performabot
 version:        0.1.0
@@ -52,8 +52,8 @@ library
     , persistent
     , persistent-sqlite
     , persistent-template
+    , regex-compat
     , split
-    , temporary
     , text
     , time
   if flag(static)

src/Model.hs

@@ -3,8 +3,8 @@
 -- @since 0.1.0
 module Model
     ( Benchmark(Benchmark)
+    , Benchmarks
     , BenchmarkId
-    , Entry
     , Test(Test)
     , TestId
     , benchmarkAverage
@@ -36,7 +36,8 @@ share [ mkPersist sqlSettings { mpsGenerateLenses = True }
       ]
       $(persistFileWith lowerCaseSettings "src/model")
 
-type Entry = (Test, [Benchmark])
+-- | Multiple Benchmarks
+type Benchmarks = [Benchmark]
 
 -- | Drop the "_benchmark" from the Benchmark
 deriveJSON defaultOptions { fieldLabelModifier = drop 10 } ''Benchmark

src/ParserGo.hs

@@ -13,25 +13,33 @@ import           Model
 import           Parser               ( Parser, State(Ok, Failure, NeedMore)
                                       , StringParser, double, integer )
 
-import           Text.Megaparsec
-                 ( Token, eof, errorBundlePretty, many, runParser )
-import           Text.Megaparsec.Char
-                 ( alphaNumChar, char, space1, spaceChar, string )
+import           Text.Megaparsec      ( Token, anySingle, eof, errorBundlePretty
+                                      , manyTill, runParser )
+import           Text.Megaparsec.Char ( char, space1, spaceChar, string )
+import           Text.Regex           ( mkRegex, subRegex )
 
 -- | Parses golang (`ginkgo --succinct`) benchmarks based on the given input
 -- state, for example:
 --   123 samples:
---     pullTime - Fastest Time: 0.944s, Average Time: 0.953s ± 0.008s, Slowest Time: 0.971s
+--     bench1 - Fastest Time: 0.944s, Average Time: 0.953s ± 0.008s, Slowest Time: 0.971s
+--     bench2 - Fastest Time: 0.944s, Average Time: 0.953s ± 0.008s, Slowest Time: 0.971s
 parse :: State -> String -> State
 parse (NeedMore b) i = runStep (step1 b) i
+parse (Ok b) i = runStep (step1 b) i
 parse _ i = runStep (step0 emptyBenchmark) i
 
 -- | Run a single step abstraction
 runStep :: Parser -> String -> State
-runStep a i = case runParser a "" i of
+runStep a i = case runParser a "" (ansiFilter i) of
     Left e -> Failure $ errorBundlePretty e
     Right r -> r
 
+-- | Strip all colors from the string
+ansiFilter :: String -> String
+ansiFilter line = subRegex (mkRegex "\\[[0-9]+m") stripped ""
+  where
+    stripped = filter (/= '\ESC') line
+
 -- | The initial parse step
 step0 :: Benchmark -> Parser
 step0 b = do
@@ -44,8 +52,7 @@ step0 b = do
 step1 :: Benchmark -> Parser
 step1 b = do
     space1
-    n <- many alphaNumChar
-    _ <- spaceChar <* char '-' <* spaceChar
+    n <- manyTill anySingle $ string " - "
     _ <- string "Fastest" <* spaceChar <* string "Time" <* colon
     _ <- spaceChar <* double <* s <* char ',' <* spaceChar
     _ <- string "Average" <* spaceChar <* string "Time" <* colon <* spaceChar

src/Result.hs

@@ -1,33 +1,31 @@
 -- | Result and state handling
 --
 -- @since 0.1.0
-module Result ( Result, amount, initParserStep, parseStepIO, save ) where
+module Result ( amount, initParserStep, parseStepIO, save ) where
 
-import           Control.Lens    ( (^.) )
+import           Control.Lens            ( (^.) )
 
-import           Data.Aeson      ( encodeFile )
-import           Data.Text       ( pack )
-import           Data.Time.Clock ( getCurrentTime )
+import           Data.Text               ( Text, pack )
+import           Data.Time.Clock         ( getCurrentTime )
 
-import           Environment     ( Environment, commit, pullRequest, repoSlug )
+import           Database.Persist        ( insert )
+import           Database.Persist.Sqlite ( runMigration, runSqlite )
 
-import           Log             ( debug, notice, noticeR )
+import           Environment
+                 ( Environment, commit, pullRequest, repoSlug )
 
-import           Model           ( Benchmark, Test(Test) )
+import           Log                     ( debug, noticeR )
 
-import           Parser          ( State(Failure, Init, Ok) )
+import           Model                   ( Benchmarks, Test(Test), migrateAll )
 
-import qualified ParserGo        as Go ( parse )
+import           Parser                  ( State(Failure, Init, Ok) )
 
-import           System.IO.Temp  ( emptySystemTempFile )
+import qualified ParserGo                as Go ( parse )
 
-import           Text.Printf     ( printf )
-
--- | The result of the complete run
-type Result = [Benchmark]
+import           Text.Printf             ( printf )
 
 -- | A single parser step consists of an intermediate state and result
-type Step = (State, Result)
+type Step = (State, Benchmarks)
 
 -- | Initial parser step for convenience
 initParserStep :: Step
@@ -46,7 +44,7 @@ parseStep :: Step -> String -> Step
 parseStep (s, r) i = let ns = Go.parse s i in (ns, appendBenchmark ns r)
 
 -- | Append the succeeding result if possible
-appendBenchmark :: State -> Result -> Result
+appendBenchmark :: State -> Benchmarks -> Benchmarks
 appendBenchmark (Ok b) r = r ++ pure b
 appendBenchmark _ r = r
 
@@ -62,32 +60,23 @@ debugStep (Failure f, r) = do
 debugStep (_, r) = debugResult r
 
 -- | Print a debug message for the current result
-debugResult :: Result -> IO ()
+debugResult :: Benchmarks -> IO ()
 debugResult r = debug . printf "Current result: %s" $ show r
 
--- | Store the current result on disk
-toDisk :: (Test, Result) -> IO FilePath
-toDisk b = do
-    f <- emptySystemTempFile "result-.json"
-    debug $ printf "Writing to temp file: %s" f
-    encodeFile f b
-    return f
-
 -- | Sen the provided data to the given url including the environment
 save :: Step -> Environment -> IO ()
-save (_, r) e = do
+save (_, b) e = do
     t <- getCurrentTime
-    let d = ( Test t
-                   (pack $ e ^. commit)
-                   (pack $ e ^. repoSlug)
-                   (pack $ e ^. pullRequest)
-                   []
-            , r
-            )
-    p <- toDisk d
-    logFilePath p
+    _ <- runSqlite db $ do
+        runMigration migrateAll
+        bids <- mapM insert b
+        insert $ Test t
+                      (pack $ e ^. commit)
+                      (pack $ e ^. repoSlug)
+                      (pack $ e ^. pullRequest)
+                      bids
     return ()
 
--- | Log the file path convenience function
-logFilePath :: FilePath -> IO ()
-logFilePath p = notice $ printf "You can retry by using the file %s" p
+-- | The database name
+db :: Text
+db = "performabot.sqlite"