{-# LANGUAGE AllowAmbiguousTypes #-}

-- | This module provides a set of statistics over the execution
--  of the registry. This allows to get better insights over the execution
--  or test that the registry is well configured
module Data.Registry.Internal.Statistics where

import Data.Registry.Internal.Types
import Protolude
import Type.Reflection

-- * DATA TYPES

-- | This datatype records:
--    - the created values
--    - the applied functions
--    - the specializations used to create values
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
$cshowsPrec :: Int -> Statistics -> ShowS
showsPrec :: Int -> Statistics -> ShowS
$cshow :: Statistics -> String
show :: Statistics -> String
$cshowList :: [Statistics] -> ShowS
showList :: [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
(<>)

-- | A list of function applications created
--   when creating a value out of the Registry
type Operations = [AppliedFunction]

-- | List of distinct paths from the root of the value graph to a leaf
type Paths = [[Value]]

-- | A function application with an output value and a list of input values
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
$cshowsPrec :: Int -> AppliedFunction -> ShowS
showsPrec :: Int -> AppliedFunction -> ShowS
$cshow :: AppliedFunction -> String
show :: AppliedFunction -> String
$cshowList :: Operations -> ShowS
showList :: Operations -> ShowS
Show)

-- | Create Statistics from a list of values
initStatistics :: Values -> Statistics
initStatistics :: Values -> Statistics
initStatistics Values
vs = Statistics
forall a. Monoid a => a
mempty {values = vs}

-- | Return the specializations used during the creation of values
valuesSpecializations :: Statistics -> [Specialization]
valuesSpecializations :: Statistics -> [Specialization]
valuesSpecializations Statistics
stats =
  case Values -> [Value]
listValues (Statistics -> Values
values Statistics
stats) of
    [] -> []
    Value
v : [Value]
vs ->
      case Value -> Maybe Specialization
valueSpecialization Value
v of
        Just Specialization
s -> Specialization
s Specialization -> [Specialization] -> [Specialization]
forall a. a -> [a] -> [a]
: Statistics -> [Specialization]
valuesSpecializations Statistics
stats {values = fromValues vs}
        Maybe Specialization
Nothing -> Statistics -> [Specialization]
valuesSpecializations Statistics
stats {values = fromValues vs}

-- | Return the list of distinct paths from the root of a value graph to leaves
--   of that graph.
--   This can be used to check if a given value was indeed used according to a given
--   specialization
allValuesPaths :: Statistics -> Paths
allValuesPaths :: Statistics -> Paths
allValuesPaths Statistics
stats = do
  Value
v <- Values -> [Value]
listValues (Values -> [Value]) -> Values -> [Value]
forall a b. (a -> b) -> a -> b
$ Statistics -> Values
values Statistics
stats
  Value -> Paths
valuePaths Value
v

-- | Return all the paths from a given value to all its dependencies
valuePaths :: Value -> Paths
valuePaths :: Value -> Paths
valuePaths v :: Value
v@(CreatedValue Dynamic
_ ValueDescription
_ Maybe SpecializationContext
_ (Dependencies [Value]
ds)) = do
  Value
d <- [Value]
ds
  (Value
v :) ([Value] -> [Value]) -> Paths -> Paths
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Paths
valuePaths Value
d
valuePaths Value
_ = []

-- | Find the most recently created value of a given type
findMostRecentValue :: forall a. (Typeable a) => Statistics -> Maybe Value
findMostRecentValue :: forall {k} (a :: k). Typeable a => Statistics -> Maybe Value
findMostRecentValue Statistics
stats = SomeTypeRep -> Values -> Maybe Value
findValue (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)) (Statistics -> Values
values Statistics
stats)

-- | Find the created values of a given type
findCreatedValues :: forall a. (Typeable a) => Statistics -> [Value]
findCreatedValues :: forall {k} (a :: k). Typeable a => Statistics -> [Value]
findCreatedValues Statistics
stats = SomeTypeRep -> Values -> [Value]
findValues(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)) (Statistics -> Values
values Statistics
stats)