{-# LANGUAGE AllowAmbiguousTypes #-}
module Data.Registry.Internal.Statistics where
import Data.Registry.Internal.Types
import Protolude
import Type.Reflection
data Statistics = Statistics {
Statistics -> Operations
operations :: Operations
, Statistics -> Values
values :: Values
} deriving (Int -> Statistics -> ShowS
[Statistics] -> ShowS
Statistics -> String
(Int -> Statistics -> ShowS)
-> (Statistics -> String)
-> ([Statistics] -> ShowS)
-> Show Statistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statistics] -> ShowS
$cshowList :: [Statistics] -> ShowS
show :: Statistics -> String
$cshow :: Statistics -> String
showsPrec :: Int -> Statistics -> ShowS
$cshowsPrec :: Int -> Statistics -> ShowS
Show)
instance Semigroup Statistics where
Statistics Operations
ops1 Values
vs1 <> :: Statistics -> Statistics -> Statistics
<> Statistics Operations
ops2 Values
vs2 =
Operations -> Values -> Statistics
Statistics (Operations
ops1 Operations -> Operations -> Operations
forall a. Semigroup a => a -> a -> a
<> Operations
ops2) (Values
vs1 Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> Values
vs2)
instance Monoid Statistics where
mempty :: Statistics
mempty = Operations -> Values -> Statistics
Statistics Operations
forall a. Monoid a => a
mempty Values
forall a. Monoid a => a
mempty
mappend :: Statistics -> Statistics -> Statistics
mappend = Statistics -> Statistics -> Statistics
forall a. Semigroup a => a -> a -> a
(<>)
type Operations = [AppliedFunction]
type Paths = [[Value]]
data AppliedFunction = AppliedFunction {
AppliedFunction -> Value
_outputValue :: Value
, AppliedFunction -> [Value]
_inputValues ::[Value]
} deriving (Int -> AppliedFunction -> ShowS
Operations -> ShowS
AppliedFunction -> String
(Int -> AppliedFunction -> ShowS)
-> (AppliedFunction -> String)
-> (Operations -> ShowS)
-> Show AppliedFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: Operations -> ShowS
$cshowList :: Operations -> ShowS
show :: AppliedFunction -> String
$cshow :: AppliedFunction -> String
showsPrec :: Int -> AppliedFunction -> ShowS
$cshowsPrec :: Int -> AppliedFunction -> ShowS
Show)
initStatistics :: Values -> Statistics
initStatistics :: Values -> Statistics
initStatistics Values
vs = Statistics
forall a. Monoid a => a
mempty { values :: Values
values = Values
vs }
usedSpecializations :: Statistics -> [Specialization]
usedSpecializations :: Statistics -> [Specialization]
usedSpecializations Statistics
stats =
case Statistics -> Values
values Statistics
stats of
Values [] -> []
Values (Value
v : [Value]
vs) ->
case Value -> Maybe Specialization
usedSpecialization Value
v of
Just Specialization
s -> Specialization
s Specialization -> [Specialization] -> [Specialization]
forall a. a -> [a] -> [a]
: Statistics -> [Specialization]
usedSpecializations Statistics
stats { values :: Values
values = [Value] -> Values
Values [Value]
vs }
Maybe Specialization
Nothing -> Statistics -> [Specialization]
usedSpecializations Statistics
stats { values :: Values
values = [Value] -> Values
Values [Value]
vs }
allValuesPaths :: Statistics -> Paths
allValuesPaths :: Statistics -> Paths
allValuesPaths Statistics
stats = do
Value
v <- Values -> [Value]
unValues (Values -> [Value]) -> Values -> [Value]
forall a b. (a -> b) -> a -> b
$ Statistics -> Values
values Statistics
stats
Value -> Paths
valuePaths Value
v
valuePaths :: Value -> Paths
valuePaths :: Value -> Paths
valuePaths v :: Value
v@(CreatedValue Dynamic
_ ValueDescription
_ Maybe Context
_ Maybe Specialization
_ (Dependencies [Value]
ds)) = do
Value
d <- [Value]
ds
(Value
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:) ([Value] -> [Value]) -> Paths -> Paths
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Paths
valuePaths Value
d
valuePaths Value
_ = []
findMostRecentValue :: forall a . (Typeable a) => Statistics -> Maybe Value
findMostRecentValue :: Statistics -> Maybe Value
findMostRecentValue Statistics
stats = (Value -> Bool) -> [Value] -> Maybe Value
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Value
v -> Value -> SomeTypeRep
valueDynTypeRep Value
v SomeTypeRep -> SomeTypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy a -> SomeTypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) ([Value] -> Maybe Value) -> [Value] -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Values -> [Value]
unValues (Statistics -> Values
values Statistics
stats)