Add database handling

Signed-off-by: Sascha Grunert <sgrunert@suse.com>
saschagrunert · Jun 25, 2019 · af344ed · af344ed
1 parent b7a3f9a
commit af344ed
Show file tree

Hide file tree

Showing 5 changed files with 32 additions and 42 deletions.
diff --git a/.gitignore b/.gitignore
@@ -1,6 +1,6 @@
 *.lock
 *.orig
-*.sqlite3*
+*.sqlite
 *.tar
 *.tix
 .ghc.environment.*

diff --git a/nix/default.nix b/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
+, 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 split text time
   ];
   libraryToolDepends = [ hpack ];
   executableHaskellDepends = [

diff --git a/package.yaml b/package.yaml
@@ -20,7 +20,7 @@ flags:
     manual: false
 
 ghc-options:
-  - -Werror
+  # - -Werror
   - -Weverything
   - -Wno-all-missed-specialisations
   - -Wno-implicit-prelude
@@ -64,7 +64,6 @@ library:
     - persistent-sqlite
     - persistent-template
     - split
-    - temporary
     - text
     - time
   when:

diff --git a/performabot.cabal b/performabot.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 78812b67fb634b70ac93b92d47f01a0f4fbabb2234f2c82f01904e75ad697fe1
+-- hash: 5bc1b7c93029733bfd7b7905a2f5826cfbbc08e093a866b1dc09710e0fc3029c
 
 name:           performabot
 version:        0.1.0
@@ -41,7 +41,7 @@ library
   hs-source-dirs:
       src
   default-extensions: GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies
-  ghc-options: -Werror -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-unsafe
+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-unsafe
   build-depends:
       aeson
     , ansi-terminal
@@ -53,7 +53,6 @@ library
     , persistent-sqlite
     , persistent-template
     , split
-    , temporary
     , text
     , time
   if flag(static)
@@ -68,7 +67,7 @@ executable performabot
   hs-source-dirs:
       app
   default-extensions: GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies
-  ghc-options: -Werror -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-unsafe -rtsopts -threaded -with-rtsopts=-N
+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-unsafe -rtsopts -threaded -with-rtsopts=-N
   build-depends:
       base
     , hslogger
@@ -88,7 +87,7 @@ test-suite performabot-test
   hs-source-dirs:
       test
   default-extensions: GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies
-  ghc-options: -Werror -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-unsafe -rtsopts -threaded -with-rtsopts=-N
+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-unsafe -rtsopts -threaded -with-rtsopts=-N
   build-depends:
       aeson
     , base

diff --git a/src/Result.hs b/src/Result.hs
@@ -3,25 +3,26 @@
 -- @since 0.1.0
 module Result ( 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                   ( Benchmark, 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 )
+import           Text.Printf             ( printf )
 
 -- | The result of the complete run
 type Result = [Benchmark]
@@ -65,29 +66,20 @@ debugStep (_, r) = debugResult r
 debugResult :: Result -> 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"