{-# LINE 1 "System/Metrics/Distribution.hsc" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}



-- | This module defines a type for tracking statistics about a series
-- of events. An event could be handling of a request and the value
-- associated with the event -- the value you'd pass to 'add' -- could
-- be the amount of time spent serving that request (e.g. in
-- milliseconds). All operations are thread safe.
module System.Metrics.Distribution
    ( Distribution
    , new
    , add
    , addN
    , read

      -- * Gathered statistics
    , Stats
    , mean
    , variance
    , count
    , sum
    , min
    , max
    ) where

import Control.Monad (forM_, replicateM)
import Data.Int (Int64)
import Foreign.C.Types (CInt)
import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable(alignment, peek, poke, sizeOf), peekByteOff,
                         pokeByteOff)
import Prelude hiding (max, min, read, sum)

import Data.Array
import System.Metrics.Distribution.Internal (Stats(..))
import System.Metrics.ThreadId

-- | An metric for tracking events.
newtype Distribution = Distribution { Distribution -> Array Stripe
unD :: Array Stripe }

data Stripe = Stripe
    { Stripe -> ForeignPtr CDistrib
stripeFp    :: !(ForeignPtr CDistrib)
    }

data CDistrib = CDistrib
    { CDistrib -> Int64
cCount      :: !Int64
    , CDistrib -> Double
cMean       :: !Double
    , CDistrib -> Double
cSumSqDelta :: !Double
    , CDistrib -> Double
cSum        :: !Double
    , CDistrib -> Double
cMin        :: !Double
    , CDistrib -> Double
cMax        :: !Double
    , CDistrib -> Int64
cLock       :: !Int64  -- ^ 0 - unlocked, 1 - locked
    }

instance Storable CDistrib where
    sizeOf :: CDistrib -> Int
sizeOf CDistrib
_ = ((Int
56))
{-# LINE 62 "System/Metrics/Distribution.hsc" #-}
    alignment _ = alignment (undefined :: CInt)

    peek :: Ptr CDistrib -> IO CDistrib
peek Ptr CDistrib
p = do
        Int64
cCount <- ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDistrib
hsc_ptr Int
0)) Ptr CDistrib
p
{-# LINE 66 "System/Metrics/Distribution.hsc" #-}
        Double
cMean <- ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDistrib
hsc_ptr Int
8)) Ptr CDistrib
p
{-# LINE 67 "System/Metrics/Distribution.hsc" #-}
        Double
cSumSqDelta <- ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDistrib
hsc_ptr Int
16)) Ptr CDistrib
p
{-# LINE 68 "System/Metrics/Distribution.hsc" #-}
        Double
cSum <- ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDistrib
hsc_ptr Int
24)) Ptr CDistrib
p
{-# LINE 69 "System/Metrics/Distribution.hsc" #-}
        Double
cMin <- ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDistrib
hsc_ptr Int
32)) Ptr CDistrib
p
{-# LINE 70 "System/Metrics/Distribution.hsc" #-}
        Double
cMax <- ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> IO Double
forall b. Ptr b -> Int -> IO Double
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDistrib
hsc_ptr Int
40)) Ptr CDistrib
p
{-# LINE 71 "System/Metrics/Distribution.hsc" #-}
        Int64
cLock <- ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CDistrib
hsc_ptr Int
48)) Ptr CDistrib
p
{-# LINE 72 "System/Metrics/Distribution.hsc" #-}
        CDistrib -> IO CDistrib
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CDistrib -> IO CDistrib) -> CDistrib -> IO CDistrib
forall a b. (a -> b) -> a -> b
$! CDistrib
            { cCount :: Int64
cCount      = Int64
cCount
            , cMean :: Double
cMean       = Double
cMean
            , cSumSqDelta :: Double
cSumSqDelta = Double
cSumSqDelta
            , cSum :: Double
cSum        = Double
cSum
            , cMin :: Double
cMin        = Double
cMin
            , cMax :: Double
cMax        = Double
cMax
            , cLock :: Int64
cLock       = Int64
cLock
            }

    poke :: Ptr CDistrib -> CDistrib -> IO ()
poke Ptr CDistrib
p CDistrib{Double
Int64
cCount :: CDistrib -> Int64
cMean :: CDistrib -> Double
cSumSqDelta :: CDistrib -> Double
cSum :: CDistrib -> Double
cMin :: CDistrib -> Double
cMax :: CDistrib -> Double
cLock :: CDistrib -> Int64
cCount :: Int64
cMean :: Double
cSumSqDelta :: Double
cSum :: Double
cMin :: Double
cMax :: Double
cLock :: Int64
..} = do
        ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CDistrib
hsc_ptr Int
0)) Ptr CDistrib
p Int64
cCount
{-# LINE 84 "System/Metrics/Distribution.hsc" #-}
        ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CDistrib
hsc_ptr Int
8)) Ptr CDistrib
p Double
cMean
{-# LINE 85 "System/Metrics/Distribution.hsc" #-}
        ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CDistrib
hsc_ptr Int
16)) Ptr CDistrib
p Double
cSumSqDelta
{-# LINE 86 "System/Metrics/Distribution.hsc" #-}
        ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CDistrib
hsc_ptr Int
24)) Ptr CDistrib
p Double
cSum
{-# LINE 87 "System/Metrics/Distribution.hsc" #-}
        ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CDistrib
hsc_ptr Int
32)) Ptr CDistrib
p Double
cMin
{-# LINE 88 "System/Metrics/Distribution.hsc" #-}
        ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> Double -> IO ()
forall b. Ptr b -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CDistrib
hsc_ptr Int
40)) Ptr CDistrib
p Double
cMax
{-# LINE 89 "System/Metrics/Distribution.hsc" #-}
        ((\Ptr CDistrib
hsc_ptr -> Ptr CDistrib -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CDistrib
hsc_ptr Int
48)) Ptr CDistrib
p Int64
cLock
{-# LINE 90 "System/Metrics/Distribution.hsc" #-}

newCDistrib :: IO (ForeignPtr CDistrib)
newCDistrib :: IO (ForeignPtr CDistrib)
newCDistrib = do
    ForeignPtr CDistrib
fp <- IO (ForeignPtr CDistrib)
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
    ForeignPtr CDistrib -> (Ptr CDistrib -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDistrib
fp ((Ptr CDistrib -> IO ()) -> IO ())
-> (Ptr CDistrib -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CDistrib
p -> Ptr CDistrib -> CDistrib -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDistrib
p (CDistrib -> IO ()) -> CDistrib -> IO ()
forall a b. (a -> b) -> a -> b
$ CDistrib
        { cCount :: Int64
cCount      = Int64
0
        , cMean :: Double
cMean       = Double
0.0
        , cSumSqDelta :: Double
cSumSqDelta = Double
0.0
        , cSum :: Double
cSum        = Double
0.0
        , cMin :: Double
cMin        = Double
0.0
        , cMax :: Double
cMax        = Double
0.0
        , cLock :: Int64
cLock       = Int64
0
        }
    ForeignPtr CDistrib -> IO (ForeignPtr CDistrib)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr CDistrib
fp

newStripe :: IO Stripe
newStripe :: IO Stripe
newStripe = do
    ForeignPtr CDistrib
fp <- IO (ForeignPtr CDistrib)
newCDistrib
    Stripe -> IO Stripe
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stripe -> IO Stripe) -> Stripe -> IO Stripe
forall a b. (a -> b) -> a -> b
$! Stripe
        { stripeFp :: ForeignPtr CDistrib
stripeFp    = ForeignPtr CDistrib
fp
        }

-- | Number of lock stripes. Should be greater or equal to the number
-- of HECs.
numStripes :: Int
numStripes :: Int
numStripes = Int
8

-- | Get the stripe to use for this thread.
myStripe :: Distribution -> IO Stripe
myStripe :: Distribution -> IO Stripe
myStripe Distribution
distrib = do
    Int
tid <- IO Int
myCapability
    Stripe -> IO Stripe
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stripe -> IO Stripe) -> Stripe -> IO Stripe
forall a b. (a -> b) -> a -> b
$! Distribution -> Array Stripe
unD Distribution
distrib Array Stripe -> Int -> Stripe
forall a. Array a -> Int -> a
`index` (Int
tid Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
numStripes)

------------------------------------------------------------------------
-- Exposed API

-- | Create a new distribution.
new :: IO Distribution
new :: IO Distribution
new = (Array Stripe -> Distribution
Distribution (Array Stripe -> Distribution)
-> ([Stripe] -> Array Stripe) -> [Stripe] -> Distribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Stripe] -> Array Stripe
forall a. Int -> [a] -> Array a
fromList Int
numStripes) ([Stripe] -> Distribution) -> IO [Stripe] -> IO Distribution
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
      Int -> IO Stripe -> IO [Stripe]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numStripes IO Stripe
newStripe

-- | Add a value to the distribution.
add :: Distribution -> Double -> IO ()
add :: Distribution -> Double -> IO ()
add Distribution
distrib Double
val = Distribution -> Double -> Int64 -> IO ()
addN Distribution
distrib Double
val Int64
1

foreign import ccall unsafe "hs_distrib_add_n" cDistribAddN
    :: Ptr CDistrib -> Double -> Int64 -> IO ()

-- | Add the same value to the distribution N times.
addN :: Distribution -> Double -> Int64 -> IO ()
addN :: Distribution -> Double -> Int64 -> IO ()
addN Distribution
distrib Double
val Int64
n = do
    Stripe
stripe <- Distribution -> IO Stripe
myStripe Distribution
distrib
    ForeignPtr CDistrib -> (Ptr CDistrib -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Stripe -> ForeignPtr CDistrib
stripeFp Stripe
stripe) ((Ptr CDistrib -> IO ()) -> IO ())
-> (Ptr CDistrib -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CDistrib
p ->
        Ptr CDistrib -> Double -> Int64 -> IO ()
cDistribAddN Ptr CDistrib
p Double
val Int64
n

foreign import ccall unsafe "hs_distrib_combine" combine
    :: Ptr CDistrib -> Ptr CDistrib -> IO ()

-- | Get the current statistical summary for the event being tracked.
read :: Distribution -> IO Stats
read :: Distribution -> IO Stats
read Distribution
distrib = do
    ForeignPtr CDistrib
result <- IO (ForeignPtr CDistrib)
newCDistrib
    CDistrib{Double
Int64
cCount :: CDistrib -> Int64
cMean :: CDistrib -> Double
cSumSqDelta :: CDistrib -> Double
cSum :: CDistrib -> Double
cMin :: CDistrib -> Double
cMax :: CDistrib -> Double
cLock :: CDistrib -> Int64
cCount :: Int64
cMean :: Double
cSumSqDelta :: Double
cSum :: Double
cMin :: Double
cMax :: Double
cLock :: Int64
..} <- ForeignPtr CDistrib -> (Ptr CDistrib -> IO CDistrib) -> IO CDistrib
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDistrib
result ((Ptr CDistrib -> IO CDistrib) -> IO CDistrib)
-> (Ptr CDistrib -> IO CDistrib) -> IO CDistrib
forall a b. (a -> b) -> a -> b
$ \ Ptr CDistrib
resultp -> do
        [Stripe] -> (Stripe -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Array Stripe -> [Stripe]
forall a. Array a -> [a]
toList (Array Stripe -> [Stripe]) -> Array Stripe -> [Stripe]
forall a b. (a -> b) -> a -> b
$ Distribution -> Array Stripe
unD Distribution
distrib) ((Stripe -> IO ()) -> IO ()) -> (Stripe -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Stripe
stripe ->
            ForeignPtr CDistrib -> (Ptr CDistrib -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Stripe -> ForeignPtr CDistrib
stripeFp Stripe
stripe) ((Ptr CDistrib -> IO ()) -> IO ())
-> (Ptr CDistrib -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CDistrib
p ->
            Ptr CDistrib -> Ptr CDistrib -> IO ()
combine Ptr CDistrib
p Ptr CDistrib
resultp
        Ptr CDistrib -> IO CDistrib
forall a. Storable a => Ptr a -> IO a
peek Ptr CDistrib
resultp
    Stats -> IO Stats
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stats -> IO Stats) -> Stats -> IO Stats
forall a b. (a -> b) -> a -> b
$! Stats
        { mean :: Double
mean  = Double
cMean
        , variance :: Double
variance = if Int64
cCount Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then Double
0.0
                     else Double
cSumSqDelta Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
cCount
        , count :: Int64
count = Int64
cCount
        , sum :: Double
sum   = Double
cSum
        , min :: Double
min   = Double
cMin
        , max :: Double
max   = Double
cMax
        }