gitson-0.5.2: benchmark/GitsonBench.hs

{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-}

module GitsonBench (setup, benchmarks, cleanup) where

import           Control.Monad (void)
import           System.Directory
import           Data.Aeson
import           Criterion
import           Gitson

exampleVal ∷ Value
exampleVal = object [ "with" .= [ "some", object [ "stuff" .= String "inside" ], Number 1, Number 2, Number 3, Number 4, Number 5, Bool True ]
                    , "more" .= [ "some", object [ "stuff" .= String "inside" ], object [ "stuff" .= String "inside" ], Bool True ]
                    , "Text" .= String "This is some text. This is some text. This is some text. This is some text. This is some text. This is some text. "
                    , "aaaa" .= [ "some", object [ "stuff" .= String "inside" ], Number 1, Number 2, Number 3, Number 4, Number 5, Bool True ]
                    , "bbbb" .= [ "some", object [ "stuff" .= String "inside" ], object [ "stuff" .= String "inside" ], Bool True ]
                    , "xxxx" .= object [
                        "more" .= [ "some", object [ "stuff" .= String "inside" ], object [ "stuff" .= String "inside" ], Bool True ]
                      , "text" .= String "This is some text. This is some text. This is some text. This is some text. This is some text. This is some text. "
                      , "aaaa" .= [ "some", object [ "stuff" .= String "inside" ], Number 1, Number 2, Number 3, Number 4, Number 5, Bool True ]
                      , "yyyy" .= String "This is some text. This is some text. This is some text. This is some text. This is some text. This is some text. "
                      , "bbbb" .= [ "some", object [ "stuff" .= String "inside" ], object [ "stuff" .= String "inside" ], Bool True ] ]
                    , "text" .= String "This is some text. This is some text. This is some text. This is some text. This is some text. This is some text. "
                    , "texT" .= String "This is some text. This is some text. This is some text. This is some text. This is some text. This is some text. " ]

benchRepoPath ∷ String
benchRepoPath = "tmp/bench-repo"

setup ∷ IO ()
setup = do
  createRepo benchRepoPath
  void $ transaction benchRepoPath $ do
    saveDocument "things" "thing-to-read" exampleVal
    saveNextDocument "things" "thing-to-read" exampleVal

transactOneWrite ∷ IO ()
transactOneWrite = transaction benchRepoPath $ do
  saveDocument "things" "first-thing" exampleVal

transactNextWrites ∷ IO ()
transactNextWrites = transaction benchRepoPath $ do
  saveNextDocument "things" "thing" exampleVal
  saveNextDocument "things" "thing" exampleVal
  saveNextDocument "things" "thing" exampleVal
  saveNextDocument "things" "thing" exampleVal

readThing ∷ IO ()
readThing = void (readDocument "things" "thing-to-read" ∷ IO (Maybe Value))

readByName ∷ IO ()
readByName = void (readDocumentByName "things" "thing-to-read" ∷ IO (Maybe Value))

benchmarks ∷ [Benchmark]
benchmarks = [
    bench "transaction with 1 write" $ nfIO transactOneWrite
  , bench "transaction with 4 writes with incrementing ids" $ nfIO transactNextWrites
  , bench "1 read" $ nfIO $ readThing
  , bench "1 read by name" $ nfIO $ readByName ]

cleanup ∷ IO ()
cleanup = removeDirectoryRecursive benchRepoPath