{-# 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
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 forall a. Semigroup a => a -> a -> a
<> Operations
ops2) (Values
vs1 forall a. Semigroup a => a -> a -> a
<> Values
vs2)

instance Monoid Statistics where
  mempty :: Statistics
mempty = Operations -> Values -> Statistics
Statistics forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
  mappend :: Statistics -> Statistics -> Statistics
mappend = 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
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)

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

-- | Return the specializations used during the creation of values
valuesSpecializations :: Statistics -> [Specialization]
valuesSpecializations :: Statistics -> [Specialization]
valuesSpecializations Statistics
stats =
  case Values -> [Value]
toValues (Statistics -> Values
values Statistics
stats) of
    [] -> []
    Value
v : [Value]
vs ->
      case Value -> Maybe Specialization
valueSpecialization Value
v of
        Just Specialization
s -> Specialization
s forall a. a -> [a] -> [a]
: Statistics -> [Specialization]
valuesSpecializations Statistics
stats {values :: Values
values = [Value] -> Values
fromValues [Value]
vs}
        Maybe Specialization
Nothing -> Statistics -> [Specialization]
valuesSpecializations Statistics
stats {values :: Values
values = [Value] -> Values
fromValues [Value]
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]
toValues 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 :) 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Value
v -> Value -> SomeTypeRep
valueDynTypeRep Value
v forall a. Eq a => a -> a -> Bool
== forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) forall a b. (a -> b) -> a -> b
$ Values -> [Value]
toValues (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 = forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
v -> Value -> SomeTypeRep
valueDynTypeRep Value
v forall a. Eq a => a -> a -> Bool
== forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) forall a b. (a -> b) -> a -> b
$ Values -> [Value]
toValues (Statistics -> Values
values Statistics
stats)