weigh 0.0.2 → 0.0.3
raw patch · 3 files changed
+105/−47 lines, 3 files
Files
- CHANGELOG +4/−0
- src/Weigh.hs +100/−46
- weigh.cabal +1/−1
CHANGELOG view
@@ -1,3 +1,7 @@+0.0.3:+ * Added more docs to haddocks+ * Export more internal combinators+ 0.0.2: * Remove magic numbers from weighing code, better accuracy * Add additional `io` combinator
src/Weigh.hs view
@@ -5,13 +5,27 @@ {-# LANGUAGE BangPatterns #-} -- | Framework for seeing how much a function allocates.+--+-- Example:+--+-- @+-- import Weigh+-- main =+-- mainWith (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)+-- @ module Weigh- (-- * Main entry point.+ (-- * Main entry points mainWith- -- * Types- ,Weigh- ,Weight(..)+ ,weighResults -- * Simple combinators ,func ,io@@ -22,8 +36,16 @@ ,validateFunc -- * Validators ,maxAllocs+ -- * Types+ ,Weigh+ ,Weight(..) -- * Handy utilities- ,commas)+ ,commas+ -- * Internals+ ,weighDispatch+ ,weighFunc+ ,weighAction+ ) where import Control.Applicative@@ -67,35 +89,39 @@ -------------------------------------------------------------------------------- -- Main-runners --- | Just run the measuring and print a report.+-- | Just run the measuring and print a report. Uses 'weighResults'. mainWith :: Weigh a -> IO () mainWith m =+ do results <- weighResults m+ unless (null results)+ (do putStrLn ""+ putStrLn (report 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))++-- | Run the measuring and return all the results, each one may have+-- an error.+weighResults+ :: Weigh a -> IO [(Weight,Maybe String)]+weighResults m = do args <- getArgs let cases = execWriter (runWeigh m)- result <- weigh args cases+ result <- weighDispatch args cases case result of- Nothing -> return ()+ Nothing -> return [] Just weights ->- do let results =- map (\w ->- case lookup (weightLabel w) cases of- Nothing -> (w,Nothing)- Just a -> (w,actionCheck a w))- weights- putStrLn ""- putStrLn (report 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))-+ return (map (\w ->+ case lookup (weightLabel w) cases of+ Nothing -> (w,Nothing)+ Just a -> (w,actionCheck a w))+ weights) -------------------------------------------------------------------------------- -- User DSL@@ -103,30 +129,44 @@ -- | Weigh a function applied to an argument. -- -- Implemented in terms of 'validateFunc'.-func :: (NFData a) => String -> (b -> a) -> b -> Weigh ()+func :: (NFData a)+ => String -- ^ Name of the case.+ -> (b -> a) -- ^ Function that does some action to measure.+ -> b -- ^ Argument to that function.+ -> Weigh () func name !f !x = validateFunc name f x (const Nothing) --- | Weigh a function applied to an argument.+-- | Weigh an action applied to an argument. ----- Implemented in terms of 'validateFunc'.-io :: (NFData a) => String -> (b -> IO a) -> b -> Weigh ()+-- Implemented in terms of 'validateAction'.+io :: (NFData a)+ => String -- ^ Name of the case.+ -> (b -> IO a) -- ^ Aciton that does some IO to measure.+ -> b -- ^ Argument to that function.+ -> Weigh () io name !f !x = validateAction name f x (const Nothing) -- | Weigh a value. -- -- Implemented in terms of 'action'.-value :: NFData a => String -> a -> Weigh ()+value :: NFData a+ => String -- ^ Name for the value.+ -> a -- ^ The value to measure.+ -> Weigh () value name !v = func name id v -- | Weigh an IO action. -- -- Implemented in terms of 'validateAction'. action :: NFData a- => String -> IO a -> Weigh ()+ => String -- ^ Name for the value.+ -> IO a -- ^ The action to measure.+ -> Weigh () action name !m = io name (const m) () -- | Make a validator that set sthe maximum allocations.-maxAllocs :: Int64 -> (Weight -> Maybe String)+maxAllocs :: Int64 -- ^ The upper bound.+ -> (Weight -> Maybe String) maxAllocs n = \w -> if weightAllocatedBytes w > n@@ -135,16 +175,22 @@ else Nothing -- | Weigh an IO action, validating the result.-validateAction- :: (NFData a)- => String -> (b -> IO a) -> b -> (Weight -> Maybe String) -> Weigh ()+validateAction :: (NFData a)+ => String -- ^ Name of the action.+ -> (b -> IO a) -- ^ The function which performs some IO.+ -> b -- ^ Argument to the function. Doesn't have to be forced.+ -> (Weight -> Maybe String) -- ^ A validating function, returns maybe an error.+ -> Weigh () validateAction name !m !arg !validate = Weigh (tell [(name,Action (Left m) arg validate)]) -- | Weigh a function, validating the result-validateFunc- :: (NFData a)- => String -> (b -> a) -> b -> (Weight -> Maybe String) -> Weigh ()+validateFunc :: (NFData a)+ => String -- ^ Name of the function.+ -> (b -> a) -- ^ The function which calculates something.+ -> b -- ^ Argument to the function. Doesn't have to be forced.+ -> (Weight -> Maybe String) -- ^ A validating function, returns maybe an error.+ -> Weigh () validateFunc name !f !x !validate = Weigh (tell [(name,Action (Right f) x validate)]) @@ -153,8 +199,10 @@ -- | Weigh a set of actions. The value of the actions are forced -- completely to ensure they are fully allocated.-weigh :: [String] -> [(String,Action)] -> IO (Maybe [Weight])-weigh args cases =+weighDispatch :: [String] -- ^ Program arguments.+ -> [(String,Action)] -- ^ Weigh name:action mapping.+ -> IO (Maybe [Weight])+weighDispatch args cases = case args of ("--case":label:_) -> case lookup label (deepseq (map fst cases) cases) of@@ -185,10 +233,16 @@ ["--case",label,"+RTS","-T","-RTS"] "" case exit of- ExitFailure{} -> error ("Error in case (" ++ show label ++ "):\n " ++ err)+ ExitFailure{} ->+ error ("Error in case (" ++ show label ++ "):\n " ++ err) ExitSuccess ->- let !r = read out- in return r+ case reads out of+ [(!r,_)] -> return r+ _ ->+ error (concat ["Malformed output from subprocess. Weigh"+ ," (currently) communicates with its sub-"+ ,"processes via stdout. Remove any other "+ ,"output from your process."]) -- | Weigh a pure function. This function is heavily documented inside. weighFunc
weigh.cabal view
@@ -1,5 +1,5 @@ name: weigh-version: 0.0.2+version: 0.0.3 synopsis: Measure allocations of a Haskell functions/values description: Please see README.md homepage: https://github.com/fpco/weigh#readme