Separate environment (#26)

app/Main.hs

@@ -8,17 +8,14 @@ import           Control.Monad       ( foldM )
 
 import           Data.List           ( intercalate )
 
-import           Env
-                 ( commitEnvVars, fillEnvironment, pullRequestEnvVars
+import           Environment
+                 ( Environment(Environment), commit, commitEnvVars
+                 , fillEnvironment, pullRequest, pullRequestEnvVars, repoSlug
                  , repoSlugEnvVars, tokenEnvVars )
 
 import           Log                 as L ( info )
 import           Log                 ( initLogger, notice, warn )
 
-import           Model
-                 ( Environment(Environment), environmentCommit
-                 , environmentPullRequest, environmentRepoSlug )
-
 import           Options.Applicative as O ( info )
 import           Options.Applicative
                  ( (<**>), Parser, ParserInfo
@@ -29,7 +26,7 @@ import           Options.Applicative
                  , helper, infoOption, internal, long, many, metavar, short
                  , short, strOption, switch, value )
 
-import           ParserResult
+import           Result
                  ( amount, initParserStep, parseStepIO, save )
 
 import           System.Exit         ( exitFailure )
@@ -116,9 +113,9 @@ run (Args e v d) = do
 
     -- Prepare environment
     env <- fillEnvironment e d
-    L.info . printf "Using commit: %s" $ env ^. environmentCommit
-    L.info . printf "Using pull request: %s" $ env ^. environmentPullRequest
-    L.info . printf "Using repository slug: %s" $ env ^. environmentRepoSlug
+    L.info . printf "Using commit: %s" $ env ^. commit
+    L.info . printf "Using pull request: %s" $ env ^. pullRequest
+    L.info . printf "Using repository slug: %s" $ env ^. repoSlug
 
     -- Parse loop
     notice "Processing input from stdin..."

nix/default.nix

@@ -1,6 +1,5 @@
-{ mkDerivation, aeson, ansi-terminal, base, bytestring, directory
-, hpack, hslogger, http-conduit, lens, megaparsec
-, optparse-applicative, persistent, persistent-sqlite
+{ 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
 }:
@@ -11,9 +10,8 @@ mkDerivation {
   isLibrary = true;
   isExecutable = true;
   libraryHaskellDepends = [
-    aeson ansi-terminal base bytestring directory hslogger http-conduit
-    lens megaparsec persistent persistent-sqlite persistent-template
-    split temporary text time
+    aeson ansi-terminal base hslogger lens megaparsec persistent
+    persistent-sqlite persistent-template split temporary text time
   ];
   libraryToolDepends = [ hpack ];
   executableHaskellDepends = [

package.yaml

@@ -20,7 +20,7 @@ flags:
     manual: false
 
 ghc-options:
-  # - -Werror
+  - -Werror
   - -Weverything
   - -Wno-all-missed-specialisations
   - -Wno-implicit-prelude
@@ -57,10 +57,7 @@ library:
   dependencies:
     - aeson
     - ansi-terminal
-    - bytestring
-    - directory
     - hslogger
-    - http-conduit
     - lens
     - megaparsec
     - persistent

performabot.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 6dd0c8bb11e5e152228978bd9c385e7a0c7d3f0c96a4d034f60166c3e020325a
+-- hash: 78812b67fb634b70ac93b92d47f01a0f4fbabb2234f2c82f01904e75ad697fe1
 
 name:           performabot
 version:        0.1.0
@@ -30,26 +30,23 @@ flag static
 
 library
   exposed-modules:
-      Env
+      Environment
       Log
       Model
       Parser
       ParserGo
-      ParserResult
+      Result
   other-modules:
       Paths_performabot
   hs-source-dirs:
       src
   default-extensions: GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies
-  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-unsafe
+  ghc-options: -Werror -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
     , base
-    , bytestring
-    , directory
     , hslogger
-    , http-conduit
     , lens
     , megaparsec
     , persistent
@@ -71,7 +68,7 @@ executable performabot
   hs-source-dirs:
       app
   default-extensions: GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies
-  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
+  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
   build-depends:
       base
     , hslogger
@@ -91,7 +88,7 @@ test-suite performabot-test
   hs-source-dirs:
       test
   default-extensions: GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies
-  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
+  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
   build-depends:
       aeson
     , base

src/Env.hs → src/Environment.hs

@@ -1,45 +1,56 @@
 -- | System environment handling
 --
 -- @since 0.1.0
-module Env
-    ( commitEnvVars
+module Environment
+    ( Environment(Environment)
+    , commit
+    , commitEnvVars
     , fillEnvironment
+    , pullRequest
     , pullRequestEnvVars
+    , repoSlug
     , repoSlugEnvVars
     , tokenEnvVars
     ) where
 
-import           Control.Lens       ( (.~), (^.) )
+import           Control.Lens       ( (.~), (^.), makeLenses )
 import           Control.Monad      ( mapM, msum )
 
+import           Data.Aeson.TH
+                 ( defaultOptions, deriveJSON, fieldLabelModifier )
 import           Data.List          ( intercalate )
 import           Data.List.Split    ( splitOn )
-import           Data.Text          ( Text, pack )
-import qualified Data.Text          as T ( null )
 
 import           Log                ( err )
 
-import           Model
-                 ( Environment, environmentCommit, environmentPullRequest
-                 , environmentRepoSlug, environmentToken )
-
 import           System.Environment ( lookupEnv )
 import           System.Exit        ( exitFailure )
 
 import           Text.Printf        ( printf )
 
+data Environment = Environment { _commit      :: String
+                               , _pullRequest :: String
+                               , _repoSlug    :: String
+                               , _token       :: String
+                               }
+    deriving Show
+
+$(makeLenses ''Environment)
+
+deriveJSON defaultOptions { fieldLabelModifier = drop 1 } ''Environment
+
 fillEnvironment :: Environment -> Bool -> IO Environment
 fillEnvironment e d = do
-    c <- getEnv (e ^. environmentCommit) "commit" commitEnvVars
-    p <- getEnv (e ^. environmentPullRequest) "pull request" pullRequestEnvVars
-    r <- getEnv (e ^. environmentRepoSlug) "repo slug" repoSlugEnvVars
-    t <- getEnv (e ^. environmentToken) "token" tokenEnvVars
+    c <- getEnv (e ^. commit) "commit" commitEnvVars
+    p <- getEnv (e ^. pullRequest) "pull request" pullRequestEnvVars
+    r <- getEnv (e ^. repoSlug) "repo slug" repoSlugEnvVars
+    t <- getEnv (e ^. token) "token" tokenEnvVars
 
     -- Validate the other environment variables
-    if not d && any T.null [ r, c, p, t ]
+    if not d && any null [ c, p, r, t ]
         then exitFailure
-        else return $ environmentToken .~ t $ environmentPullRequest .~ p $
-            environmentCommit .~ c $ environmentRepoSlug .~ r $ e
+        else return $ token .~ t $ pullRequest .~ p $ commit .~ c $
+            repoSlug .~ r $ e
 
 -- | The prefix for local env vars
 prefix :: String -> String
@@ -72,11 +83,11 @@ pullRequestEnvVars =
     [ prefix "PULL_REQUEST", "CIRCLE_PR_NUMBER", "TRAVIS_PULL_REQUEST" ]
 
 -- | Generic environment variable retrieval
-getEnv :: Text -> String -> [String] -> IO Text
+getEnv :: String -> String -> [String] -> IO String
 getEnv "" t v = do
     e <- mapM lookupSplitEnv v
     case msum e of
-        Just b -> return $ pack b
+        Just b -> return b
         _ -> do
             err $ printf ("No %s found via the $%s environment "
                           ++ "variable%s or the command line")

src/Model.hs

@@ -5,8 +5,6 @@ module Model
     ( Benchmark(Benchmark)
     , BenchmarkId
     , Entry
-    , Environment(Environment)
-    , EnvironmentId
     , Test(Test)
     , TestId
     , benchmarkAverage
@@ -15,61 +13,37 @@ module Model
     , benchmarkSamples
     , benchmarkUnit
     , emptyBenchmark
-    , environmentCommit
-    , environmentPullRequest
-    , environmentRepoSlug
-    , environmentToken
     , migrateAll
     , testBenchmarks
-    , testEnvironment
+    , testCommit
+    , testPullRequest
+    , testRepoSlug
     , testTime
     ) where
 
 import           Data.Aeson.TH
                  ( defaultOptions, deriveJSON, fieldLabelModifier )
-import           Data.Text           ( Text )
-import           Data.Time           ( UTCTime )
+import           Data.Text              ( Text )
+import           Data.Time              ( UTCTime )
 
-import           Database.Persist.TH ( mkMigrate, mkPersist, mpsGenerateLenses
-                                     , persistLowerCase, share, sqlSettings )
+import           Database.Persist.Quasi ( lowerCaseSettings )
+import           Database.Persist.TH
+                 ( mkMigrate, mkPersist, mpsGenerateLenses, persistFileWith
+                 , share, sqlSettings )
 
 share [ mkPersist sqlSettings { mpsGenerateLenses = True }
       , mkMigrate "migrateAll"
       ]
-      [persistLowerCase|
-Test
-    benchmarks  [BenchmarkId]
-    environment EnvironmentId
-    time        UTCTime
-    deriving    Show
+      $(persistFileWith lowerCaseSettings "src/model")
 
-Environment
-    commit      Text
-    pullRequest Text
-    repoSlug    Text
-    token       Text
-    deriving    Show
-
-Benchmark
-    average     Double
-    derivation  Double
-    name        Text
-    samples     Int
-    unit        Text
-    deriving    Show
-|]
-
-type Entry = (Environment, [Benchmark])
+type Entry = (Test, [Benchmark])
 
 -- | Drop the "_benchmark" from the Benchmark
 deriveJSON defaultOptions { fieldLabelModifier = drop 10 } ''Benchmark
 
 -- | Drop the "_result" from the Result
 deriveJSON defaultOptions { fieldLabelModifier = drop 5 } ''Test
 
--- | Drop the "_environment" from the Environment
-deriveJSON defaultOptions { fieldLabelModifier = drop 12 } ''Environment
-
 -- | Get a new empty Benchmark instance
 emptyBenchmark :: Benchmark
 emptyBenchmark = Benchmark 0 0 "" 0 ""