    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE DeriveFoldable #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE BangPatterns #-}

    -- | Framework for seeing how much a function allocates.
    --
    -- WARNING: weigh is incompatible with profiling. It reports much more
    -- allocations with profiling turned on.
    --
    -- 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)
    -- @
    --
    -- Use 'wgroup' to group sets of tests.

    module Weigh
      (-- * Main entry points
       mainWith
      ,weighResults
      -- * Configuration
      ,setColumns
      ,Column(..)
      ,setFormat
      ,Format (..)
      ,setConfig
      ,Config (..)
      ,defaultConfig
      -- * Simple combinators
      ,func
      ,func'
      ,io
      ,value
      ,action
      ,wgroup
      -- * Validating combinators
      ,validateAction
      ,validateFunc
      -- * Validators
      ,maxAllocs
      -- * Types
      ,Weigh
      ,Weight(..)
      -- * Handy utilities
      ,commas
      ,reportGroup
      -- * Internals
      ,weighDispatch
      ,weighFunc
      ,weighFuncResult
      ,weighAction
      ,weighActionResult
      ,Grouped(..)
      )
      where

    import Control.Applicative
    import Control.Arrow
    import Control.DeepSeq
    #if MIN_VERSION_base(4,18,0)
    import Control.Monad (unless)
    #endif
    import Control.Monad.State
    import Criterion.Measurement
    import qualified Data.Foldable as Foldable
    import qualified Data.List as List
    import Data.List.Split
    import Data.Maybe
    import qualified Data.Traversable as Traversable
    import Data.Word
    import GHC.Generics
    import Prelude
    import System.Environment
    import System.Exit
    import System.IO
    import System.IO.Temp
    import System.Mem
    import System.Process
    import Text.Printf
    import qualified Weigh.GHCStats as GHCStats

    --------------------------------------------------------------------------------
    -- Types

    -- | Table column.
    data Column
      = Case      -- ^ Case name for the column
      | Allocated -- ^ Total bytes allocated
      | GCs       -- ^ Total number of GCs
      | Live      -- ^ Total amount of live data in the heap
      | Check     -- ^ Table column indicating about the test status
      | Max       -- ^ Maximum residency memory in use
      | MaxOS     -- ^ Maximum memory in use by the RTS. Valid only for
                  -- GHC >= 8.2.2. For unsupported GHC, this is reported
                  -- as 0.
      | WallTime  -- ^ Rough execution time. For general indication, not a benchmark tool.
      deriving (Int -> Column -> ShowS
    [Column] -> ShowS
    Column -> String
    (Int -> Column -> ShowS)
    -> (Column -> String) -> ([Column] -> ShowS) -> Show Column
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Column -> ShowS
    showsPrec :: Int -> Column -> ShowS
    $cshow :: Column -> String
    show :: Column -> String
    $cshowList :: [Column] -> ShowS
    showList :: [Column] -> ShowS
    Show, Column -> Column -> Bool
    (Column -> Column -> Bool)
    -> (Column -> Column -> Bool) -> Eq Column
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Column -> Column -> Bool
    == :: Column -> Column -> Bool
    $c/= :: Column -> Column -> Bool
    /= :: Column -> Column -> Bool
    Eq, Int -> Column
    Column -> Int
    Column -> [Column]
    Column -> Column
    Column -> Column -> [Column]
    Column -> Column -> Column -> [Column]
    (Column -> Column)
    -> (Column -> Column)
    -> (Int -> Column)
    -> (Column -> Int)
    -> (Column -> [Column])
    -> (Column -> Column -> [Column])
    -> (Column -> Column -> [Column])
    -> (Column -> Column -> Column -> [Column])
    -> Enum Column
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: Column -> Column
    succ :: Column -> Column
    $cpred :: Column -> Column
    pred :: Column -> Column
    $ctoEnum :: Int -> Column
    toEnum :: Int -> Column
    $cfromEnum :: Column -> Int
    fromEnum :: Column -> Int
    $cenumFrom :: Column -> [Column]
    enumFrom :: Column -> [Column]
    $cenumFromThen :: Column -> Column -> [Column]
    enumFromThen :: Column -> Column -> [Column]
    $cenumFromTo :: Column -> Column -> [Column]
    enumFromTo :: Column -> Column -> [Column]
    $cenumFromThenTo :: Column -> Column -> Column -> [Column]
    enumFromThenTo :: Column -> Column -> Column -> [Column]
    Enum)

    -- | Weigh configuration.
    data Config = Config
      { Config -> [Column]
    configColumns :: [Column]
      , Config -> String
    configPrefix :: String
      , Config -> Format
    configFormat :: !Format
      } deriving (Int -> Config -> ShowS
    [Config] -> ShowS
    Config -> String
    (Int -> Config -> ShowS)
    -> (Config -> String) -> ([Config] -> ShowS) -> Show Config
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Config -> ShowS
    showsPrec :: Int -> Config -> ShowS
    $cshow :: Config -> String
    show :: Config -> String
    $cshowList :: [Config] -> ShowS
    showList :: [Config] -> ShowS
    Show)

    data Format = Plain | Markdown
      deriving (Int -> Format -> ShowS
    [Format] -> ShowS
    Format -> String
    (Int -> Format -> ShowS)
    -> (Format -> String) -> ([Format] -> ShowS) -> Show Format
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Format -> ShowS
    showsPrec :: Int -> Format -> ShowS
    $cshow :: Format -> String
    show :: Format -> String
    $cshowList :: [Format] -> ShowS
    showList :: [Format] -> ShowS
    Show)

    -- | Weigh specification monad.
    newtype Weigh a =
      Weigh {forall a. Weigh a -> State (Config, [Grouped Action]) a
    runWeigh :: State (Config, [Grouped Action]) a}
      deriving (Applicative Weigh
    Applicative Weigh =>
    (forall a b. Weigh a -> (a -> Weigh b) -> Weigh b)
    -> (forall a b. Weigh a -> Weigh b -> Weigh b)
    -> (forall a. a -> Weigh a)
    -> Monad Weigh
    forall a. a -> Weigh a
    forall a b. Weigh a -> Weigh b -> Weigh b
    forall a b. Weigh a -> (a -> Weigh b) -> Weigh b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. Weigh a -> (a -> Weigh b) -> Weigh b
    >>= :: forall a b. Weigh a -> (a -> Weigh b) -> Weigh b
    $c>> :: forall a b. Weigh a -> Weigh b -> Weigh b
    >> :: forall a b. Weigh a -> Weigh b -> Weigh b
    $creturn :: forall a. a -> Weigh a
    return :: forall a. a -> Weigh a
    Monad,(forall a b. (a -> b) -> Weigh a -> Weigh b)
    -> (forall a b. a -> Weigh b -> Weigh a) -> Functor Weigh
    forall a b. a -> Weigh b -> Weigh a
    forall a b. (a -> b) -> Weigh a -> Weigh b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Weigh a -> Weigh b
    fmap :: forall a b. (a -> b) -> Weigh a -> Weigh b
    $c<$ :: forall a b. a -> Weigh b -> Weigh a
    <$ :: forall a b. a -> Weigh b -> Weigh a
    Functor,Functor Weigh
    Functor Weigh =>
    (forall a. a -> Weigh a)
    -> (forall a b. Weigh (a -> b) -> Weigh a -> Weigh b)
    -> (forall a b c. (a -> b -> c) -> Weigh a -> Weigh b -> Weigh c)
    -> (forall a b. Weigh a -> Weigh b -> Weigh b)
    -> (forall a b. Weigh a -> Weigh b -> Weigh a)
    -> Applicative Weigh
    forall a. a -> Weigh a
    forall a b. Weigh a -> Weigh b -> Weigh a
    forall a b. Weigh a -> Weigh b -> Weigh b
    forall a b. Weigh (a -> b) -> Weigh a -> Weigh b
    forall a b c. (a -> b -> c) -> Weigh a -> Weigh b -> Weigh c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> Weigh a
    pure :: forall a. a -> Weigh a
    $c<*> :: forall a b. Weigh (a -> b) -> Weigh a -> Weigh b
    <*> :: forall a b. Weigh (a -> b) -> Weigh a -> Weigh b
    $cliftA2 :: forall a b c. (a -> b -> c) -> Weigh a -> Weigh b -> Weigh c
    liftA2 :: forall a b c. (a -> b -> c) -> Weigh a -> Weigh b -> Weigh c
    $c*> :: forall a b. Weigh a -> Weigh b -> Weigh b
    *> :: forall a b. Weigh a -> Weigh b -> Weigh b
    $c<* :: forall a b. Weigh a -> Weigh b -> Weigh a
    <* :: forall a b. Weigh a -> Weigh b -> Weigh a
    Applicative)

    -- | How much a computation weighed in at.
    data Weight =
      Weight {Weight -> String
    weightLabel :: !String
             ,Weight -> Word64
    weightAllocatedBytes :: !Word64
             ,Weight -> Word32
    weightGCs :: !Word32
             ,Weight -> Word64
    weightLiveBytes :: !Word64
             ,Weight -> Word64
    weightMaxBytes :: !Word64
             ,Weight -> Word64
    weightMaxOSBytes :: !Word64
             ,Weight -> Double
    weightWallTime :: !Double
             }
      deriving (ReadPrec [Weight]
    ReadPrec Weight
    Int -> ReadS Weight
    ReadS [Weight]
    (Int -> ReadS Weight)
    -> ReadS [Weight]
    -> ReadPrec Weight
    -> ReadPrec [Weight]
    -> Read Weight
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Weight
    readsPrec :: Int -> ReadS Weight
    $creadList :: ReadS [Weight]
    readList :: ReadS [Weight]
    $creadPrec :: ReadPrec Weight
    readPrec :: ReadPrec Weight
    $creadListPrec :: ReadPrec [Weight]
    readListPrec :: ReadPrec [Weight]
    Read,Int -> Weight -> ShowS
    [Weight] -> ShowS
    Weight -> String
    (Int -> Weight -> ShowS)
    -> (Weight -> String) -> ([Weight] -> ShowS) -> Show Weight
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Weight -> ShowS
    showsPrec :: Int -> Weight -> ShowS
    $cshow :: Weight -> String
    show :: Weight -> String
    $cshowList :: [Weight] -> ShowS
    showList :: [Weight] -> ShowS
    Show)

    -- | Some grouped thing.
    data Grouped a
      = Grouped String [Grouped a]
      | Singleton a
      deriving (Grouped a -> Grouped a -> Bool
    (Grouped a -> Grouped a -> Bool)
    -> (Grouped a -> Grouped a -> Bool) -> Eq (Grouped a)
    forall a. Eq a => Grouped a -> Grouped a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => Grouped a -> Grouped a -> Bool
    == :: Grouped a -> Grouped a -> Bool
    $c/= :: forall a. Eq a => Grouped a -> Grouped a -> Bool
    /= :: Grouped a -> Grouped a -> Bool
    Eq, Int -> Grouped a -> ShowS
    [Grouped a] -> ShowS
    Grouped a -> String
    (Int -> Grouped a -> ShowS)
    -> (Grouped a -> String)
    -> ([Grouped a] -> ShowS)
    -> Show (Grouped a)
    forall a. Show a => Int -> Grouped a -> ShowS
    forall a. Show a => [Grouped a] -> ShowS
    forall a. Show a => Grouped a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Grouped a -> ShowS
    showsPrec :: Int -> Grouped a -> ShowS
    $cshow :: forall a. Show a => Grouped a -> String
    show :: Grouped a -> String
    $cshowList :: forall a. Show a => [Grouped a] -> ShowS
    showList :: [Grouped a] -> ShowS
    Show, (forall a b. (a -> b) -> Grouped a -> Grouped b)
    -> (forall a b. a -> Grouped b -> Grouped a) -> Functor Grouped
    forall a b. a -> Grouped b -> Grouped a
    forall a b. (a -> b) -> Grouped a -> Grouped b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Grouped a -> Grouped b
    fmap :: forall a b. (a -> b) -> Grouped a -> Grouped b
    $c<$ :: forall a b. a -> Grouped b -> Grouped a
    <$ :: forall a b. a -> Grouped b -> Grouped a
    Functor, Functor Grouped
    Foldable Grouped
    (Functor Grouped, Foldable Grouped) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> Grouped a -> f (Grouped b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        Grouped (f a) -> f (Grouped a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> Grouped a -> m (Grouped b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        Grouped (m a) -> m (Grouped a))
    -> Traversable Grouped
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a. Monad m => Grouped (m a) -> m (Grouped a)
    forall (f :: * -> *) a.
    Applicative f =>
    Grouped (f a) -> f (Grouped a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Grouped a -> m (Grouped b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Grouped a -> f (Grouped b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Grouped a -> f (Grouped b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Grouped a -> f (Grouped b)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    Grouped (f a) -> f (Grouped a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    Grouped (f a) -> f (Grouped a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Grouped a -> m (Grouped b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Grouped a -> m (Grouped b)
    $csequence :: forall (m :: * -> *) a. Monad m => Grouped (m a) -> m (Grouped a)
    sequence :: forall (m :: * -> *) a. Monad m => Grouped (m a) -> m (Grouped a)
    Traversable.Traversable, (forall m. Monoid m => Grouped m -> m)
    -> (forall m a. Monoid m => (a -> m) -> Grouped a -> m)
    -> (forall m a. Monoid m => (a -> m) -> Grouped a -> m)
    -> (forall a b. (a -> b -> b) -> b -> Grouped a -> b)
    -> (forall a b. (a -> b -> b) -> b -> Grouped a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Grouped a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Grouped a -> b)
    -> (forall a. (a -> a -> a) -> Grouped a -> a)
    -> (forall a. (a -> a -> a) -> Grouped a -> a)
    -> (forall a. Grouped a -> [a])
    -> (forall a. Grouped a -> Bool)
    -> (forall a. Grouped a -> Int)
    -> (forall a. Eq a => a -> Grouped a -> Bool)
    -> (forall a. Ord a => Grouped a -> a)
    -> (forall a. Ord a => Grouped a -> a)
    -> (forall a. Num a => Grouped a -> a)
    -> (forall a. Num a => Grouped a -> a)
    -> Foldable Grouped
    forall a. Eq a => a -> Grouped a -> Bool
    forall a. Num a => Grouped a -> a
    forall a. Ord a => Grouped a -> a
    forall m. Monoid m => Grouped m -> m
    forall a. Grouped a -> Bool
    forall a. Grouped a -> Int
    forall a. Grouped a -> [a]
    forall a. (a -> a -> a) -> Grouped a -> a
    forall m a. Monoid m => (a -> m) -> Grouped a -> m
    forall b a. (b -> a -> b) -> b -> Grouped a -> b
    forall a b. (a -> b -> b) -> b -> Grouped a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall m. Monoid m => Grouped m -> m
    fold :: forall m. Monoid m => Grouped m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> Grouped a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> Grouped a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Grouped a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> Grouped a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> Grouped a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> Grouped a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> Grouped a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> Grouped a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> Grouped a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> Grouped a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> Grouped a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> Grouped a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> Grouped a -> a
    foldr1 :: forall a. (a -> a -> a) -> Grouped a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> Grouped a -> a
    foldl1 :: forall a. (a -> a -> a) -> Grouped a -> a
    $ctoList :: forall a. Grouped a -> [a]
    toList :: forall a. Grouped a -> [a]
    $cnull :: forall a. Grouped a -> Bool
    null :: forall a. Grouped a -> Bool
    $clength :: forall a. Grouped a -> Int
    length :: forall a. Grouped a -> Int
    $celem :: forall a. Eq a => a -> Grouped a -> Bool
    elem :: forall a. Eq a => a -> Grouped a -> Bool
    $cmaximum :: forall a. Ord a => Grouped a -> a
    maximum :: forall a. Ord a => Grouped a -> a
    $cminimum :: forall a. Ord a => Grouped a -> a
    minimum :: forall a. Ord a => Grouped a -> a
    $csum :: forall a. Num a => Grouped a -> a
    sum :: forall a. Num a => Grouped a -> a
    $cproduct :: forall a. Num a => Grouped a -> a
    product :: forall a. Num a => Grouped a -> a
    Foldable.Foldable, (forall x. Grouped a -> Rep (Grouped a) x)
    -> (forall x. Rep (Grouped a) x -> Grouped a)
    -> Generic (Grouped a)
    forall x. Rep (Grouped a) x -> Grouped a
    forall x. Grouped a -> Rep (Grouped a) x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    forall a x. Rep (Grouped a) x -> Grouped a
    forall a x. Grouped a -> Rep (Grouped a) x
    $cfrom :: forall a x. Grouped a -> Rep (Grouped a) x
    from :: forall x. Grouped a -> Rep (Grouped a) x
    $cto :: forall a x. Rep (Grouped a) x -> Grouped a
    to :: forall x. Rep (Grouped a) x -> Grouped a
    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
             ,Action -> String
    actionName :: !String
             ,Action -> Weight -> Maybe String
    actionCheck :: Weight -> Maybe String}
    instance NFData Action where rnf :: Action -> ()
    rnf Action
    _ = ()

    --------------------------------------------------------------------------------
    -- Main-runners

    -- | Just run the measuring and print a report. Uses 'weighResults'.
    mainWith :: Weigh a -> IO ()
    mainWith :: forall a. Weigh a -> IO ()
    mainWith Weigh a
    m = do
      ([Grouped (Weight, Maybe String)]
    results, Config
    config) <- Weigh a -> IO ([Grouped (Weight, Maybe String)], Config)
    forall a. Weigh a -> IO ([Grouped (Weight, Maybe String)], Config)
    weighResults Weigh a
    m
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless
        ([Grouped (Weight, Maybe String)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Grouped (Weight, Maybe String)]
    results)
        (do String -> IO ()
    putStrLn String
    ""
            String -> IO ()
    putStrLn (Config -> [Grouped (Weight, Maybe String)] -> String
    report Config
    config [Grouped (Weight, Maybe String)]
    results))
      case ((Weight, Maybe String) -> Maybe (Weight, String))
    -> [(Weight, Maybe String)] -> [(Weight, String)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
             (\(Weight
    w, Maybe String
    r) -> do
                String
    msg <- Maybe String
    r
                (Weight, String) -> Maybe (Weight, String)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Weight
    w, String
    msg))
             ((Grouped (Weight, Maybe String) -> [(Weight, Maybe String)])
    -> [Grouped (Weight, Maybe String)] -> [(Weight, Maybe String)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Grouped (Weight, Maybe String) -> [(Weight, Maybe String)]
    forall a. Grouped a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    Foldable.toList ([Grouped (Weight, Maybe String)]
    -> [Grouped (Weight, Maybe String)]
    forall a. [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    Foldable.toList [Grouped (Weight, Maybe String)]
    results)) of
        [] -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        [(Weight, String)]
    errors -> do
          String -> IO ()
    putStrLn String
    "\nCheck problems:"
          ((Weight, String) -> IO ()) -> [(Weight, String)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_
            (\(Weight
    w, String
    r) -> String -> IO ()
    putStrLn (String
    "  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Weight -> String
    weightLabel Weight
    w String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n    " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    r))
            [(Weight, String)]
    errors
          ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure (-Int
    1))

    -- | Run the measuring and return all the results, each one may have
    -- an error.
    weighResults
      :: Weigh a -> IO ([Grouped (Weight,Maybe String)], Config)
    weighResults :: forall a. Weigh a -> IO ([Grouped (Weight, Maybe String)], Config)
    weighResults Weigh a
    m = do
      [String]
    args <- IO [String]
    getArgs
      Maybe String
    weighEnv <- String -> IO (Maybe String)
    lookupEnv String
    "WEIGH_CASE"
      let (Config
    config, [Grouped Action]
    cases) = State (Config, [Grouped Action]) a
    -> (Config, [Grouped Action]) -> (Config, [Grouped Action])
    forall s a. State s a -> s -> s
    execState (Weigh a -> State (Config, [Grouped Action]) a
    forall a. Weigh a -> State (Config, [Grouped Action]) a
    runWeigh Weigh a
    m) (Config
    defaultConfig, [])
      Maybe [Grouped Weight]
    result <- Maybe String -> [Grouped Action] -> IO (Maybe [Grouped Weight])
    weighDispatch Maybe String
    weighEnv [Grouped Action]
    cases
      case Maybe [Grouped Weight]
    result of
        Maybe [Grouped Weight]
    Nothing -> ([Grouped (Weight, Maybe String)], Config)
    -> IO ([Grouped (Weight, Maybe String)], Config)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], Config
    config)
        Just [Grouped Weight]
    weights ->
          ([Grouped (Weight, Maybe String)], Config)
    -> IO ([Grouped (Weight, Maybe String)], Config)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            ( (Grouped Weight -> Grouped (Weight, Maybe String))
    -> [Grouped Weight] -> [Grouped (Weight, Maybe String)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap
                ((Weight -> (Weight, Maybe String))
    -> Grouped Weight -> Grouped (Weight, Maybe String)
    forall a b. (a -> b) -> Grouped a -> Grouped b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap
                   (\Weight
    w ->
                      case String -> [Grouped Action] -> Maybe Action
    glookup (Weight -> String
    weightLabel Weight
    w) [Grouped Action]
    cases of
                        Maybe Action
    Nothing -> (Weight
    w, Maybe String
    forall a. Maybe a
    Nothing)
                        Just Action
    a -> (Weight
    w, Action -> Weight -> Maybe String
    actionCheck Action
    a Weight
    w)))
                [Grouped Weight]
    weights
            , Config
    config
              { configFormat =
                  if any (== "--markdown") args
                    then Markdown
                    else configFormat config
              })

    --------------------------------------------------------------------------------
    -- User DSL

    -- | Default columns to display.
    defaultColumns :: [Column]
    defaultColumns :: [Column]
    defaultColumns = [Column
    Case, Column
    Allocated, Column
    GCs]

    -- | Default config.
    defaultConfig :: Config
    defaultConfig :: Config
    defaultConfig =
      Config
      {configColumns :: [Column]
    configColumns = [Column]
    defaultColumns, configPrefix :: String
    configPrefix = String
    "", configFormat :: Format
    configFormat = Format
    Plain}

    -- | Set the columns to display in the config
    setColumns :: [Column] -> Weigh ()
    setColumns :: [Column] -> Weigh ()
    setColumns [Column]
    cs = State (Config, [Grouped Action]) () -> Weigh ()
    forall a. State (Config, [Grouped Action]) a -> Weigh a
    Weigh (((Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> State (Config, [Grouped Action]) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Config -> Config)
    -> (Config, [Grouped Action]) -> (Config, [Grouped Action])
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (\Config
    c -> Config
    c {configColumns = cs})))

    -- | Set the output format in the config
    setFormat :: Format -> Weigh ()
    setFormat :: Format -> Weigh ()
    setFormat Format
    fm = State (Config, [Grouped Action]) () -> Weigh ()
    forall a. State (Config, [Grouped Action]) a -> Weigh a
    Weigh (((Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> State (Config, [Grouped Action]) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Config -> Config)
    -> (Config, [Grouped Action]) -> (Config, [Grouped Action])
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (\Config
    c -> Config
    c {configFormat = fm})))

    -- | Set the config. Default is: 'defaultConfig'.
    setConfig :: Config -> Weigh ()
    setConfig :: Config -> Weigh ()
    setConfig = State (Config, [Grouped Action]) () -> Weigh ()
    forall a. State (Config, [Grouped Action]) a -> Weigh a
    Weigh (State (Config, [Grouped Action]) () -> Weigh ())
    -> (Config -> State (Config, [Grouped Action]) ())
    -> Config
    -> Weigh ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> State (Config, [Grouped Action]) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (((Config, [Grouped Action]) -> (Config, [Grouped Action]))
     -> State (Config, [Grouped Action]) ())
    -> (Config
        -> (Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> Config
    -> State (Config, [Grouped Action]) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Config -> Config)
    -> (Config, [Grouped Action]) -> (Config, [Grouped Action])
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Config -> Config)
     -> (Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> (Config -> Config -> Config)
    -> Config
    -> (Config, [Grouped Action])
    -> (Config, [Grouped Action])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Config -> Config -> Config
    forall a b. a -> b -> a
    const

    -- | Weigh a function applied to an argument.
    --
    -- Implemented in terms of 'validateFunc'.
    func :: (NFData a)
         => String   -- ^ Name of the case.
         -> (b -> a) -- ^ Function that does some action to measure.
         -> b        -- ^ Argument to that function.
         -> Weigh ()
    func :: forall a b. NFData a => String -> (b -> a) -> b -> Weigh ()
    func String
    name !b -> a
    f !b
    x = String -> (b -> a) -> b -> (Weight -> Maybe String) -> Weigh ()
    forall a b.
    NFData a =>
    String -> (b -> a) -> b -> (Weight -> Maybe String) -> Weigh ()
    validateFunc String
    name b -> a
    f b
    x (Maybe String -> Weight -> Maybe String
    forall a b. a -> b -> a
    const Maybe String
    forall a. Maybe a
    Nothing)

    -- | Weigh a function applied to an argument. Unlike 'func', the argument
    -- is evaluated to normal form before the function is applied.
    func' :: (NFData a, NFData b)
          => String
          -> (b -> a)
          -> b
          -> Weigh ()
    func' :: forall a b.
    (NFData a, NFData b) =>
    String -> (b -> a) -> b -> Weigh ()
    func' String
    name !b -> a
    f (b -> b
    forall a. NFData a => a -> a
    force -> !b
    x) = String -> (b -> a) -> b -> (Weight -> Maybe String) -> Weigh ()
    forall a b.
    NFData a =>
    String -> (b -> a) -> b -> (Weight -> Maybe String) -> Weigh ()
    validateFunc String
    name b -> a
    f b
    x (Maybe String -> Weight -> Maybe String
    forall a b. a -> b -> a
    const Maybe String
    forall a. Maybe a
    Nothing)

    -- | Weigh an action applied to an argument.
    --
    -- Implemented in terms of 'validateAction'.
    io :: (NFData a)
       => String      -- ^ Name of the case.
       -> (b -> IO a) -- ^ Action that does some IO to measure.
       -> b           -- ^ Argument to that function.
       -> Weigh ()
    io :: forall a b. NFData a => String -> (b -> IO a) -> b -> Weigh ()
    io String
    name !b -> IO a
    f !b
    x = String -> (b -> IO a) -> b -> (Weight -> Maybe String) -> Weigh ()
    forall a b.
    NFData a =>
    String -> (b -> IO a) -> b -> (Weight -> Maybe String) -> Weigh ()
    validateAction String
    name b -> IO a
    f b
    x (Maybe String -> Weight -> Maybe String
    forall a b. a -> b -> a
    const Maybe String
    forall a. Maybe a
    Nothing)

    -- | Weigh a value.
    --
    -- Implemented in terms of 'action'.
    value :: NFData a
          => String -- ^ Name for the value.
          -> a      -- ^ The value to measure.
          -> Weigh ()
    value :: forall a. NFData a => String -> a -> Weigh ()
    value String
    name !a
    v = String -> (a -> a) -> a -> Weigh ()
    forall a b. NFData a => String -> (b -> a) -> b -> Weigh ()
    func String
    name a -> a
    forall a. a -> a
    id a
    v

    -- | Weigh an IO action.
    --
    -- Implemented in terms of 'validateAction'.
    action :: NFData a
           => String -- ^ Name for the value.
           -> IO a   -- ^ The action to measure.
           -> Weigh ()
    action :: forall a. NFData a => String -> IO a -> Weigh ()
    action String
    name !IO a
    m = String -> (() -> IO a) -> () -> Weigh ()
    forall a b. NFData a => String -> (b -> IO a) -> b -> Weigh ()
    io String
    name (IO a -> () -> IO a
    forall a b. a -> b -> a
    const IO a
    m) ()

    -- | Make a validator that set sthe maximum allocations.
    maxAllocs :: Word64 -- ^ The upper bound.
              -> (Weight -> Maybe String)
    maxAllocs :: Word64 -> Weight -> Maybe String
    maxAllocs Word64
    n =
      \Weight
    w ->
        if Weight -> Word64
    weightAllocatedBytes Weight
    w Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word64
    n
           then String -> Maybe String
    forall a. a -> Maybe a
    Just (String
    "Allocated bytes exceeds " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                      Word64 -> String
    forall a. (Num a, Integral a, Show a) => a -> String
    commas Word64
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word64 -> String
    forall a. (Num a, Integral a, Show a) => a -> String
    commas (Weight -> Word64
    weightAllocatedBytes Weight
    w))
           else Maybe String
    forall a. Maybe a
    Nothing

    -- | Weigh an IO action, validating the result.
    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 :: forall a b.
    NFData a =>
    String -> (b -> IO a) -> b -> (Weight -> Maybe String) -> Weigh ()
    validateAction String
    name !b -> IO a
    m !b
    arg !Weight -> Maybe String
    validate =
      String -> (String -> Action) -> Weigh ()
    tellAction String
    name ((String -> Action) -> Weigh ()) -> (String -> Action) -> Weigh ()
    forall a b. (a -> b) -> a -> b
    $ (String -> (Weight -> Maybe String) -> Action)
    -> (Weight -> Maybe String) -> String -> Action
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Either (b -> IO a) (b -> a)
    -> b -> String -> (Weight -> Maybe String) -> Action
    forall a b.
    NFData a =>
    Either (b -> IO a) (b -> a)
    -> b -> String -> (Weight -> Maybe String) -> Action
    Action ((b -> IO a) -> Either (b -> IO a) (b -> a)
    forall a b. a -> Either a b
    Left b -> IO a
    m) b
    arg) Weight -> Maybe String
    validate

    -- | Weigh a function, validating the result
    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 :: forall a b.
    NFData a =>
    String -> (b -> a) -> b -> (Weight -> Maybe String) -> Weigh ()
    validateFunc String
    name !b -> a
    f !b
    x !Weight -> Maybe String
    validate =
      String -> (String -> Action) -> Weigh ()
    tellAction String
    name ((String -> Action) -> Weigh ()) -> (String -> Action) -> Weigh ()
    forall a b. (a -> b) -> a -> b
    $ (String -> (Weight -> Maybe String) -> Action)
    -> (Weight -> Maybe String) -> String -> Action
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Either (b -> IO a) (b -> a)
    -> b -> String -> (Weight -> Maybe String) -> Action
    forall a b.
    NFData a =>
    Either (b -> IO a) (b -> a)
    -> b -> String -> (Weight -> Maybe String) -> Action
    Action ((b -> a) -> Either (b -> IO a) (b -> a)
    forall a b. b -> Either a b
    Right b -> a
    f) b
    x)  Weight -> Maybe String
    validate

    -- | Write out an action.
    tellAction :: String -> (String -> Action) -> Weigh ()
    tellAction :: String -> (String -> Action) -> Weigh ()
    tellAction String
    name String -> Action
    act =
      State (Config, [Grouped Action]) () -> Weigh ()
    forall a. State (Config, [Grouped Action]) a -> Weigh a
    Weigh (do String
    prefix <- ((Config, [Grouped Action]) -> String)
    -> StateT (Config, [Grouped Action]) Identity String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Config -> String
    configPrefix (Config -> String)
    -> ((Config, [Grouped Action]) -> Config)
    -> (Config, [Grouped Action])
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Config, [Grouped Action]) -> Config
    forall a b. (a, b) -> a
    fst)
                ((Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> State (Config, [Grouped Action]) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (([Grouped Action] -> [Grouped Action])
    -> (Config, [Grouped Action]) -> (Config, [Grouped Action])
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (\[Grouped Action]
    x -> [Grouped Action]
    x [Grouped Action] -> [Grouped Action] -> [Grouped Action]
    forall a. [a] -> [a] -> [a]
    ++ [Action -> Grouped Action
    forall a. a -> Grouped a
    Singleton (Action -> Grouped Action) -> Action -> Grouped Action
    forall a b. (a -> b) -> a -> b
    $ String -> Action
    act (String
    prefix String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name)])))

    -- | Make a grouping of tests.
    wgroup :: String -> Weigh () -> Weigh ()
    wgroup :: String -> Weigh () -> Weigh ()
    wgroup String
    str Weigh ()
    wei = do
      (Config
    orig, [Grouped Action]
    start) <- State (Config, [Grouped Action]) (Config, [Grouped Action])
    -> Weigh (Config, [Grouped Action])
    forall a. State (Config, [Grouped Action]) a -> Weigh a
    Weigh State (Config, [Grouped Action]) (Config, [Grouped Action])
    forall s (m :: * -> *). MonadState s m => m s
    get
      let startL :: Int
    startL = [Grouped Action] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Grouped Action] -> Int) -> [Grouped Action] -> Int
    forall a b. (a -> b) -> a -> b
    $ [Grouped Action]
    start
      State (Config, [Grouped Action]) () -> Weigh ()
    forall a. State (Config, [Grouped Action]) a -> Weigh a
    Weigh (((Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> State (Config, [Grouped Action]) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Config -> Config)
    -> (Config, [Grouped Action]) -> (Config, [Grouped Action])
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (\Config
    c -> Config
    c {configPrefix = configPrefix orig ++ "/" ++ str})))
      Weigh ()
    wei
      State (Config, [Grouped Action]) () -> Weigh ()
    forall a. State (Config, [Grouped Action]) a -> Weigh a
    Weigh (State (Config, [Grouped Action]) () -> Weigh ())
    -> State (Config, [Grouped Action]) () -> Weigh ()
    forall a b. (a -> b) -> a -> b
    $ do
        ((Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> State (Config, [Grouped Action]) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (((Config, [Grouped Action]) -> (Config, [Grouped Action]))
     -> State (Config, [Grouped Action]) ())
    -> ((Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> State (Config, [Grouped Action]) ()
    forall a b. (a -> b) -> a -> b
    $ ([Grouped Action] -> [Grouped Action])
    -> (Config, [Grouped Action]) -> (Config, [Grouped Action])
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (([Grouped Action] -> [Grouped Action])
     -> (Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> ([Grouped Action] -> [Grouped Action])
    -> (Config, [Grouped Action])
    -> (Config, [Grouped Action])
    forall a b. (a -> b) -> a -> b
    $ \[Grouped Action]
    x -> Int -> [Grouped Action] -> [Grouped Action]
    forall a. Int -> [a] -> [a]
    take Int
    startL [Grouped Action]
    x [Grouped Action] -> [Grouped Action] -> [Grouped Action]
    forall a. [a] -> [a] -> [a]
    ++ [String -> [Grouped Action] -> Grouped Action
    forall a. String -> [Grouped a] -> Grouped a
    Grouped String
    str ([Grouped Action] -> Grouped Action)
    -> [Grouped Action] -> Grouped Action
    forall a b. (a -> b) -> a -> b
    $ Int -> [Grouped Action] -> [Grouped Action]
    forall a. Int -> [a] -> [a]
    drop Int
    startL [Grouped Action]
    x]
        ((Config, [Grouped Action]) -> (Config, [Grouped Action]))
    -> State (Config, [Grouped Action]) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((Config -> Config)
    -> (Config, [Grouped Action]) -> (Config, [Grouped Action])
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (\Config
    c -> Config
    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 :: Maybe String -- ^ The content of then env variable WEIGH_CASE.
                  -> [Grouped Action] -- ^ Weigh name:action mapping.
                  -> IO (Maybe [(Grouped Weight)])
    weighDispatch :: Maybe String -> [Grouped Action] -> IO (Maybe [Grouped Weight])
    weighDispatch Maybe String
    args [Grouped Action]
    cases =
      case Maybe String
    args of
        Just String
    var -> do
          let (String
    label:String
    fp:[String]
    _) = String -> [String]
    forall a. Read a => String -> a
    read String
    var
          let !String
    _ = ShowS
    forall a. NFData a => a -> a
    force String
    fp
          case String -> [Grouped Action] -> Maybe Action
    glookup String
    label ([Grouped Action] -> [Grouped Action]
    forall a. NFData a => a -> a
    force [Grouped Action]
    cases) of
            Maybe Action
    Nothing -> String -> IO (Maybe [Grouped Weight])
    forall a. HasCallStack => String -> a
    error String
    "No such case!"
            Just Action
    act -> do
              case Action
    act of
                Action !Either (b -> IO a) (b -> a)
    run b
    arg String
    _ Weight -> Maybe String
    _ -> do
                  IO ()
    initializeTime
                  Double
    start <- IO Double
    getTime
                  (Word64
    bytes, Word32
    gcs, Word64
    liveBytes, Word64
    maxByte, Word64
    maxOSBytes) <-
                    case Either (b -> IO a) (b -> a)
    run of
                      Right b -> a
    f -> (b -> a) -> b -> IO (Word64, Word32, Word64, Word64, Word64)
    forall a b.
    NFData a =>
    (b -> a) -> b -> IO (Word64, Word32, Word64, Word64, Word64)
    weighFunc b -> a
    f b
    arg
                      Left b -> IO a
    m -> (b -> IO a) -> b -> IO (Word64, Word32, Word64, Word64, Word64)
    forall a b.
    NFData a =>
    (b -> IO a) -> b -> IO (Word64, Word32, Word64, Word64, Word64)
    weighAction b -> IO a
    m b
    arg
                  Double
    end <- IO Double
    getTime
                  String -> String -> IO ()
    writeFile
                    String
    fp
                    (Weight -> String
    forall a. Show a => a -> String
    show
                       (Weight
                        { weightLabel :: String
    weightLabel = String
    label
                        , weightAllocatedBytes :: Word64
    weightAllocatedBytes = Word64
    bytes
                        , weightGCs :: Word32
    weightGCs = Word32
    gcs
                        , weightLiveBytes :: Word64
    weightLiveBytes = Word64
    liveBytes
                        , weightMaxBytes :: Word64
    weightMaxBytes = Word64
    maxByte
                        , weightMaxOSBytes :: Word64
    weightMaxOSBytes = Word64
    maxOSBytes
                        , weightWallTime :: Double
    weightWallTime = Double
    end Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    start
                        }))
              Maybe [Grouped Weight] -> IO (Maybe [Grouped Weight])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Grouped Weight]
    forall a. Maybe a
    Nothing
        Maybe String
    _ -> ([Grouped Weight] -> Maybe [Grouped Weight])
    -> IO [Grouped Weight] -> IO (Maybe [Grouped Weight])
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Grouped Weight] -> Maybe [Grouped Weight]
    forall a. a -> Maybe a
    Just ((Grouped Action -> IO (Grouped Weight))
    -> [Grouped Action] -> IO [Grouped Weight]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    Traversable.traverse ((Action -> IO Weight) -> Grouped Action -> IO (Grouped Weight)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Grouped a -> f (Grouped b)
    Traversable.traverse Action -> IO Weight
    fork) [Grouped Action]
    cases)

    -- | Lookup an action.
    glookup :: String -> [Grouped Action] -> Maybe Action
    glookup :: String -> [Grouped Action] -> Maybe Action
    glookup String
    label =
      (Action -> Bool) -> [Action] -> Maybe Action
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    Foldable.find ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    label) (String -> Bool) -> (Action -> String) -> Action -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Action -> String
    actionName) ([Action] -> Maybe Action)
    -> ([Grouped Action] -> [Action])
    -> [Grouped Action]
    -> Maybe Action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      [[Action]] -> [Action]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Action]] -> [Action])
    -> ([Grouped Action] -> [[Action]]) -> [Grouped Action] -> [Action]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Grouped Action -> [Action]) -> [Grouped Action] -> [[Action]]
    forall a b. (a -> b) -> [a] -> [b]
    map Grouped Action -> [Action]
    forall a. Grouped a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    Foldable.toList ([Grouped Action] -> [[Action]])
    -> ([Grouped Action] -> [Grouped Action])
    -> [Grouped Action]
    -> [[Action]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Grouped Action] -> [Grouped Action]
    forall a. [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    Foldable.toList

    -- | Fork a case and run it.
    fork :: Action -- ^ Label for the case.
         -> IO Weight
    fork :: Action -> IO Weight
    fork Action
    act =
      String -> (String -> Handle -> IO Weight) -> IO Weight
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    String -> (String -> Handle -> m a) -> m a
    withSystemTempFile
        String
    "weigh"
        (\String
    fp Handle
    h -> do
           Handle -> IO ()
    hClose Handle
    h
           String -> String -> IO ()
    setEnv String
    "WEIGH_CASE" (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. Show a => a -> String
    show ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [Action -> String
    actionName Action
    act,String
    fp]
           String
    me <- IO String
    getExecutablePath
           [String]
    args <- IO [String]
    getArgs
           (ExitCode
    exit, String
    _, String
    err) <-
             String -> [String] -> String -> IO (ExitCode, String, String)
    readProcessWithExitCode
               String
    me
               ([String]
    args [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "+RTS", String
    "-T", String
    "-RTS"])
               String
    ""
           case ExitCode
    exit of
             ExitFailure {} ->
               String -> IO Weight
    forall a. HasCallStack => String -> a
    error
                 (String
    "Error in case (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show (Action -> String
    actionName Action
    act) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "):\n  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    err)
             ExitCode
    ExitSuccess -> do
               String
    out <- String -> IO String
    readFile String
    fp
               case ReadS Weight
    forall a. Read a => ReadS a
    reads String
    out of
                 [(!Weight
    r, String
    _)] -> Weight -> IO Weight
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Weight
    r
                 [(Weight, String)]
    _ ->
                   String -> IO Weight
    forall a. HasCallStack => String -> a
    error
                     ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                        [ String
    "Malformed output from subprocess. Weigh"
                        , String
    " (currently) communicates with its sub-"
                        , String
    "processes via a temporary file."
                        ]))

    -- | Weigh a pure function. This function is built on top of `weighFuncResult`,
    --   which is heavily documented inside
    weighFunc
      :: (NFData a)
      => (b -> a)         -- ^ A function whose memory use we want to measure.
      -> b                -- ^ Argument to the function. Doesn't have to be forced.
      -> IO (Word64,Word32,Word64,Word64,Word64) -- ^ Bytes allocated and garbage collections.
    weighFunc :: forall a b.
    NFData a =>
    (b -> a) -> b -> IO (Word64, Word32, Word64, Word64, Word64)
    weighFunc b -> a
    run !b
    arg = (a, (Word64, Word32, Word64, Word64, Word64))
    -> (Word64, Word32, Word64, Word64, Word64)
    forall a b. (a, b) -> b
    snd ((a, (Word64, Word32, Word64, Word64, Word64))
     -> (Word64, Word32, Word64, Word64, Word64))
    -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    -> IO (Word64, Word32, Word64, Word64, Word64)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (b -> a) -> b -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    forall a b.
    NFData a =>
    (b -> a) -> b -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    weighFuncResult b -> a
    run b
    arg

    -- | Weigh a pure function and return the result. This function is heavily
    --   documented inside.
    weighFuncResult
      :: (NFData a)
      => (b -> a)         -- ^ A function whose memory use we want to measure.
      -> b                -- ^ Argument to the function. Doesn't have to be forced.
      -> IO (a, (Word64,Word32,Word64,Word64,Word64)) -- ^ Result, Bytes allocated, GCs.
    weighFuncResult :: forall a b.
    NFData a =>
    (b -> a) -> b -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    weighFuncResult b -> a
    run !b
    arg = do
      Word64
    ghcStatsSizeInBytes <- IO Word64
    GHCStats.getGhcStatsSizeInBytes
      IO ()
    performGC
         -- The above forces getStats data to be generated NOW.
      !RTSStats
    bootupStats <- IO RTSStats
    GHCStats.getStats
         -- We need the above to subtract "program startup" overhead. This
         -- operation itself adds n bytes for the size of GCStats, but we
         -- subtract again that later.
      let !result :: a
    result = a -> a
    forall a. NFData a => a -> a
    force (b -> a
    run b
    arg)
      IO ()
    performGC
         -- The above forces getStats data to be generated NOW.
      !RTSStats
    actionStats <- IO RTSStats
    GHCStats.getStats
      let reflectionGCs :: Word32
    reflectionGCs = Word32
    1 -- We performed an additional GC.
          actionBytes :: Word64
    actionBytes =
            (RTSStats -> Word64
    GHCStats.totalBytesAllocated RTSStats
    actionStats Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
             RTSStats -> Word64
    GHCStats.totalBytesAllocated RTSStats
    bootupStats) Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
               -- We subtract the size of "bootupStats", which will be
               -- included after we did the performGC.
            Word64 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    ghcStatsSizeInBytes
          actionGCs :: Word32
    actionGCs =
            RTSStats -> Word32
    GHCStats.gcCount RTSStats
    actionStats Word32 -> Word32 -> Word32
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting` RTSStats -> Word32
    GHCStats.gcCount RTSStats
    bootupStats Word32 -> Word32 -> Word32
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
            Word32
    reflectionGCs
             -- If overheadBytes is too large, we conservatively just
             -- return zero. It's not perfect, but this library is for
             -- measuring large quantities anyway.
          actualBytes :: Word64
    actualBytes = Word64 -> Word64 -> Word64
    forall a. Ord a => a -> a -> a
    max Word64
    0 Word64
    actionBytes
          liveBytes :: Word64
    liveBytes =
            (RTSStats -> Word64
    GHCStats.liveBytes RTSStats
    actionStats Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
             RTSStats -> Word64
    GHCStats.liveBytes RTSStats
    bootupStats)
          maxBytes :: Word64
    maxBytes =
            (RTSStats -> Word64
    GHCStats.maxBytesInUse RTSStats
    actionStats Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
             RTSStats -> Word64
    GHCStats.maxBytesInUse RTSStats
    bootupStats)
          maxOSBytes :: Word64
    maxOSBytes =
            (RTSStats -> Word64
    GHCStats.maxOSBytes RTSStats
    actionStats Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
                RTSStats -> Word64
    GHCStats.maxOSBytes RTSStats
    bootupStats)
      (a, (Word64, Word32, Word64, Word64, Word64))
    -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    result, (Word64
    actualBytes, Word32
    actionGCs, Word64
    liveBytes, Word64
    maxBytes, Word64
    maxOSBytes))

    subtracting :: (Ord p, Num p) => p -> p -> p
    subtracting :: forall p. (Ord p, Num p) => p -> p -> p
    subtracting p
    x p
    y =
      if p
    x p -> p -> Bool
    forall a. Ord a => a -> a -> Bool
    > p
    y
        then p
    x p -> p -> p
    forall a. Num a => a -> a -> a
    - p
    y
        else p
    0

    -- | Weigh an IO action. This function is based on `weighActionResult`, which is
    --   heavily documented inside.
    weighAction
      :: (NFData a)
      => (b -> IO a)      -- ^ A function whose memory use we want to measure.
      -> b                -- ^ Argument to the function. Doesn't have to be forced.
      -> IO (Word64,Word32,Word64,Word64,Word64) -- ^ Bytes allocated and garbage collections.
    weighAction :: forall a b.
    NFData a =>
    (b -> IO a) -> b -> IO (Word64, Word32, Word64, Word64, Word64)
    weighAction b -> IO a
    run !b
    arg = (a, (Word64, Word32, Word64, Word64, Word64))
    -> (Word64, Word32, Word64, Word64, Word64)
    forall a b. (a, b) -> b
    snd ((a, (Word64, Word32, Word64, Word64, Word64))
     -> (Word64, Word32, Word64, Word64, Word64))
    -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    -> IO (Word64, Word32, Word64, Word64, Word64)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (b -> IO a)
    -> b -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    forall a b.
    NFData a =>
    (b -> IO a)
    -> b -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    weighActionResult b -> IO a
    run b
    arg

    -- | Weigh an IO action, and return the result. This function is heavily
    --   documented inside.
    weighActionResult
      :: (NFData a)
      => (b -> IO a)      -- ^ A function whose memory use we want to measure.
      -> b                -- ^ Argument to the function. Doesn't have to be forced.
      -> IO (a, (Word64,Word32,Word64,Word64,Word64)) -- ^ Result, Bytes allocated and GCs.
    weighActionResult :: forall a b.
    NFData a =>
    (b -> IO a)
    -> b -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    weighActionResult b -> IO a
    run !b
    arg = do
      Word64
    ghcStatsSizeInBytes <- IO Word64
    GHCStats.getGhcStatsSizeInBytes
      IO ()
    performGC
         -- The above forces getStats data to be generated NOW.
      !RTSStats
    bootupStats <- IO RTSStats
    GHCStats.getStats
         -- We need the above to subtract "program startup" overhead. This
         -- operation itself adds n bytes for the size of GCStats, but we
         -- subtract again that later.
      !a
    result <- (a -> a) -> IO a -> IO a
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> a
    forall a. NFData a => a -> a
    force (b -> IO a
    run b
    arg)
      IO ()
    performGC
         -- The above forces getStats data to be generated NOW.
      !RTSStats
    actionStats <- IO RTSStats
    GHCStats.getStats
      let reflectionGCs :: Word32
    reflectionGCs = Word32
    1 -- We performed an additional GC.
          actionBytes :: Word64
    actionBytes =
            (RTSStats -> Word64
    GHCStats.totalBytesAllocated RTSStats
    actionStats Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
             RTSStats -> Word64
    GHCStats.totalBytesAllocated RTSStats
    bootupStats) Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
               -- We subtract the size of "bootupStats", which will be
               -- included after we did the performGC.
            Word64 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    ghcStatsSizeInBytes
          actionGCs :: Word32
    actionGCs =
            RTSStats -> Word32
    GHCStats.gcCount RTSStats
    actionStats Word32 -> Word32 -> Word32
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting` RTSStats -> Word32
    GHCStats.gcCount RTSStats
    bootupStats Word32 -> Word32 -> Word32
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
            Word32
    reflectionGCs
             -- If overheadBytes is too large, we conservatively just
             -- return zero. It's not perfect, but this library is for
             -- measuring large quantities anyway.
          actualBytes :: Word64
    actualBytes = Word64 -> Word64 -> Word64
    forall a. Ord a => a -> a -> a
    max Word64
    0 Word64
    actionBytes
          liveBytes :: Word64
    liveBytes =
            Word64 -> Word64 -> Word64
    forall a. Ord a => a -> a -> a
    max Word64
    0 (RTSStats -> Word64
    GHCStats.liveBytes RTSStats
    actionStats Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting` RTSStats -> Word64
    GHCStats.liveBytes RTSStats
    bootupStats)
          maxBytes :: Word64
    maxBytes =
            Word64 -> Word64 -> Word64
    forall a. Ord a => a -> a -> a
    max
              Word64
    0
              (RTSStats -> Word64
    GHCStats.maxBytesInUse RTSStats
    actionStats Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
               RTSStats -> Word64
    GHCStats.maxBytesInUse RTSStats
    bootupStats)
          maxOSBytes :: Word64
    maxOSBytes =
            Word64 -> Word64 -> Word64
    forall a. Ord a => a -> a -> a
    max
              Word64
    0
              (RTSStats -> Word64
    GHCStats.maxOSBytes RTSStats
    actionStats Word64 -> Word64 -> Word64
    forall p. (Ord p, Num p) => p -> p -> p
    `subtracting`
               RTSStats -> Word64
    GHCStats.maxOSBytes RTSStats
    bootupStats)
      (a, (Word64, Word32, Word64, Word64, Word64))
    -> IO (a, (Word64, Word32, Word64, Word64, Word64))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    result,
        (  Word64
    actualBytes
        ,  Word32
    actionGCs
        ,  Word64
    liveBytes
        ,  Word64
    maxBytes
        ,  Word64
    maxOSBytes
        ))

    --------------------------------------------------------------------------------
    -- Formatting functions

    report :: Config -> [Grouped (Weight,Maybe String)] -> String
    report :: Config -> [Grouped (Weight, Maybe String)] -> String
    report Config
    config [Grouped (Weight, Maybe String)]
    gs =
      String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate
        String
    "\n\n"
        ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter
           (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null)
           [ if [(Weight, Maybe String)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Weight, Maybe String)]
    singletons
               then []
               else Config -> [(Weight, Maybe String)] -> String
    reportTabular Config
    config [(Weight, Maybe String)]
    singletons
           , String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate String
    "\n\n" (((String, [Grouped (Weight, Maybe String)]) -> String)
    -> [(String, [Grouped (Weight, Maybe String)])] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> [Grouped (Weight, Maybe String)] -> String)
    -> (String, [Grouped (Weight, Maybe String)]) -> String
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Config -> String -> [Grouped (Weight, Maybe String)] -> String
    reportGroup Config
    config)) [(String, [Grouped (Weight, Maybe String)])]
    groups)
           ])
      where
        singletons :: [(Weight, Maybe String)]
    singletons =
          (Grouped (Weight, Maybe String) -> Maybe (Weight, Maybe String))
    -> [Grouped (Weight, Maybe String)] -> [(Weight, Maybe String)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
            (\case
               Singleton (Weight, Maybe String)
    v -> (Weight, Maybe String) -> Maybe (Weight, Maybe String)
    forall a. a -> Maybe a
    Just (Weight, Maybe String)
    v
               Grouped (Weight, Maybe String)
    _ -> Maybe (Weight, Maybe String)
    forall a. Maybe a
    Nothing)
            [Grouped (Weight, Maybe String)]
    gs
        groups :: [(String, [Grouped (Weight, Maybe String)])]
    groups =
          (Grouped (Weight, Maybe String)
     -> Maybe (String, [Grouped (Weight, Maybe String)]))
    -> [Grouped (Weight, Maybe String)]
    -> [(String, [Grouped (Weight, Maybe String)])]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
            (\case
               Grouped String
    title [Grouped (Weight, Maybe String)]
    vs -> (String, [Grouped (Weight, Maybe String)])
    -> Maybe (String, [Grouped (Weight, Maybe String)])
    forall a. a -> Maybe a
    Just (String
    title, [Grouped (Weight, Maybe String)]
    vs)
               Grouped (Weight, Maybe String)
    _ -> Maybe (String, [Grouped (Weight, Maybe String)])
    forall a. Maybe a
    Nothing)
            [Grouped (Weight, Maybe String)]
    gs

    reportGroup :: Config -> [Char] -> [Grouped (Weight, Maybe String)] -> [Char]
    reportGroup :: Config -> String -> [Grouped (Weight, Maybe String)] -> String
    reportGroup Config
    config String
    title [Grouped (Weight, Maybe String)]
    gs =
      case Config -> Format
    configFormat Config
    config of
        Format
    Plain -> String
    title String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    indent (Config -> [Grouped (Weight, Maybe String)] -> String
    report Config
    config [Grouped (Weight, Maybe String)]
    gs)
        Format
    Markdown -> String
    "#" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    title String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Config -> [Grouped (Weight, Maybe String)] -> String
    report Config
    config [Grouped (Weight, Maybe String)]
    gs

    -- | Make a report of the weights.
    reportTabular :: Config -> [(Weight,Maybe String)] -> String
    reportTabular :: Config -> [(Weight, Maybe String)] -> String
    reportTabular Config
    config = [(Weight, Maybe String)] -> String
    forall {a}. [(Weight, Maybe a)] -> String
    tabled
      where
        tabled :: [(Weight, Maybe a)] -> String
    tabled =
          (case Config -> Format
    configFormat Config
    config of
             Format
    Plain -> [[(Bool, String)]] -> String
    tablize
             Format
    Markdown -> [[(Bool, String)]] -> String
    mdtable) ([[(Bool, String)]] -> String)
    -> ([(Weight, Maybe a)] -> [[(Bool, String)]])
    -> [(Weight, Maybe a)]
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          ([(Column, (Bool, String))] -> [(Bool, String)]
    forall {b}. [(Column, b)] -> [b]
    select [(Column, (Bool, String))]
    headings [(Bool, String)] -> [[(Bool, String)]] -> [[(Bool, String)]]
    forall a. a -> [a] -> [a]
    :) ([[(Bool, String)]] -> [[(Bool, String)]])
    -> ([(Weight, Maybe a)] -> [[(Bool, String)]])
    -> [(Weight, Maybe a)]
    -> [[(Bool, String)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Weight, Maybe a) -> [(Bool, String)])
    -> [(Weight, Maybe a)] -> [[(Bool, String)]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([(Column, (Bool, String))] -> [(Bool, String)]
    forall {b}. [(Column, b)] -> [b]
    select ([(Column, (Bool, String))] -> [(Bool, String)])
    -> ((Weight, Maybe a) -> [(Column, (Bool, String))])
    -> (Weight, Maybe a)
    -> [(Bool, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Weight, Maybe a) -> [(Column, (Bool, String))]
    forall {a}. (Weight, Maybe a) -> [(Column, (Bool, String))]
    toRow)
        select :: [(Column, b)] -> [b]
    select [(Column, b)]
    row = (Column -> Maybe b) -> [Column] -> [b]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\Column
    name -> Column -> [(Column, b)] -> Maybe b
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Column
    name [(Column, b)]
    row) (Config -> [Column]
    configColumns Config
    config)
        headings :: [(Column, (Bool, String))]
    headings =
          [ (Column
    Case, (Bool
    True, String
    "Case"))
          , (Column
    Allocated, (Bool
    False, String
    "Allocated"))
          , (Column
    GCs, (Bool
    False, String
    "GCs"))
          , (Column
    Live, (Bool
    False, String
    "Live"))
          , (Column
    Check, (Bool
    True, String
    "Check"))
          , (Column
    Max, (Bool
    False, String
    "Max"))
          , (Column
    MaxOS, (Bool
    False, String
    "MaxOS"))
          , (Column
    WallTime, (Bool
    False, String
    "Wall Time"))
          ]
        toRow :: (Weight, Maybe a) -> [(Column, (Bool, String))]
    toRow (Weight
    w, Maybe a
    err) =
          [ (Column
    Case, (Bool
    True, ShowS
    takeLastAfterBk ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Weight -> String
    weightLabel Weight
    w))
          , (Column
    Allocated, (Bool
    False, Word64 -> String
    forall a. (Num a, Integral a, Show a) => a -> String
    commas (Weight -> Word64
    weightAllocatedBytes Weight
    w)))
          , (Column
    GCs, (Bool
    False, Word32 -> String
    forall a. (Num a, Integral a, Show a) => a -> String
    commas (Weight -> Word32
    weightGCs Weight
    w)))
          , (Column
    Live, (Bool
    False, Word64 -> String
    forall a. (Num a, Integral a, Show a) => a -> String
    commas (Weight -> Word64
    weightLiveBytes Weight
    w)))
          , (Column
    Max, (Bool
    False, Word64 -> String
    forall a. (Num a, Integral a, Show a) => a -> String
    commas (Weight -> Word64
    weightMaxBytes Weight
    w)))
          , (Column
    MaxOS, (Bool
    False, Word64 -> String
    forall a. (Num a, Integral a, Show a) => a -> String
    commas (Weight -> Word64
    weightMaxOSBytes Weight
    w)))
          , (Column
    WallTime, (Bool
    False, String -> Double -> String
    forall r. PrintfType r => String -> r
    printf String
    "%.3fs" (Weight -> Double
    weightWallTime Weight
    w)))
          , ( Column
    Check
            , ( Bool
    True
              , case Maybe a
    err of
                  Maybe a
    Nothing -> String
    "OK"
                  Just {} -> String
    "INVALID"))
          ]
        takeLastAfterBk :: ShowS
    takeLastAfterBk String
    w = case Char -> String -> [Int]
    forall a. Eq a => a -> [a] -> [Int]
    List.elemIndices Char
    '/' String
    w of
                           [] -> String
    w
                           [Int]
    x  -> Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop (Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +[Int] -> Int
    forall a. HasCallStack => [a] -> a
    last [Int]
    x) String
    w

    -- | Make a markdown table.
    mdtable ::[[(Bool,String)]] -> String
    mdtable :: [[(Bool, String)]] -> String
    mdtable [[(Bool, String)]]
    rows = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate String
    "\n" [String
    heading, String
    align, String
    body]
      where
        heading :: String
    heading = [String] -> String
    columns (((Bool, String) -> String) -> [(Bool, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Bool
    _, String
    str) -> String
    str) ([(Bool, String)] -> Maybe [(Bool, String)] -> [(Bool, String)]
    forall a. a -> Maybe a -> a
    fromMaybe [] ([[(Bool, String)]] -> Maybe [(Bool, String)]
    forall a. [a] -> Maybe a
    listToMaybe [[(Bool, String)]]
    rows)))
        align :: String
    align =
          [String] -> String
    columns
            (((Bool, String) -> String) -> [(Bool, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map
               (\(Bool
    shouldAlignLeft, String
    _) ->
                  if Bool
    shouldAlignLeft
                    then String
    ":---"
                    else String
    "---:")
               ([(Bool, String)] -> Maybe [(Bool, String)] -> [(Bool, String)]
    forall a. a -> Maybe a -> a
    fromMaybe [] ([[(Bool, String)]] -> Maybe [(Bool, String)]
    forall a. [a] -> Maybe a
    listToMaybe [[(Bool, String)]]
    rows)))
        body :: String
    body =
          String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate String
    "\n" (([(Bool, String)] -> String) -> [[(Bool, String)]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\[(Bool, String)]
    row -> [String] -> String
    columns (((Bool, String) -> String) -> [(Bool, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, String) -> String
    forall a b. (a, b) -> b
    snd [(Bool, String)]
    row)) (Int -> [[(Bool, String)]] -> [[(Bool, String)]]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [[(Bool, String)]]
    rows))
        columns :: [String] -> String
    columns [String]
    xs = String
    "|" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate String
    "|" [String]
    xs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "|"

    -- | Make a table out of a list of rows.
    tablize :: [[(Bool,String)]] -> String
    tablize :: [[(Bool, String)]] -> String
    tablize [[(Bool, String)]]
    xs =
      String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate String
    "\n" (([(Bool, String)] -> String) -> [[(Bool, String)]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate String
    "  " ([String] -> String)
    -> ([(Bool, String)] -> [String]) -> [(Bool, String)] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, (Bool, String)) -> String)
    -> [(Int, (Bool, String))] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, (Bool, String)) -> String
    forall {t} {t}.
    (PrintfArg t, PrintfType t) =>
    (Int, (Bool, t)) -> t
    fill ([(Int, (Bool, String))] -> [String])
    -> ([(Bool, String)] -> [(Int, (Bool, String))])
    -> [(Bool, String)]
    -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> [(Bool, String)] -> [(Int, (Bool, String))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0 ..]) [[(Bool, String)]]
    xs)
      where
        fill :: (Int, (Bool, t)) -> t
    fill (Int
    x', (Bool
    left', t
    text')) =
          String -> t -> t
    forall r. PrintfType r => String -> r
    printf (String
    "%" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    direction String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    width String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "s") t
    text'
          where
            direction :: String
    direction =
              if Bool
    left'
                then String
    "-"
                else String
    ""
            width :: Int
    width = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (([(Bool, String)] -> Int) -> [[(Bool, String)]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int)
    -> ([(Bool, String)] -> String) -> [(Bool, String)] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, String) -> String
    forall a b. (a, b) -> b
    snd ((Bool, String) -> String)
    -> ([(Bool, String)] -> (Bool, String))
    -> [(Bool, String)]
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(Bool, String)] -> Int -> (Bool, String)
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    x')) [[(Bool, String)]]
    xs)

    -- | Formatting an integral number to 1,000,000, etc.
    commas :: (Num a,Integral a,Show a) => a -> String
    commas :: forall a. (Num a, Integral a, Show a) => a -> String
    commas = ShowS
    forall a. [a] -> [a]
    reverse ShowS -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate String
    "," ([String] -> String) -> (a -> [String]) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> [String]
    forall e. Int -> [e] -> [[e]]
    chunksOf Int
    3 (String -> [String]) -> (a -> String) -> a -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. [a] -> [a]
    reverse ShowS -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    -- | Indent all lines in a string.
    indent :: [Char] -> [Char]
    indent :: ShowS
    indent = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    List.intercalate String
    "\n" ([String] -> String) -> (String -> [String]) -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    2 Char
    ' 'String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines