{-# 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
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
(<>)

-- | 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
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 }

-- | Return the specializations used during the creation of values
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 }

-- | 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]
unValues (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 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
_ = []

-- | Find the most recently created value of a given type
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)