diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f413462..3e21e9b 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -16,9 +16,9 @@ jobs: strategy: matrix: os: [ubuntu-latest, macOS-latest] - cabal: ["3.6"] + cabal: ["3.10"] ghc: - - "8.10.7" + - "9.6.3" steps: - uses: actions/checkout@v4 diff --git a/README.md b/README.md index 62a0f90..77c392a 100644 --- a/README.md +++ b/README.md @@ -67,29 +67,12 @@ library. To run benchmarks, use the following command: ``` -cabal v2-run co-log-bench +cabal v2-run co-log-bench -- --svg bench.svg &> /dev/null ``` -| Benchmarks | Time for 10K messages | -| :------------------------------------------------------ | :-------------------- | -| `Prelude.putStrLn` | ` 5.117ms` | -| `Text.putStrLn` | ` 9.220ms` | -| `ByteString.putStrLn` | ` 2.971ms` | -| `mempty` | ` 1.181ms` | -| `logStringStdout` | ` 5.107ms` | -| `logPrint` | ` 5.248ms` | -| `logTextStdout` | ` 5.351ms` | -| `logByteStringStdout` | ` 2.933ms` | -| `logByteStringStderr` | ` 17.482ms` | -| `ByteString > (stdout <> stderr)` | ` 17.715ms` | -| `Message > format > stdout` | ` 9.188ms` | -| `Message > format > ByteString > stdout` | ` 3.524ms` | -| `Message{callstack} > format > stdout` | ` 9.139ms` | -| `Message{callstack:5} > format > stdout` | ` 9.464ms` | -| `Message{callstack:50} > format > stdout` | ` 9.439ms` | -| `Message{Time,ThreadId} > format > stdout` | ` 54.160ms` | -| `Message{Time,ThreadId} > format > ByteString > stdout` | ` 54.137ms` | +**Time for 10K messages:** +![Benchmarks](bench.svg) [hk-img]: https://img.shields.io/hackage/v/co-log.svg?logo=haskell [hk-img-ps]: https://img.shields.io/hackage/v/co-log-polysemy.svg?logo=haskell diff --git a/bench.svg b/bench.svg new file mode 100644 index 0000000..1c1645b --- /dev/null +++ b/bench.svg @@ -0,0 +1,181 @@ + + + +Prelude.putStrLn +19.7 ms + + +19.7 ms ± 1.1 ms + + + + + + + +Text.putStrLn +20.1 ms + + +20.1 ms ± 839 μs + + + + + + +ByteString.putStrLn 14.8 ms + +14.8 ms ± 1.4 ms + + + + + + +mempty 2.58 μs + +2.58 μs ± 189 ns + + + + + + + +logStringStdout +19.9 ms + + +19.9 ms ± 1.3 ms + + + + + + + +logPrint +19.7 ms + + +19.7 ms ± 1.7 ms + + + + + + + +logTextStdout +20.0 ms + + +20.0 ms ± 1.5 ms + + + + + + +logByteStringStdout 15.1 ms + +15.1 ms ± 1.4 ms + + + + + + +logByteStringStderr 15.3 ms + +15.3 ms ± 1.4 ms + + + + + + + +ByteString > (stdout <> stderr) +30.7 ms + + +30.7 ms ± 2.3 ms + + + + + + +Message > format > stdout 22.6 ms + +22.6 ms ± 2.2 ms + + + + + + +Message > format > ByteString > stdout 15.9 ms + +15.9 ms ± 588 μs + + + + + + +Message{callstack} > format > stdout 23.1 ms + +23.1 ms ± 2.0 ms + + + + + + +Message{callstack:5} > format > stdout 22.0 ms + +22.0 ms ± 1.1 ms + + + + + + +Message{callstack:50} > format > stdout 21.5 ms + +21.5 ms ± 2.1 ms + + + + + + + +Message{Time,ThreadId} > format > stdout +78.1 ms + + +78.1 ms ± 4.2 ms + + + + + + + +Message{Time,ThreadId} > format > ByteString > stdout +68.1 ms + + +68.1 ms ± 2.0 ms + + + + + + + + diff --git a/co-log-benchmark-simple/Main.hs b/co-log-benchmark-simple/Main.hs index 0d85515..fc32cc6 100644 --- a/co-log-benchmark-simple/Main.hs +++ b/co-log-benchmark-simple/Main.hs @@ -1,8 +1,5 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} module Main ( main @@ -10,99 +7,84 @@ module Main import Control.Exception (onException) import Control.Monad (replicateM_) -import Data.Bifunctor (bimap) -import Data.Coerce (coerce) -import Data.Maybe (fromMaybe) -import Data.Semigroup (Max (..), (<>)) -import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime) -import Data.Traversable (for) import GHC.Stack (HasCallStack, callStack, emptyCallStack) -import System.Environment (getArgs) -import System.IO (IOMode (..), withFile) -import System.Posix.Process (getProcessID) -import System.Process.Typed (closed, proc, runProcess_, setStderr, setStdin, setStdout, - useHandleClose) import Colog (pattern D, LogAction, Message, Msg (..), cmap, cmapM, defaultFieldMap, fmtMessage, fmtRichMessageDefault, logByteStringStderr, logByteStringStdout, logPrint, logStringStdout, logTextStdout, richMessageAction, upgradeMessageAction, (<&)) +import Test.Tasty.Bench ( bench, defaultMain, nfIO, Benchmark ) import qualified Data.ByteString.Char8 as ByteString import qualified Data.Text.Encoding import qualified Data.Text.IO as Text - --- | Named and specialized version of pair constructor for creating benchmarks. -bench :: String -> IO () -> (String, IO ()) -bench = (,) - -- | List of benchmarks. -benchs :: [(String, IO ())] -benchs = - [ bench "Prelude.putStrLn" $ +benchmarks :: [Benchmark] +benchmarks = + [ bench "Prelude.putStrLn" $ nfIO $ runIO putStrLn "message" - , bench "Text.putStrLn" $ + , bench "Text.putStrLn" $ nfIO $ runIO Text.putStrLn "message" - , bench "ByteString.putStrLn" $ + , bench "ByteString.putStrLn" $ nfIO $ runIO ByteString.putStrLn "message" - , bench "mempty" $ + , bench "mempty" $ nfIO $ runLA mempty ("message" :: String) - , bench "logStringStdout" $ + , bench "logStringStdout" $ nfIO $ let la = logStringStdout in runLA la "message" - , bench "logPrint" $ + , bench "logPrint" $ nfIO $ let la = logPrint in runLA la (5 :: Int) - , bench "logTextStdout" $ + , bench "logTextStdout" $ nfIO $ let la = logTextStdout in runLA la "message" - , bench "logByteStringStdout" $ + , bench "logByteStringStdout" $ nfIO $ let la = logByteStringStdout in runLA la "message" - , bench "logByteStringStderr" $ + , bench "logByteStringStderr" $ nfIO $ let la = logByteStringStderr in runLA la "message" - , bench "ByteString > (stdout <> stderr)" $ + , bench "ByteString > (stdout <> stderr)" $ nfIO $ let la = logByteStringStdout <> logByteStringStderr in runLA la "message" - , bench "Message > format > stdout" $ + , bench "Message > format > stdout" $ nfIO $ let la = cmap fmtMessage logTextStdout in runLA la msg - , bench "Message > format > ByteString > stdout" $ + , bench "Message > format > ByteString > stdout" $ nfIO $ let la = cmap (Data.Text.Encoding.encodeUtf8 . fmtMessage) logByteStringStdout in runLA la msg - , bench "Message{callstack} > format > stdout" $ + , bench "Message{callstack} > format > stdout" $ nfIO $ let la = cmap fmtMessage logTextStdout in runLA la (Msg D callStack "message") - , bench "Message{callstack:5} > format > stdout" $ + , bench "Message{callstack:5} > format > stdout" $ nfIO $ let la = cmap fmtMessage logTextStdout in nest 5 $ runLA la (Msg D callStack "message") - , bench "Message{callstack:50} > format > stdout" $ + , bench "Message{callstack:50} > format > stdout" $ nfIO $ let la = cmap fmtMessage logTextStdout in nest 50 $ runLA la (Msg D callStack "message") - , bench "Message{Time,ThreadId} > format > stdout" $ do + , bench "Message{Time,ThreadId} > format > stdout" $ nfIO $ let messageAction = cmapM fmtRichMessageDefault logTextStdout - let la = upgradeMessageAction defaultFieldMap messageAction - runLA la msg + la = upgradeMessageAction defaultFieldMap messageAction + in runLA la msg - , bench "Message{Time,ThreadId} > format > ByteString > stdout" $ + , bench "Message{Time,ThreadId} > format > ByteString > stdout" $ nfIO $ runLA richMessageAction msg ] where @@ -125,82 +107,4 @@ benchs = nest n f = nest (n - 1) f `onException` pure () -- force nesting main :: IO () -main = getArgs >>= \case - [] -> do - putStrLn "Dump 10k messages (in a forked process):" - results <- runBenchmarks benchs - putStr $ genTable results - name:_ -> fromMaybe (putStrLn "No benchmark with such name") $ - name `lookup` benchs - -{- | Measure the running time of the process. The process allowed to dump data -to stdout or /dev/null. We measure the total running time of the process, and do -not verify that all logs were actually dumped, process should do that on it's -own. --} -timeProcess :: String -> IO NominalDiffTime -timeProcess n = do - t <- getCurrentTime - pid <- getProcessID - withFile "/dev/null" AppendMode $ \fnull1 -> - withFile "/dev/null" AppendMode $ \fnull2 -> do - let cfg = setStdin closed - $ setStdout (useHandleClose fnull1) - $ setStderr (useHandleClose fnull2) - $ proc ("/proc/" ++ show pid ++ "/exe") [n] - runProcess_ cfg - t' <- getCurrentTime - pure $ t' `diffUTCTime` t - -runBenchmarks :: [(String, IO ())] -> IO [(String, NominalDiffTime)] -runBenchmarks bs = for bs $ \(name, _) -> do - t <- timeProcess name - pure (name, t) - -{- | Function that takes list of pairs - benchmark name and result and generates -markdown table. --} -genTable :: [(String, NominalDiffTime)] -> String -genTable rawResults = unlines rows - where - -- stringified and quoted results - results :: [(String, String)] - results = map (bimap quote (quote . fmtTime)) rawResults - - -- Takes length of string as Max monoid - strLen :: String -> Max Int - strLen = Max . length - - quote :: String -> String - quote s = "`" <> s <> "`" - - nameMax, timeMax :: Int - (nameMax, max (length @[] "Time for 10K messages") -> timeMax) = - coerce $ foldMap (bimap strLen strLen) results - - padLeft, padRight :: Char -> Int -> String -> String - padLeft c limit s = replicate (limit - length s) c ++ s - padRight c limit s = s ++ replicate (limit - length s) c - - rows :: [String] - rows = map toTableRow - $ (padRight ' ' nameMax "Benchmarks", padRight ' ' timeMax "Time for 10K messages") - : (':' : replicate (nameMax - 1) '-', ':' : replicate (timeMax - 1) '-') - : map (bimap (padRight ' ' nameMax) (padRight ' ' timeMax)) results - - toTableRow :: (String, String) -> String - toTableRow (l, r) = "| " ++ l ++ " | " ++ r ++ " |" - - -- formats time as milliseconds like this: ` 23.987ms` - fmtTime :: NominalDiffTime -> String - fmtTime = formatMillis . properFraction . (* 1000) . toRational - where - formatMillis :: (Int, Rational) -> String - formatMillis (n, f) = concat - [ padLeft ' ' 3 $ show n - , padRight '0' 4 $ fmtRat f - , "ms" - ] - - fmtRat :: Rational -> String - fmtRat = take 4 . dropWhile (/= '.') . show . fromRational @Double +main = defaultMain benchmarks diff --git a/co-log-benchmark-simple/co-log-benchmark-simple.cabal b/co-log-benchmark-simple/co-log-benchmark-simple.cabal index b3d1792..653144f 100644 --- a/co-log-benchmark-simple/co-log-benchmark-simple.cabal +++ b/co-log-benchmark-simple/co-log-benchmark-simple.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: co-log-benchmark-simple -version: 0.0.0.0 +version: 0.1.0.0 synopsis: Benchmarks of the co-log library. description: Set of benchmarks that can be used to verify that @co-log@ library does not introduce unnesessarily @@ -9,11 +9,11 @@ license: MPL-2.0 license-file: LICENSE author: Alexander Vershilov, Kowainik maintainer: Kowainik -copyright: 2018-2020 Kowainik +copyright: 2018-2020 Kowainik, 2021-2023 co-log category: Logging, Benchmarks build-type: Simple extra-source-files: CHANGELOG.md -tested-with: GHC == 8.10.7 +tested-with: GHC == 9.6.3 source-repository head type: git @@ -23,21 +23,20 @@ executable co-log-bench main-is: Main.hs if os(windows) buildable: False - build-depends: base >= 4.14 && < 4.15 + build-depends: base >= 4.14 && < 4.19 , bytestring , co-log + , tasty-bench , text - , time - , typed-process - , unix - ghc-options: -Wall - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wcompat - -Widentities - -Wredundant-constraints + ghc-options: -Weverything + -Werror + -Wno-implicit-prelude + -Wno-unsafe + -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module + -Wno-missing-import-lists + -Wno-monomorphism-restriction -fhide-source-paths -freverse-errors - -Wpartial-fields default-language: Haskell2010 diff --git a/hie.yaml b/hie.yaml new file mode 100644 index 0000000..23c7e87 --- /dev/null +++ b/hie.yaml @@ -0,0 +1,3 @@ +cradle: + cabal: + component: "executable:co-log-bench" \ No newline at end of file