Improving PaymentRate parser

Author: recursion-ninja

bench/macro/lsm-tree-bench-unions.hs

@@ -40,7 +40,7 @@ import           Control.Applicative ((<**>))
 import           Control.Concurrent (getNumCapabilities)
 import           Control.Concurrent.Async
 import           Control.Concurrent.MVar
-import           Control.Monad (forM, forM_, void, when)
+import           Control.Monad (forM, forM_, guard, void, when)
 import           Control.Monad.ST (ST, runST)
 import           Control.Monad.Trans.State.Strict (runState, state)
 import qualified Data.ByteString.Short as BS
@@ -72,12 +72,17 @@ import           System.Directory (createDirectoryIfMissing)
 import           System.IO
 import           System.Mem (performMajorGC)
 import qualified System.Random as Random
+import qualified Text.ParserCombinators.ReadPrec as Lex
 import           Text.Printf (printf)
 import           Text.Read (Read (..))
+import qualified Text.Read as Lex
+import qualified Text.Read.Lex as Lex
 
 import           Database.LSMTree.Extras (groupsOfN)
 import           Database.LSMTree.Internal.ByteString (byteArrayToSBS)
 
+import System.Environment
+
 -- We should be able to write this benchmark
 -- using only use public lsm-tree interface
 import qualified Database.LSMTree.Simple as LSM
@@ -172,7 +177,15 @@ instance Show PaymentRate where
 
 instance Read PaymentRate where
 
-  readPrec = PaymentRate . toRational <$> (readPrec @Double)
+  readPrec =
+    let pFloat = toRational <$> (readPrec @Double)
+        pFract = do
+          num <- Lex.readP_to_Prec $ const Lex.readDecP
+          Lex.Symbol sep <- Lex.lexP
+          guard $ head sep `elem` ("/:%" :: String)
+          den <- Lex.readP_to_Prec $ const Lex.readDecP
+          pure $ num % den
+    in  PaymentRate <$> Lex.choice [ pFract, pFloat ]
 
 -------------------------------------------------------------------------------
 -- command line interface
@@ -456,12 +469,18 @@ doDryRun' gopts opts = do
 -- |
 -- From StackOverflow: https://stackoverflow.com/a/30938328
 renderRational :: Int -> Rational -> String
-renderRational len rat = sign <> shows d ("." ++ take len (go next))
+renderRational len rat = sign <> shows prefix ("." ++ suffix)
     where
       sign
         | num < 0 = "-"
         | otherwise = ""
-      (d, next) = abs num `quotRem` den
+
+      (prefix, next) = abs num `quotRem` den
+
+      suffix = case next of
+        0 -> "0"
+        n -> take len $ go n
+        
       num = numerator rat
       den = denominator rat
       go 0 = ""
@@ -541,6 +560,8 @@ doRun gopts opts = do
           | pipelined opts = pipelinedIterations h
           | otherwise = sequentialIterations h
 
+    print $ deriveFileNameForPlot gopts opts
+
     refRNG <- newIORef $ initGen 
                 (initialSize gopts)
                 (batchSize opts)
@@ -619,6 +640,37 @@ fillBetween title vs = Plot.liftEC $ do
   Plot.plot_fillbetween_style .= Plot.solidFillStyle color
   Plot.plot_fillbetween_values .= vs
 
+deriveFileNameForPlot :: GlobalOpts -> RunOpts -> FilePath
+deriveFileNameForPlot gOpts rOpts =
+    let partTable = show $ tableCount gOpts
+        partWidth = List.intercalate "_" . fmap Fold.toList . groupsOfN 3 . reverse . show $ initialSize gOpts
+    in  Fold.fold
+          [ "benchmark"
+          , partTable
+          , "×"
+          , partWidth
+          , ".png"
+          ]
+
+{-
+data GlobalOpts = GlobalOpts
+    { rootDir     :: !FilePath  -- ^ session directory.
+    , tableCount  :: !Int -- ^ Number of  tables in the benchmark
+    , initialSize :: !Int
+    }
+  deriving stock Show
+
+data RunOpts = RunOpts
+    { batchCount :: !Int
+    , batchSize  :: !Int
+    , check      :: !Bool
+    , seed       :: !Word64
+    , pipelined  :: !Bool
+    , payRate    :: !PaymentRate
+    }
+  deriving stock Show
+-}
+
 -------------------------------------------------------------------------------
 -- sequential
 -------------------------------------------------------------------------------
@@ -913,6 +965,7 @@ main = do
     putStrLn "         To benchmark in release mode, pass:"
     putStrLn "         --project-file=cabal.project.release"
 #endif
+    getArgs >>= Fold.traverse_ print
     (gopts, cmd) <- O.customExecParser prefs cliP
     print gopts
     print cmd