weigh 0.0.7 → 0.0.8

raw patch · 5 files changed

+157/−78 lines, 5 filesdep −template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG +3/−0
• src/Weigh.hs +136/−60
• src/Weigh/GHCStats.hs +0/−1
• src/test/Main.hs +17/−15
• weigh.cabal +1/−2

@@ -1,3 +1,6 @@+0.0.7:+	* Support grouping+ 0.0.6: 	* Support GHC 8.2 	* Use more reliable calculations

@@ -1,3 +1,8 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ExistentialQuantification #-}@@ -21,6 +26,8 @@ --         count 0 = () --         count a = count (a - 1) -- @+--+-- Use 'wgroup' to group sets of tests.  module Weigh   (-- * Main entry points@@ -34,6 +41,7 @@   ,io   ,value   ,action+  ,wgroup   -- * Validating combinators   ,validateAction   ,validateFunc@@ -55,10 +63,13 @@ import Control.Arrow import Control.DeepSeq import Control.Monad.State-import Data.List+import qualified Data.Foldable as Foldable+import qualified Data.Traversable as Traversable+import Data.Int+import qualified Data.List as List import Data.List.Split import Data.Maybe-import Data.Int+import GHC.Generics import Prelude import System.Environment import System.Exit@@ -77,12 +88,14 @@   deriving (Show, Eq, Enum)  -- | Weigh configuration.-data Config = Config {configColumns :: [Column]}-  deriving (Show)+data Config = Config+  { configColumns :: [Column]+  , configPrefix :: String+  } deriving (Show)  -- | Weigh specification monad. newtype Weigh a =-  Weigh {runWeigh :: State (Config, [(String,Action)]) a}+  Weigh {runWeigh :: State (Config, [Grouped Action]) a}   deriving (Monad,Functor,Applicative)  -- | How much a computation weighed in at.@@ -95,51 +108,64 @@          }   deriving (Read,Show) +-- | Some grouped thing.+data Grouped a+  = Grouped String [Grouped a]+  | Singleton String a+  deriving (Eq, Show, Functor, Traversable.Traversable, Foldable.Foldable, Generic)+instance NFData a => NFData (Grouped a)+ -- | An action to run. data Action =   forall a b. (NFData a) =>   Action {_actionRun :: !(Either (b -> IO a) (b -> a))          ,_actionArg :: !b+         ,actionName :: !String          ,actionCheck :: Weight -> Maybe String}+instance NFData Action where rnf _ = ()  -------------------------------------------------------------------------------- -- Main-runners  -- | Just run the measuring and print a report. Uses 'weighResults'. mainWith :: Weigh a -> IO ()-mainWith m =-  do (results, config) <- weighResults m-     unless (null results)-            (do putStrLn ""-                putStrLn (report config results))-     case mapMaybe (\(w,r) ->-                      do msg <- r-                         return (w,msg))-                   results of-       [] -> return ()-       errors ->-         do putStrLn "\nCheck problems:"-            mapM_ (\(w,r) -> putStrLn ("  " ++ weightLabel w ++ "\n    " ++ r)) errors-            exitWith (ExitFailure (-1))+mainWith m = do+  (results, config) <- weighResults m+  unless+    (null results)+    (do putStrLn ""+        putStrLn (report config results))+  case mapMaybe+         (\(w, r) -> do+            msg <- r+            return (w, msg))+         (concatMap Foldable.toList (Foldable.toList results)) of+    [] -> return ()+    errors -> do+      putStrLn "\nCheck problems:"+      mapM_+        (\(w, r) -> putStrLn ("  " ++ weightLabel w ++ "\n    " ++ r))+        errors+      exitWith (ExitFailure (-1))  -- | Run the measuring and return all the results, each one may have -- an error. weighResults-  :: Weigh a -> IO ([(Weight,Maybe String)], Config)+  :: Weigh a -> IO ([Grouped (Weight,Maybe String)], Config) weighResults m = do   args <- getArgs-  let (config, cases) =-        execState (runWeigh m) (defaultConfig, [])+  let (config, cases) = execState (runWeigh m) (defaultConfig, [])   result <- weighDispatch args cases   case result of     Nothing -> return ([], config)     Just weights ->       return-        ( map-            (\w ->-               case lookup (weightLabel w) cases of-                 Nothing -> (w, Nothing)-                 Just a -> (w, actionCheck a w))+        ( fmap+            (fmap+               (\w ->+                  case glookup (weightLabel w) cases of+                    Nothing -> (w, Nothing)+                    Just a -> (w, actionCheck a w)))             weights         , config) @@ -152,7 +178,7 @@  -- | Default config. defaultConfig :: Config-defaultConfig = Config {configColumns = defaultColumns}+defaultConfig = Config {configColumns = defaultColumns, configPrefix = ""}  -- | Set the config. Default is: 'defaultConfig'. setColumns :: [Column] -> Weigh ()@@ -214,7 +240,7 @@                -> (Weight -> Maybe String) -- ^ A validating function, returns maybe an error.                -> Weigh () validateAction name !m !arg !validate =-  tellAction [(name,Action (Left m) arg validate)]+  tellAction name (Action (Left m) arg name validate)  -- | Weigh a function, validating the result validateFunc :: (NFData a)@@ -224,29 +250,42 @@              -> (Weight -> Maybe String) -- ^ A validating function, returns maybe an error.              -> Weigh () validateFunc name !f !x !validate =-  tellAction [(name,Action (Right f) x validate)]+  tellAction name (Action (Right f) x name validate)  -- | Write out an action.-tellAction :: [(String, Action)] -> Weigh ()-tellAction x = Weigh (modify (second ( ++ x)))+tellAction :: String -> Action -> Weigh ()+tellAction name act =+  Weigh (do prefix <- gets (configPrefix . fst)+            modify (second (\x -> x ++ [Singleton (prefix ++ "/" ++ name) act]))) +-- | Make a grouping of tests.+wgroup :: String -> Weigh () -> Weigh ()+wgroup str wei = do+  (orig, start) <- Weigh get+  let startL = length $ start+  Weigh (modify (first (\c -> c {configPrefix = configPrefix orig ++ "/" ++ str})))+  wei+  Weigh $ do+    modify $ second $ \x -> take startL x ++ [Grouped str $ drop startL x]+    modify (first (\c -> c {configPrefix = configPrefix orig}))+ -------------------------------------------------------------------------------- -- Internal measuring actions  -- | Weigh a set of actions. The value of the actions are forced -- completely to ensure they are fully allocated. weighDispatch :: [String] -- ^ Program arguments.-              -> [(String,Action)] -- ^ Weigh name:action mapping.-              -> IO (Maybe [Weight])+              -> [Grouped Action] -- ^ Weigh name:action mapping.+              -> IO (Maybe [(Grouped Weight)]) weighDispatch args cases =   case args of     ("--case":label:fp:_) ->       let !_ = force fp-      in case lookup label (deepseq (map fst cases) cases) of+      in case glookup label (force cases) of            Nothing -> error "No such case!"            Just act -> do              case act of-               Action !run arg _ -> do+               Action !run arg _ _ -> do                  (bytes, gcs, liveBytes, maxByte) <-                    case run of                      Right f -> weighFunc f arg@@ -262,15 +301,18 @@                        , weightMaxBytes = maxByte                        }))              return Nothing-    _-      | names == nub names -> fmap Just (mapM (fork . fst) cases)-      | otherwise -> error "Non-unique names specified for things to measure."-      where names = map fst cases+    _ -> fmap Just (Traversable.traverse (Traversable.traverse fork) cases) +-- | Lookup an action.+glookup :: String -> [Grouped Action] -> Maybe Action+glookup label =+  Foldable.find ((== label) . actionName) .+  concat . map Foldable.toList . Foldable.toList+ -- | Fork a case and run it.-fork :: String -- ^ Label for the case.+fork :: Action -- ^ Label for the case.      -> IO Weight-fork label =+fork act =   withSystemTempFile     "weigh"     (\fp h -> do@@ -279,22 +321,23 @@        (exit, _, err) <-          readProcessWithExitCode            me-           ["--case", label, fp, "+RTS", "-T", "-RTS"]+           ["--case", actionName act, fp, "+RTS", "-T", "-RTS"]            ""        case exit of          ExitFailure {} ->-           error ("Error in case (" ++ show label ++ "):\n  " ++ err)-         ExitSuccess ->-           do out <- readFile fp-              case reads out of-                [(!r, _)] -> return r-                _ ->-                  error-                    (concat-                       [ "Malformed output from subprocess. Weigh"-                       , " (currently) communicates with its sub-"-                       , "processes via a temporary file."-                       ]))+           error+             ("Error in case (" ++ show (actionName act) ++ "):\n  " ++ err)+         ExitSuccess -> do+           out <- readFile fp+           case reads out of+             [(!r, _)] -> return r+             _ ->+               error+                 (concat+                    [ "Malformed output from subprocess. Weigh"+                    , " (currently) communicates with its sub-"+                    , "processes via a temporary file."+                    ]))  -- | Weigh a pure function. This function is heavily documented inside. weighFunc@@ -389,10 +432,39 @@ -------------------------------------------------------------------------------- -- Formatting functions +report :: Config -> [Grouped (Weight,Maybe String)] -> String+report config gs =+  List.intercalate+    "\n\n"+    (filter+       (not . null)+       [ if null singletons+           then []+           else reportTabular config singletons+       , List.intercalate "\n\n" (map (uncurry (reportGroup config)) groups)+       ])+  where+    singletons =+      mapMaybe+        (\case+           Singleton _ v -> Just v+           _ -> Nothing)+        gs+    groups =+      mapMaybe+        (\case+           Grouped title vs -> Just (title, vs)+           _ -> Nothing)+        gs++reportGroup :: Config -> [Char] -> [Grouped (Weight, Maybe String)] -> [Char]+reportGroup config title gs = title ++ "\n\n" ++ indent (report config gs)+ -- | Make a report of the weights.-report :: Config -> [(Weight,Maybe String)] -> String-report config = tablize . (select headings :) . map (select . toRow)+reportTabular :: Config -> [(Weight,Maybe String)] -> String+reportTabular config = tabled   where+    tabled = tablize . (select headings :) . map (select . toRow)     select row = mapMaybe (\name -> lookup name row) (configColumns config)     headings =       [ (Case, (True, "Case"))@@ -418,8 +490,8 @@ -- | Make a table out of a list of rows. tablize :: [[(Bool,String)]] -> String tablize xs =-  intercalate "\n"-              (map (intercalate "  " . map fill . zip [0 ..]) xs)+  List.intercalate "\n"+              (map (List.intercalate "  " . map fill . zip [0 ..]) xs)   where fill (x',(left',text')) = printf ("%" ++ direction ++ show width ++ "s") text'           where direction = if left'                                then "-"@@ -428,4 +500,8 @@  -- | Formatting an integral number to 1,000,000, etc. commas :: (Num a,Integral a,Show a) => a -> String-commas = reverse . intercalate "," . chunksOf 3 . reverse . show+commas = reverse . List.intercalate "," . chunksOf 3 . reverse . show++-- | Indent all lines in a string.+indent :: [Char] -> [Char]+indent = List.intercalate "\n" . map (replicate 2 ' '++) . lines

@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TupleSections #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-}  -- | Calculate the size of GHC.Stats statically.

@@ -12,11 +12,12 @@ -- | Weigh integers. main :: IO () main =-  mainWith (do integers-               ioactions-               ints-               struct-               packing)+  mainWith+    (do wgroup "Integers" integers+        wgroup "IO actions" ioactions+        wgroup "Ints" ints+        wgroup "Structs" struct+        wgroup "Packing" packing)  -- | Weigh IO actions. ioactions :: Weigh ()@@ -31,16 +32,17 @@  -- | Just counting integers. integers :: Weigh ()-integers =-  do func "integers count 0" count 0-     func "integers count 1" count 1-     func "integers count 2" count 2-     func "integers count 3" count 3-     func "integers count 10" count 10-     func "integers count 100" count 100-  where count :: Integer -> ()-        count 0 = ()-        count a = count (a - 1)+integers = do+  func "integers count 0" count 0+  func "integers count 1" count 1+  func "integers count 2" count 2+  func "integers count 3" count 3+  func "integers count 10" count 10+  func "integers count 100" count 100+  where+    count :: Integer -> ()+    count 0 = ()+    count a = count (a - 1)  -- | We count ints and ensure that the allocations are optimized away -- to only two 64-bit Ints (16 bytes).

@@ -1,5 +1,5 @@ name:                weigh-version:             0.0.7+version:             0.0.8 synopsis:            Measure allocations of a Haskell functions/values description:         Please see README.md homepage:            https://github.com/fpco/weigh#readme@@ -29,7 +29,6 @@                      , deepseq                      , mtl                      , split-                     , template-haskell                      , temporary   default-language:    Haskell2010