weigh 0.0.11 → 0.0.12
raw patch · 5 files changed
+72/−104 lines, 5 filesdep −bytestring-triedep −containersdep −randomdep ~base
Dependencies removed: bytestring-trie, containers, random, unordered-containers
Dependency ranges changed: base
Files
- CHANGELOG +3/−0
- src/Weigh.hs +56/−33
- src/test/Main.hs +12/−1
- src/test/Maps.hs +0/−48
- weigh.cabal +1/−22
CHANGELOG view
@@ -1,3 +1,6 @@+0.0.12:+ * Fix bug in non-unique groupings+ 0.0.10: * Export Grouped
src/Weigh.hs view
@@ -11,6 +11,9 @@ -- | Framework for seeing how much a function allocates. --+-- WARNING: weigh is incompatible with profiling. It reports much more+-- allocations with profiling turned on.+-- -- Example: -- -- @@@ -36,6 +39,11 @@ -- * Configuration ,setColumns ,Column(..)+ ,setFormat+ ,Format (..)+ ,setConfig+ ,Config (..)+ ,defaultConfig -- * Simple combinators ,func ,io@@ -52,6 +60,7 @@ ,Weight(..) -- * Handy utilities ,commas+ ,reportGroup -- * Internals ,weighDispatch ,weighFunc@@ -116,7 +125,7 @@ -- | Some grouped thing. data Grouped a = Grouped String [Grouped a]- | Singleton String a+ | Singleton a deriving (Eq, Show, Functor, Traversable.Traversable, Foldable.Foldable, Generic) instance NFData a => NFData (Grouped a) @@ -159,8 +168,9 @@ :: Weigh a -> IO ([Grouped (Weight,Maybe String)], Config) weighResults m = do args <- getArgs+ weighEnv <- lookupEnv "WEIGH_CASE" let (config, cases) = execState (runWeigh m) (defaultConfig, [])- result <- weighDispatch args cases+ result <- weighDispatch weighEnv cases case result of Nothing -> return ([], config) Just weights ->@@ -192,10 +202,18 @@ Config {configColumns = defaultColumns, configPrefix = "", configFormat = Plain} --- | Set the config. Default is: 'defaultConfig'.+-- | Set the columns to display in the config setColumns :: [Column] -> Weigh () setColumns cs = Weigh (modify (first (\c -> c {configColumns = cs}))) +-- | Set the output format in the config+setFormat :: Format -> Weigh ()+setFormat fm = Weigh (modify (first (\c -> c {configFormat = fm})))++-- | Set the config. Default is: 'defaultConfig'.+setConfig :: Config -> Weigh ()+setConfig = Weigh . modify . first . const+ -- | Weigh a function applied to an argument. -- -- Implemented in terms of 'validateFunc'.@@ -252,7 +270,7 @@ -> (Weight -> Maybe String) -- ^ A validating function, returns maybe an error. -> Weigh () validateAction name !m !arg !validate =- tellAction name (Action (Left m) arg name validate)+ tellAction name $ flip (Action (Left m) arg) validate -- | Weigh a function, validating the result validateFunc :: (NFData a)@@ -262,13 +280,13 @@ -> (Weight -> Maybe String) -- ^ A validating function, returns maybe an error. -> Weigh () validateFunc name !f !x !validate =- tellAction name (Action (Right f) x name validate)+ tellAction name $ flip (Action (Right f) x) validate -- | Write out an action.-tellAction :: String -> Action -> Weigh ()+tellAction :: String -> (String -> Action) -> Weigh () tellAction name act = Weigh (do prefix <- gets (configPrefix . fst)- modify (second (\x -> x ++ [Singleton (prefix ++ "/" ++ name) act])))+ modify (second (\x -> x ++ [Singleton $ act (prefix ++ "/" ++ name)]))) -- | Make a grouping of tests. wgroup :: String -> Weigh () -> Weigh ()@@ -286,33 +304,34 @@ -- | Weigh a set of actions. The value of the actions are forced -- completely to ensure they are fully allocated.-weighDispatch :: [String] -- ^ Program arguments.+weighDispatch :: Maybe String -- ^ The content of then env variable WEIGH_CASE. -> [Grouped Action] -- ^ Weigh name:action mapping. -> IO (Maybe [(Grouped Weight)]) weighDispatch args cases = case args of- ("--case":label:fp:_) ->+ Just var -> do+ let (label:fp:_) = read var let !_ = force fp- in case glookup label (force cases) of- Nothing -> error "No such case!"- Just act -> do- case act of- Action !run arg _ _ -> do- (bytes, gcs, liveBytes, maxByte) <-- case run of- Right f -> weighFunc f arg- Left m -> weighAction m arg- writeFile- fp- (show- (Weight- { weightLabel = label- , weightAllocatedBytes = bytes- , weightGCs = gcs- , weightLiveBytes = liveBytes- , weightMaxBytes = maxByte- }))- return Nothing+ case glookup label (force cases) of+ Nothing -> error "No such case!"+ Just act -> do+ case act of+ Action !run arg _ _ -> do+ (bytes, gcs, liveBytes, maxByte) <-+ case run of+ Right f -> weighFunc f arg+ Left m -> weighAction m arg+ writeFile+ fp+ (show+ (Weight+ { weightLabel = label+ , weightAllocatedBytes = bytes+ , weightGCs = gcs+ , weightLiveBytes = liveBytes+ , weightMaxBytes = maxByte+ }))+ return Nothing _ -> fmap Just (Traversable.traverse (Traversable.traverse fork) cases) -- | Lookup an action.@@ -329,11 +348,12 @@ "weigh" (\fp h -> do hClose h+ setEnv "WEIGH_CASE" $ show $ [actionName act,fp] me <- getExecutablePath (exit, _, err) <- readProcessWithExitCode me- ["--case", actionName act, fp, "+RTS", "-T", "-RTS"]+ ["+RTS", "-T", "-RTS"] "" case exit of ExitFailure {} ->@@ -396,7 +416,7 @@ , fromIntegral liveBytes , fromIntegral maxBytes) --- | Weigh a pure function. This function is heavily documented inside.+-- | Weigh an IO action. This function is heavily documented inside. weighAction :: (NFData a) => (b -> IO a) -- ^ A function whose memory use we want to measure.@@ -459,7 +479,7 @@ singletons = mapMaybe (\case- Singleton _ v -> Just v+ Singleton v -> Just v _ -> Nothing) gs groups =@@ -494,7 +514,7 @@ , (Max, (False, "Max")) ] toRow (w, err) =- [ (Case, (True, weightLabel w))+ [ (Case, (True, takeLastAfterBk $ weightLabel w)) , (Allocated, (False, commas (weightAllocatedBytes w))) , (GCs, (False, commas (weightGCs w))) , (Live, (False, commas (weightLiveBytes w)))@@ -505,6 +525,9 @@ Nothing -> "OK" Just {} -> "INVALID")) ]+ takeLastAfterBk w = case List.elemIndices '/' w of+ [] -> w+ x -> drop (1+last x) w -- | Make a markdown table. mdtable ::[[(Bool,String)]] -> String
src/test/Main.hs view
@@ -9,6 +9,8 @@ import Weigh import GHC.Generics +import Data.List (nub)+ -- | Weigh integers. main :: IO () main =@@ -17,7 +19,10 @@ wgroup "IO actions" ioactions wgroup "Ints" ints wgroup "Structs" struct- wgroup "Packing" packing)+ wgroup "Packing" packing+ wgroup "fst" aFuncNamedId+ wgroup "snd" anotherFuncNamedId+ ) -- | Weigh IO actions. ioactions :: Weigh ()@@ -91,3 +96,9 @@ do func "\\x -> HasInt x" (\x -> HasInt x) 5 func "\\x -> HasUnpacked (HasInt x)" (\x -> HasUnpacked (HasInt x)) 5 func "\\x -> HasPacked (HasInt x)" (\x -> HasPacked (HasInt x)) 5++aFuncNamedId :: Weigh ()+aFuncNamedId = func "id" id (1::Int)++anotherFuncNamedId :: Weigh ()+anotherFuncNamedId = func "id" nub ([1,2,3,4,5,1]::[Int])
− src/test/Maps.hs
@@ -1,48 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveGeneric #-}---- | Example uses of comparing map-like data structures.--module Main where--import Control.DeepSeq-import qualified Data.HashMap.Lazy-import qualified Data.HashMap.Strict-import qualified Data.IntMap.Lazy-import qualified Data.IntMap.Strict-import qualified Data.Map.Lazy-import qualified Data.Map.Strict-import System.Random-import Weigh---- | Weigh maps.-main :: IO ()-main =- mainWith (do inserts- fromlists)--inserts :: Weigh ()-inserts = do func "Data.Map.Strict.insert mempty"- (\(k,v) -> Data.Map.Strict.insert k v mempty)- (1 :: Int,1 :: Int)- func "Data.Map.Lazy.insert mempty"- (\(k,v) -> Data.Map.Lazy.insert k v mempty)- (1 :: Int,1 :: Int)- func "Data.HashMap.Strict.insert mempty"- (\(k,v) -> Data.HashMap.Strict.insert k v mempty)- (1 :: Int,1 :: Int)- func "Data.HashMap.Lazy.insert mempty"- (\(k,v) -> Data.HashMap.Lazy.insert k v mempty)- (1 :: Int,1 :: Int)--fromlists :: Weigh ()-fromlists =- do let !elems =- force (zip (randoms (mkStdGen 0) :: [Int])- [1 :: Int .. 1000000])- func "Data.Map.Strict.fromList (1 million)" Data.Map.Strict.fromList elems- func "Data.Map.Lazy.fromList (1 million)" Data.Map.Lazy.fromList elems- func "Data.IntMap.Strict.fromList (1 million)" Data.IntMap.Strict.fromList elems- func "Data.IntMap.Lazy.fromList (1 million)" Data.IntMap.Lazy.fromList elems- func "Data.HashMap.Strict.fromList (1 million)" Data.HashMap.Strict.fromList elems- func "Data.HashMap.Lazy.fromList (1 million)" Data.HashMap.Lazy.fromList elems
weigh.cabal view
@@ -1,5 +1,5 @@ name: weigh-version: 0.0.11+version: 0.0.12 synopsis: Measure allocations of a Haskell functions/values description: Please see README.md homepage: https://github.com/fpco/weigh#readme@@ -14,11 +14,6 @@ CHANGELOG cabal-version: >=1.10 -flag weigh-maps- manual: True- default: False- description: Weigh maps.- library hs-source-dirs: src ghc-options: -Wall -O2@@ -41,19 +36,3 @@ build-depends: base , weigh , deepseq--test-suite weigh-maps- if !flag(weigh-maps)- buildable: False- default-language: Haskell2010- type: exitcode-stdio-1.0- hs-source-dirs: src/test- ghc-options: -O2- main-is: Maps.hs- build-depends: base- , weigh- , deepseq- , containers- , unordered-containers- , bytestring-trie- , random