{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BangPatterns #-}
module Weigh
(
mainWith
,weighResults
,setColumns
,Column(..)
,setFormat
,Format (..)
,setConfig
,Config (..)
,defaultConfig
,func
,func'
,io
,value
,action
,wgroup
,validateAction
,validateFunc
,maxAllocs
,Weigh
,Weight(..)
,commas
,reportGroup
,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
data Column
= Case
| Allocated
| GCs
| Live
| Check
| Max
| MaxOS
| WallTime
deriving (Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show, Column -> Column -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c== :: Column -> Column -> Bool
Eq, Int -> Column
Column -> Int
Column -> [Column]
Column -> Column
Column -> Column -> [Column]
Column -> Column -> Column -> [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
enumFromThenTo :: Column -> Column -> Column -> [Column]
$cenumFromThenTo :: Column -> Column -> Column -> [Column]
enumFromTo :: Column -> Column -> [Column]
$cenumFromTo :: Column -> Column -> [Column]
enumFromThen :: Column -> Column -> [Column]
$cenumFromThen :: Column -> Column -> [Column]
enumFrom :: Column -> [Column]
$cenumFrom :: Column -> [Column]
fromEnum :: Column -> Int
$cfromEnum :: Column -> Int
toEnum :: Int -> Column
$ctoEnum :: Int -> Column
pred :: Column -> Column
$cpred :: Column -> Column
succ :: Column -> Column
$csucc :: Column -> Column
Enum)
data Config = Config
{ Config -> [Column]
configColumns :: [Column]
, Config -> String
configPrefix :: String
, Config -> Format
configFormat :: !Format
} deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)
data Format = Plain | Markdown
deriving (Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show)
newtype Weigh a =
Weigh {forall a. Weigh a -> State (Config, [Grouped Action]) a
runWeigh :: State (Config, [Grouped Action]) a}
deriving (Applicative 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
return :: forall a. a -> Weigh a
$creturn :: forall a. a -> Weigh a
>> :: forall a b. Weigh a -> Weigh b -> Weigh b
$c>> :: forall a b. Weigh a -> Weigh b -> Weigh b
>>= :: forall a b. Weigh a -> (a -> Weigh b) -> Weigh b
$c>>= :: forall a b. Weigh a -> (a -> Weigh b) -> Weigh b
Monad,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
<$ :: forall a b. a -> Weigh b -> Weigh a
$c<$ :: forall a b. a -> Weigh b -> Weigh a
fmap :: forall a b. (a -> b) -> Weigh a -> Weigh b
$cfmap :: forall a b. (a -> b) -> Weigh a -> Weigh b
Functor,Functor 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
<* :: forall a b. Weigh a -> Weigh b -> Weigh a
$c<* :: forall a b. Weigh a -> Weigh b -> Weigh a
*> :: forall a b. Weigh a -> Weigh b -> Weigh b
$c*> :: forall a b. Weigh a -> Weigh b -> Weigh b
liftA2 :: forall a b c. (a -> b -> c) -> Weigh a -> Weigh b -> Weigh c
$cliftA2 :: forall a b c. (a -> b -> c) -> Weigh a -> Weigh b -> Weigh c
<*> :: forall a b. Weigh (a -> b) -> Weigh a -> Weigh b
$c<*> :: forall a b. Weigh (a -> b) -> Weigh a -> Weigh b
pure :: forall a. a -> Weigh a
$cpure :: forall a. a -> Weigh a
Applicative)
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]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Weight]
$creadListPrec :: ReadPrec [Weight]
readPrec :: ReadPrec Weight
$creadPrec :: ReadPrec Weight
readList :: ReadS [Weight]
$creadList :: ReadS [Weight]
readsPrec :: Int -> ReadS Weight
$creadsPrec :: Int -> ReadS Weight
Read,Int -> Weight -> ShowS
[Weight] -> ShowS
Weight -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Weight] -> ShowS
$cshowList :: [Weight] -> ShowS
show :: Weight -> String
$cshow :: Weight -> String
showsPrec :: Int -> Weight -> ShowS
$cshowsPrec :: Int -> Weight -> ShowS
Show)
data Grouped a
= Grouped String [Grouped a]
| Singleton a
deriving (Grouped a -> Grouped a -> Bool
forall a. Eq a => Grouped a -> Grouped a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grouped a -> Grouped a -> Bool
$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
Eq, Int -> Grouped a -> ShowS
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
showList :: [Grouped a] -> ShowS
$cshowList :: forall a. Show a => [Grouped a] -> ShowS
show :: Grouped a -> String
$cshow :: forall a. Show a => Grouped a -> String
showsPrec :: Int -> Grouped a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Grouped a -> ShowS
Show, 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
<$ :: forall a b. a -> Grouped b -> Grouped a
$c<$ :: forall a b. a -> Grouped b -> Grouped a
fmap :: forall a b. (a -> b) -> Grouped a -> Grouped b
$cfmap :: forall a b. (a -> b) -> Grouped a -> Grouped b
Functor, Functor Grouped
Foldable 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)
sequence :: forall (m :: * -> *) a. Monad m => Grouped (m a) -> m (Grouped a)
$csequence :: forall (m :: * -> *) a. Monad m => Grouped (m a) -> m (Grouped a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grouped a -> m (Grouped b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grouped a -> m (Grouped b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Grouped (f a) -> f (Grouped a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Grouped (f a) -> f (Grouped a)
traverse :: 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)
Traversable.Traversable, 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
product :: forall a. Num a => Grouped a -> a
$cproduct :: forall a. Num a => Grouped a -> a
sum :: forall a. Num a => Grouped a -> a
$csum :: forall a. Num a => Grouped a -> a
minimum :: forall a. Ord a => Grouped a -> a
$cminimum :: forall a. Ord a => Grouped a -> a
maximum :: forall a. Ord a => Grouped a -> a
$cmaximum :: forall a. Ord a => Grouped a -> a
elem :: forall a. Eq a => a -> Grouped a -> Bool
$celem :: forall a. Eq a => a -> Grouped a -> Bool
length :: forall a. Grouped a -> Int
$clength :: forall a. Grouped a -> Int
null :: forall a. Grouped a -> Bool
$cnull :: forall a. Grouped a -> Bool
toList :: forall a. Grouped a -> [a]
$ctoList :: forall a. Grouped a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Grouped a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Grouped a -> a
foldr1 :: forall a. (a -> a -> a) -> Grouped a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Grouped a -> a
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
$cfoldl :: forall b a. (b -> a -> 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
$cfoldr :: forall a b. (a -> b -> b) -> b -> Grouped a -> b
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
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Grouped a -> m
fold :: forall m. Monoid m => Grouped m -> m
$cfold :: forall m. Monoid m => Grouped m -> m
Foldable.Foldable, 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
$cto :: forall a x. Rep (Grouped a) x -> Grouped a
$cfrom :: forall a x. Grouped a -> Rep (Grouped a) x
Generic)
instance NFData a => NFData (Grouped a)
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
_ = ()
mainWith :: Weigh a -> IO ()
mainWith :: forall a. Weigh a -> IO ()
mainWith Weigh a
m = do
([Grouped (Weight, Maybe String)]
results, Config
config) <- forall a. Weigh a -> IO ([Grouped (Weight, Maybe String)], Config)
weighResults Weigh a
m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(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 forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\(Weight
w, Maybe String
r) -> do
String
msg <- Maybe String
r
forall (m :: * -> *) a. Monad m => a -> m a
return (Weight
w, String
msg))
(forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList [Grouped (Weight, Maybe String)]
results)) of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(Weight, String)]
errors -> do
String -> IO ()
putStrLn String
"\nCheck problems:"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
(\(Weight
w, String
r) -> String -> IO ()
putStrLn (String
" " forall a. [a] -> [a] -> [a]
++ Weight -> String
weightLabel Weight
w forall a. [a] -> [a] -> [a]
++ String
"\n " forall a. [a] -> [a] -> [a]
++ String
r))
[(Weight, String)]
errors
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure (-Int
1))
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) = forall s a. State s a -> s -> s
execState (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], Config
config)
Just [Grouped Weight]
weights ->
forall (m :: * -> *) a. Monad m => a -> m a
return
( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(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, 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 :: Format
configFormat =
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== String
"--markdown") [String]
args
then Format
Markdown
else Config -> Format
configFormat Config
config
})
defaultColumns :: [Column]
defaultColumns :: [Column]
defaultColumns = [Column
Case, Column
Allocated, Column
GCs]
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
Config
{configColumns :: [Column]
configColumns = [Column]
defaultColumns, configPrefix :: String
configPrefix = String
"", configFormat :: Format
configFormat = Format
Plain}
setColumns :: [Column] -> Weigh ()
setColumns :: [Column] -> Weigh ()
setColumns [Column]
cs = forall a. State (Config, [Grouped Action]) a -> Weigh a
Weigh (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\Config
c -> Config
c {configColumns :: [Column]
configColumns = [Column]
cs})))
setFormat :: Format -> Weigh ()
setFormat :: Format -> Weigh ()
setFormat Format
fm = forall a. State (Config, [Grouped Action]) a -> Weigh a
Weigh (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\Config
c -> Config
c {configFormat :: Format
configFormat = Format
fm})))
setConfig :: Config -> Weigh ()
setConfig :: Config -> Weigh ()
setConfig = forall a. State (Config, [Grouped Action]) a -> Weigh a
Weigh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
func :: (NFData a)
=> String
-> (b -> a)
-> b
-> Weigh ()
func :: forall a b. NFData a => String -> (b -> a) -> b -> Weigh ()
func String
name !b -> a
f !b
x = forall a b.
NFData a =>
String -> (b -> a) -> b -> (Weight -> Maybe String) -> Weigh ()
validateFunc String
name b -> a
f b
x (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
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 (forall a. NFData a => a -> a
force -> !b
x) = forall a b.
NFData a =>
String -> (b -> a) -> b -> (Weight -> Maybe String) -> Weigh ()
validateFunc String
name b -> a
f b
x (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
io :: (NFData a)
=> String
-> (b -> IO a)
-> b
-> Weigh ()
io :: forall a b. NFData a => String -> (b -> IO a) -> b -> Weigh ()
io String
name !b -> IO a
f !b
x = forall a b.
NFData a =>
String -> (b -> IO a) -> b -> (Weight -> Maybe String) -> Weigh ()
validateAction String
name b -> IO a
f b
x (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
value :: NFData a
=> String
-> a
-> Weigh ()
value :: forall a. NFData a => String -> a -> Weigh ()
value String
name !a
v = forall a b. NFData a => String -> (b -> a) -> b -> Weigh ()
func String
name forall a. a -> a
id a
v
action :: NFData a
=> String
-> IO a
-> Weigh ()
action :: forall a. NFData a => String -> IO a -> Weigh ()
action String
name !IO a
m = forall a b. NFData a => String -> (b -> IO a) -> b -> Weigh ()
io String
name (forall a b. a -> b -> a
const IO a
m) ()
maxAllocs :: Word64
-> (Weight -> Maybe String)
maxAllocs :: Word64 -> Weight -> Maybe String
maxAllocs Word64
n =
\Weight
w ->
if Weight -> Word64
weightAllocatedBytes Weight
w forall a. Ord a => a -> a -> Bool
> Word64
n
then forall a. a -> Maybe a
Just (String
"Allocated bytes exceeds " forall a. [a] -> [a] -> [a]
++
forall a. (Num a, Integral a, Show a) => a -> String
commas Word64
n forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. (Num a, Integral a, Show a) => a -> String
commas (Weight -> Word64
weightAllocatedBytes Weight
w))
else forall a. Maybe a
Nothing
validateAction :: (NFData a)
=> String
-> (b -> IO a)
-> b
-> (Weight -> Maybe String)
-> 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 forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b.
NFData a =>
Either (b -> IO a) (b -> a)
-> b -> String -> (Weight -> Maybe String) -> Action
Action (forall a b. a -> Either a b
Left b -> IO a
m) b
arg) Weight -> Maybe String
validate
validateFunc :: (NFData a)
=> String
-> (b -> a)
-> b
-> (Weight -> Maybe String)
-> 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 forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b.
NFData a =>
Either (b -> IO a) (b -> a)
-> b -> String -> (Weight -> Maybe String) -> Action
Action (forall a b. b -> Either a b
Right b -> a
f) b
x) Weight -> Maybe String
validate
tellAction :: String -> (String -> Action) -> Weigh ()
tellAction :: String -> (String -> Action) -> Weigh ()
tellAction String
name String -> Action
act =
forall a. State (Config, [Grouped Action]) a -> Weigh a
Weigh (do String
prefix <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Config -> String
configPrefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\[Grouped Action]
x -> [Grouped Action]
x forall a. [a] -> [a] -> [a]
++ [forall a. a -> Grouped a
Singleton forall a b. (a -> b) -> a -> b
$ String -> Action
act (String
prefix forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
name)])))
wgroup :: String -> Weigh () -> Weigh ()
wgroup :: String -> Weigh () -> Weigh ()
wgroup String
str Weigh ()
wei = do
(Config
orig, [Grouped Action]
start) <- forall a. State (Config, [Grouped Action]) a -> Weigh a
Weigh forall s (m :: * -> *). MonadState s m => m s
get
let startL :: Int
startL = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [Grouped Action]
start
forall a. State (Config, [Grouped Action]) a -> Weigh a
Weigh (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\Config
c -> Config
c {configPrefix :: String
configPrefix = Config -> String
configPrefix Config
orig forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
str})))
Weigh ()
wei
forall a. State (Config, [Grouped Action]) a -> Weigh a
Weigh forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ \[Grouped Action]
x -> forall a. Int -> [a] -> [a]
take Int
startL [Grouped Action]
x forall a. [a] -> [a] -> [a]
++ [forall a. String -> [Grouped a] -> Grouped a
Grouped String
str forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
startL [Grouped Action]
x]
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\Config
c -> Config
c {configPrefix :: String
configPrefix = Config -> String
configPrefix Config
orig}))
weighDispatch :: Maybe String
-> [Grouped Action]
-> 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]
_) = forall a. Read a => String -> a
read String
var
let !String
_ = forall a. NFData a => a -> a
force String
fp
case String -> [Grouped Action] -> Maybe Action
glookup String
label (forall a. NFData a => a -> a
force [Grouped Action]
cases) of
Maybe Action
Nothing -> 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 -> 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 -> 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
(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 forall a. Num a => a -> a -> a
- Double
start
}))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe String
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Traversable.traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Traversable.traverse Action -> IO Weight
fork) [Grouped Action]
cases)
glookup :: String -> [Grouped Action] -> Maybe Action
glookup :: String -> [Grouped Action] -> Maybe Action
glookup String
label =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Foldable.find ((forall a. Eq a => a -> a -> Bool
== String
label) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action -> String
actionName) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
fork :: Action
-> IO Weight
fork :: Action -> IO Weight
fork Action
act =
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" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show 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 forall a. [a] -> [a] -> [a]
++ [String
"+RTS", String
"-T", String
"-RTS"])
String
""
case ExitCode
exit of
ExitFailure {} ->
forall a. HasCallStack => String -> a
error
(String
"Error in case (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Action -> String
actionName Action
act) forall a. [a] -> [a] -> [a]
++ String
"):\n " forall a. [a] -> [a] -> [a]
++ String
err)
ExitCode
ExitSuccess -> do
String
out <- String -> IO String
readFile String
fp
case forall a. Read a => ReadS a
reads String
out of
[(!Weight
r, String
_)] -> forall (m :: * -> *) a. Monad m => a -> m a
return Weight
r
[(Weight, String)]
_ ->
forall a. HasCallStack => String -> a
error
(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."
]))
weighFunc
:: (NFData a)
=> (b -> a)
-> b
-> IO (Word64,Word32,Word64,Word64,Word64)
weighFunc :: forall a b.
NFData a =>
(b -> a) -> b -> IO (Word64, Word32, Word64, Word64, Word64)
weighFunc b -> a
run !b
arg = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
NFData a =>
(b -> a) -> b -> IO (a, (Word64, Word32, Word64, Word64, Word64))
weighFuncResult b -> a
run b
arg
weighFuncResult
:: (NFData a)
=> (b -> a)
-> b
-> IO (a, (Word64,Word32,Word64,Word64,Word64))
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
!RTSStats
bootupStats <- IO RTSStats
GHCStats.getStats
let !result :: a
result = forall a. NFData a => a -> a
force (b -> a
run b
arg)
IO ()
performGC
!RTSStats
actionStats <- IO RTSStats
GHCStats.getStats
let reflectionGCs :: Word32
reflectionGCs = Word32
1
actionBytes :: Word64
actionBytes =
(RTSStats -> Word64
GHCStats.totalBytesAllocated RTSStats
actionStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
RTSStats -> Word64
GHCStats.totalBytesAllocated RTSStats
bootupStats) forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ghcStatsSizeInBytes
actionGCs :: Word32
actionGCs =
RTSStats -> Word32
GHCStats.gcCount RTSStats
actionStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting` RTSStats -> Word32
GHCStats.gcCount RTSStats
bootupStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
Word32
reflectionGCs
actualBytes :: Word64
actualBytes = forall a. Ord a => a -> a -> a
max Word64
0 Word64
actionBytes
liveBytes :: Word64
liveBytes =
(RTSStats -> Word64
GHCStats.liveBytes RTSStats
actionStats 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 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 forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
RTSStats -> Word64
GHCStats.maxOSBytes RTSStats
bootupStats)
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 forall a. Ord a => a -> a -> Bool
> p
y
then p
x forall a. Num a => a -> a -> a
- p
y
else p
0
weighAction
:: (NFData a)
=> (b -> IO a)
-> b
-> IO (Word64,Word32,Word64,Word64,Word64)
weighAction :: forall a b.
NFData a =>
(b -> IO a) -> b -> IO (Word64, Word32, Word64, Word64, Word64)
weighAction b -> IO a
run !b
arg = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
NFData a =>
(b -> IO a)
-> b -> IO (a, (Word64, Word32, Word64, Word64, Word64))
weighActionResult b -> IO a
run b
arg
weighActionResult
:: (NFData a)
=> (b -> IO a)
-> b
-> IO (a, (Word64,Word32,Word64,Word64,Word64))
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
!RTSStats
bootupStats <- IO RTSStats
GHCStats.getStats
!a
result <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NFData a => a -> a
force (b -> IO a
run b
arg)
IO ()
performGC
!RTSStats
actionStats <- IO RTSStats
GHCStats.getStats
let reflectionGCs :: Word32
reflectionGCs = Word32
1
actionBytes :: Word64
actionBytes =
(RTSStats -> Word64
GHCStats.totalBytesAllocated RTSStats
actionStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
RTSStats -> Word64
GHCStats.totalBytesAllocated RTSStats
bootupStats) forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ghcStatsSizeInBytes
actionGCs :: Word32
actionGCs =
RTSStats -> Word32
GHCStats.gcCount RTSStats
actionStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting` RTSStats -> Word32
GHCStats.gcCount RTSStats
bootupStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
Word32
reflectionGCs
actualBytes :: Word64
actualBytes = forall a. Ord a => a -> a -> a
max Word64
0 Word64
actionBytes
liveBytes :: Word64
liveBytes =
forall a. Ord a => a -> a -> a
max Word64
0 (RTSStats -> Word64
GHCStats.liveBytes RTSStats
actionStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting` RTSStats -> Word64
GHCStats.liveBytes RTSStats
bootupStats)
maxBytes :: Word64
maxBytes =
forall a. Ord a => a -> a -> a
max
Word64
0
(RTSStats -> Word64
GHCStats.maxBytesInUse RTSStats
actionStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
RTSStats -> Word64
GHCStats.maxBytesInUse RTSStats
bootupStats)
maxOSBytes :: Word64
maxOSBytes =
forall a. Ord a => a -> a -> a
max
Word64
0
(RTSStats -> Word64
GHCStats.maxOSBytes RTSStats
actionStats forall p. (Ord p, Num p) => p -> p -> p
`subtracting`
RTSStats -> Word64
GHCStats.maxOSBytes RTSStats
bootupStats)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result,
( Word64
actualBytes
, Word32
actionGCs
, Word64
liveBytes
, Word64
maxBytes
, Word64
maxOSBytes
))
report :: Config -> [Grouped (Weight,Maybe String)] -> String
report :: Config -> [Grouped (Weight, Maybe String)] -> String
report Config
config [Grouped (Weight, Maybe String)]
gs =
forall a. [a] -> [[a]] -> [a]
List.intercalate
String
"\n\n"
(forall a. (a -> Bool) -> [a] -> [a]
filter
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
[ if 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
, forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n\n" (forall a b. (a -> b) -> [a] -> [b]
map (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 =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\case
Singleton (Weight, Maybe String)
v -> forall a. a -> Maybe a
Just (Weight, Maybe String)
v
Grouped (Weight, Maybe String)
_ -> forall a. Maybe a
Nothing)
[Grouped (Weight, Maybe String)]
gs
groups :: [(String, [Grouped (Weight, Maybe String)])]
groups =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\case
Grouped String
title [Grouped (Weight, Maybe String)]
vs -> forall a. a -> Maybe a
Just (String
title, [Grouped (Weight, Maybe String)]
vs)
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 forall a. [a] -> [a] -> [a]
++ String
"\n\n" forall a. [a] -> [a] -> [a]
++ ShowS
indent (Config -> [Grouped (Weight, Maybe String)] -> String
report Config
config [Grouped (Weight, Maybe String)]
gs)
Format
Markdown -> String
"#" forall a. [a] -> [a] -> [a]
++ String
title forall a. [a] -> [a] -> [a]
++ String
"\n\n" forall a. [a] -> [a] -> [a]
++ Config -> [Grouped (Weight, Maybe String)] -> String
report Config
config [Grouped (Weight, Maybe String)]
gs
reportTabular :: Config -> [(Weight,Maybe String)] -> String
reportTabular :: Config -> [(Weight, Maybe String)] -> String
reportTabular Config
config = 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall {b}. [(Column, b)] -> [b]
select [(Column, (Bool, String))]
headings forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall {b}. [(Column, b)] -> [b]
select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Weight, Maybe a) -> [(Column, (Bool, String))]
toRow)
select :: [(Column, b)] -> [b]
select [(Column, b)]
row = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Column
name -> 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 forall a b. (a -> b) -> a -> b
$ Weight -> String
weightLabel Weight
w))
, (Column
Allocated, (Bool
False, forall a. (Num a, Integral a, Show a) => a -> String
commas (Weight -> Word64
weightAllocatedBytes Weight
w)))
, (Column
GCs, (Bool
False, forall a. (Num a, Integral a, Show a) => a -> String
commas (Weight -> Word32
weightGCs Weight
w)))
, (Column
Live, (Bool
False, forall a. (Num a, Integral a, Show a) => a -> String
commas (Weight -> Word64
weightLiveBytes Weight
w)))
, (Column
Max, (Bool
False, forall a. (Num a, Integral a, Show a) => a -> String
commas (Weight -> Word64
weightMaxBytes Weight
w)))
, (Column
MaxOS, (Bool
False, forall a. (Num a, Integral a, Show a) => a -> String
commas (Weight -> Word64
weightMaxOSBytes Weight
w)))
, (Column
WallTime, (Bool
False, 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 forall a. Eq a => a -> [a] -> [Int]
List.elemIndices Char
'/' String
w of
[] -> String
w
[Int]
x -> forall a. Int -> [a] -> [a]
drop (Int
1forall a. Num a => a -> a -> a
+forall a. [a] -> a
last [Int]
x) String
w
mdtable ::[[(Bool,String)]] -> String
mdtable :: [[(Bool, String)]] -> String
mdtable [[(Bool, String)]]
rows = forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" [String
heading, String
align, String
body]
where
heading :: String
heading = [String] -> String
columns (forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
_, String
str) -> String
str) (forall a. a -> Maybe a -> a
fromMaybe [] (forall a. [a] -> Maybe a
listToMaybe [[(Bool, String)]]
rows)))
align :: String
align =
[String] -> String
columns
(forall a b. (a -> b) -> [a] -> [b]
map
(\(Bool
shouldAlignLeft, String
_) ->
if Bool
shouldAlignLeft
then String
":---"
else String
"---:")
(forall a. a -> Maybe a -> a
fromMaybe [] (forall a. [a] -> Maybe a
listToMaybe [[(Bool, String)]]
rows)))
body :: String
body =
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" (forall a b. (a -> b) -> [a] -> [b]
map (\[(Bool, String)]
row -> [String] -> String
columns (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Bool, String)]
row)) (forall a. Int -> [a] -> [a]
drop Int
1 [[(Bool, String)]]
rows))
columns :: [String] -> String
columns [String]
xs = String
"|" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
List.intercalate String
"|" [String]
xs forall a. [a] -> [a] -> [a]
++ String
"|"
tablize :: [[(Bool,String)]] -> String
tablize :: [[(Bool, String)]] -> String
tablize [[(Bool, String)]]
xs =
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
List.intercalate String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {t} {t}.
(PrintfArg t, PrintfType t) =>
(Int, (Bool, t)) -> t
fill forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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')) =
forall r. PrintfType r => String -> r
printf (String
"%" forall a. [a] -> [a] -> [a]
++ String
direction forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
width forall a. [a] -> [a] -> [a]
++ String
"s") t
text'
where
direction :: String
direction =
if Bool
left'
then String
"-"
else String
""
width :: Int
width = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> Int -> a
!! Int
x')) [[(Bool, String)]]
xs)
commas :: (Num a,Integral a,Show a) => a -> String
commas :: forall a. (Num a, Integral a, Show a) => a -> String
commas = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
List.intercalate String
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Int -> [e] -> [[e]]
chunksOf Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
indent :: [Char] -> [Char]
indent :: ShowS
indent = forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> a -> [a]
replicate Int
2 Char
' 'forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines