Add logging, CLI argument parsing and JSON encoding

Signed-off-by: Sascha Grunert <sgrunert@suse.com>

floskell.json

@@ -1,6 +1,6 @@
 {
   "style": "cramer",
-  "extensions": ["TemplateHaskell"],
+  "extensions": ["DeriveGeneric", "OverloadedStrings", "TemplateHaskell"],
   "fixities": [],
   "formatting": {
     "op": {

nix/default.nix

@@ -1,17 +1,18 @@
-{ mkDerivation, base, hpack, lens, megaparsec, stdenv, tasty
-, tasty-hspec, tasty-quickcheck
+{ mkDerivation, aeson, base, hpack, hslogger, lens, megaparsec
+, optparse-applicative, stdenv, tasty, tasty-hspec
+, tasty-quickcheck
 }:
 mkDerivation {
   pname = "performabot";
   version = "0.1.0";
   src = ./..;
   isLibrary = true;
   isExecutable = true;
-  libraryHaskellDepends = [ base lens megaparsec ];
+  libraryHaskellDepends = [ aeson base hslogger lens megaparsec ];
   libraryToolDepends = [ hpack ];
-  executableHaskellDepends = [ base ];
+  executableHaskellDepends = [ base hslogger optparse-applicative ];
   testHaskellDepends = [
-    base lens megaparsec tasty tasty-hspec tasty-quickcheck
+    aeson base lens megaparsec tasty tasty-hspec tasty-quickcheck
   ];
   preConfigure = "hpack";
   homepage = "https://github.com/saschagrunert/performabot#readme";

nix/nixpkgs.json

@@ -1,7 +1,7 @@
 {
   "url": "https://github.com/nixos/nixpkgs",
-  "rev": "d4a6e8b727a691dcf0581db3fe9be807d6cd16eb",
-  "date": "2019-06-06T17:18:34+02:00",
-  "sha256": "1jv3vyb354jxwz10f196p4r1jbz3khdwxhgjrrb4gv5kxgjiclrs",
+  "rev": "af940c1f87fedc7c90b61ec264220c3f003126c4",
+  "date": "2019-06-07T17:50:21+03:00",
+  "sha256": "059s6dh8x3smla692xf9bb119yaixglm14c3xan1mysl3fxq41xh",
   "fetchSubmodules": false
 }

package.yaml

@@ -27,6 +27,7 @@ ghc-options:
   - -Wno-unsafe
 
 default-extensions:
+  - DeriveGeneric
   - OverloadedStrings
   - TemplateHaskell
 
@@ -39,11 +40,15 @@ executables:
       - -threaded
       - -with-rtsopts=-N
     dependencies:
+      - hslogger
       - performabot
+      - optparse-applicative
 
 library:
   source-dirs: src
   dependencies:
+    - aeson
+    - hslogger
     - lens
     - megaparsec
 
@@ -56,6 +61,7 @@ tests:
       - -threaded
       - -with-rtsopts=-N
     dependencies:
+      - aeson
       - lens
       - megaparsec
       - tasty

performabot.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 68caf93b86d38889e47ecf55b29392cde1472b2b9920e460da48df3738c48e44
+-- hash: 3db39fbe3f536e48b8fb7e63743e6dbe0898d17542afc2f1afd857fd98258aa4
 
 name:           performabot
 version:        0.1.0
@@ -27,15 +27,18 @@ library
   exposed-modules:
       Benchmark
       GoParser
+      Log
       Parser
   other-modules:
       Paths_performabot
   hs-source-dirs:
       src
-  default-extensions: OverloadedStrings TemplateHaskell
+  default-extensions: DeriveGeneric OverloadedStrings TemplateHaskell
   ghc-options: -Werror -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe
   build-depends:
-      base
+      aeson
+    , base
+    , hslogger
     , lens
     , megaparsec
   default-language: Haskell2010
@@ -46,10 +49,12 @@ executable performabot
       Paths_performabot
   hs-source-dirs:
       src/cmd
-  default-extensions: OverloadedStrings TemplateHaskell
+  default-extensions: DeriveGeneric OverloadedStrings TemplateHaskell
   ghc-options: -Werror -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -rtsopts -threaded -with-rtsopts=-N
   build-depends:
       base
+    , hslogger
+    , optparse-applicative
     , performabot
   default-language: Haskell2010
 
@@ -63,10 +68,11 @@ test-suite performabot-test
       Paths_performabot
   hs-source-dirs:
       test
-  default-extensions: OverloadedStrings TemplateHaskell
+  default-extensions: DeriveGeneric OverloadedStrings TemplateHaskell
   ghc-options: -Werror -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -rtsopts -threaded -with-rtsopts=-N
   build-depends:
-      base
+      aeson
+    , base
     , lens
     , megaparsec
     , performabot

src/Benchmark.hs

@@ -11,7 +11,12 @@ module Benchmark
     , unit
     ) where
 
-import           Control.Lens ( makeLenses )
+import           Control.Lens  ( makeLenses )
+
+import           Data.Aeson.TH
+                 ( defaultOptions, deriveJSON, fieldLabelModifier )
+
+import           GHC.Generics  ( Generic )
 
 -- | A Benchmark result
 data Benchmark =
@@ -21,11 +26,14 @@ data Benchmark =
               , _samples    :: Integer -- The amount of sampled data
               , _unit       :: String  -- The unit of the benchmark, like "seconds"
               }
-    deriving ( Show )
+    deriving ( Generic, Show )
+
+-- | Lens creation
+makeLenses ''Benchmark
+
+-- | Drop the underscore from the Benchmark
+deriveJSON defaultOptions { fieldLabelModifier = drop 1 } ''Benchmark
 
 -- | Get a new empty Benchmark instance
 emptyBenchmark :: Benchmark
 emptyBenchmark = Benchmark 0 0 "" 0 ""
-
--- | Lens creation
-makeLenses ''Benchmark

src/Log.hs

@@ -0,0 +1,43 @@
+-- | The logging faccade
+--
+-- @since 0.1.0
+module Log ( debug, debugR, info, infoR, initLogger, notice, noticeR ) where
+
+import           System.Log.Logger ( Priority, debugM, infoM, noticeM, setLevel
+                                   , updateGlobalLogger )
+
+-- | The default logger
+logger :: String
+logger = "logger"
+
+-- | The prefix string for unraw log output: 🤖
+prefix :: String
+prefix = "\129302"
+
+-- | Logger initialization
+initLogger :: Priority -> IO ()
+initLogger l = updateGlobalLogger logger (setLevel l)
+
+-- | Output a debug message with prefix
+debug :: String -> IO ()
+debug m = debugR $ prefix ++ m
+
+-- | Output a debug message
+debugR :: String -> IO ()
+debugR = debugM logger
+
+-- | Output an info message with prefix
+info :: String -> IO ()
+info m = infoR $ prefix ++ m
+
+-- | Output an info message
+infoR :: String -> IO ()
+infoR = infoM logger
+
+-- | Output an notice message with prefix
+notice :: String -> IO ()
+notice m = noticeR $ prefix ++ m
+
+-- | Output an notice message
+noticeR :: String -> IO ()
+noticeR = noticeM logger

src/Parser.hs

@@ -44,4 +44,3 @@ integer = lexeme L.decimal
 -- | Parses double numbers
 double :: StringParser Double
 double = lexeme L.float
-

src/cmd/Main.hs

@@ -3,27 +3,89 @@
 -- @since 0.1.0
 module Main ( main ) where
 
-import           Control.Monad ( foldM_ )
+import           Control.Monad       ( foldM )
 
-import           GoParser      ( parse )
+import           GoParser            ( parse )
 
-import           Parser        ( State(Init) )
+import           Log
+                 ( debug, info, initLogger, notice, noticeR )
+
+import qualified Options.Applicative as O ( info )
+import           Options.Applicative
+                 ( (<**>), Parser, ParserInfo, ParserPrefs(..), customExecParser
+                 , flag', footer, fullDesc, header, help, helper, infoOption
+                 , long, many, short )
+
+import           Parser              ( State(Ok, Failure, Init) )
 
 import           System.IO
                  ( BufferMode(LineBuffering), hSetBuffering, stdout )
+import           System.Log.Logger   ( Priority(..) )
+
+import           Text.Printf         ( printf )
+
+newtype Args = Args Priority
 
 -- | The main function
 main :: IO ()
-main = do
-    putStrLn "Welcome to performabot! Waiting for input from stdin…"
+main = customExecParser p parser >>= run
+  where
+    p = ParserPrefs { prefMultiSuffix     = ""
+                    , prefDisambiguate    = True
+                    , prefShowHelpOnError = False
+                    , prefShowHelpOnEmpty = True
+                    , prefBacktrack       = True
+                    , prefColumns         = 80
+                    }
+
+-- | The main argument parser
+parser :: ParserInfo Args
+parser =
+    O.info (arguments <**> version <**> helper)
+           (fullDesc <> header "performabot - Continuous performance analysis reports for software projects"
+            <> footer "More info at <https://github.com/saschagrunert/performabot>")
+
+arguments :: Parser Args
+arguments = Args <$> verbosity
+
+verbosity :: Parser Priority
+verbosity = priority . length
+    <$> many (flag' ()
+                    (long "verbose" <> short 'v'
+                     <> help ("the logging verbosity,"
+                              ++ " can be specified up to 2x")))
+  where
+    priority a
+        | a == 0 = NOTICE
+        | a == 1 = INFO
+        | otherwise = DEBUG
+
+version :: Parser (a -> a)
+version =
+    infoOption "v0.1.0" (long "version" <> help "Print the current version")
+
+-- | The entry function after argument parsing
+run :: Args -> IO ()
+run (Args v) = do
+    initLogger v
+    notice "Welcome to performabot! Processing input from stdin…"
     hSetBuffering stdout LineBuffering
     input <- getContents
-    foldM_ parseAndPrint Init (lines input)
-
--- | Prints the current line to the logging faccade and runs the parser on it
-parseAndPrint :: State -> String -> IO State
-parseAndPrint s line = do
-    putStrLn line
-    let ns = parse s line
-    print ns
-    return ns
+    (_, i) <- foldM parseAndPrint (Init, 0) $ lines input
+    notice . printf "Processing done, found %d result%s" i $
+        if i /= 1 then ("s" :: String) else ""
+
+parseAndPrint :: (State, Integer) -> String -> IO (State, Integer)
+parseAndPrint (s, i) line = do
+    noticeR line
+    let z = parse s line
+    debugState z
+    return (z, i + res z)
+
+debugState :: State -> IO ()
+debugState (Failure f) = info $ printf "Parse error: %s" f
+debugState x = debug . printf "State: %s" $ show x
+
+res :: State -> Integer
+res (Ok _) = 1
+res _ = 0

test/BenchmarkSpec.hs

@@ -8,6 +8,8 @@ import           Benchmark
 
 import           Control.Lens     ( (^.) )
 
+import           Data.Aeson       ( encode )
+
 import           Test.Tasty.Hspec
                  ( Spec, it, parallel, shouldBe, shouldContain )
 
@@ -31,3 +33,6 @@ benchmarkSpec = parallel $ do
 
     it "should succeed to access a Benchmarks 'unit'" $
         emptyBenchmark ^. unit `shouldBe` ""
+
+    it "should succeed to encode a Benchmarks to JSON" $ encode emptyBenchmark
+        `shouldBe` "{\"average\":0.0,\"derivation\":0.0,\"name\":\"\",\"samples\":0,\"unit\":\"\"}"