{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MonoLocalBinds #-}

-- | This module returns creation data about the values created when created a value of a given type
module Data.Registry.Statistics
  ( module S,
    makeStatistics,
    makeStatisticsEither,
  )
where

import Data.Registry.Internal.Make
import Data.Registry.Internal.Stack
import Data.Registry.Internal.Statistics as S
import Data.Registry.Internal.Types
import Data.Registry.Registry
import Protolude
import Type.Reflection
import Prelude (error)

-- | Return `Statistics` as the result of the creation of a value
--   of a given type (and throws an exception if the value cannot be created)
makeStatistics :: forall a ins out. (Typeable a) => Registry ins out -> Statistics
makeStatistics :: forall {k} (a :: k) (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> Statistics
makeStatistics Registry ins out
registry =
  case forall {k} (a :: k) (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> Either Text Statistics
makeStatisticsEither @a Registry ins out
registry of
    Right Statistics
a -> Statistics
a
    Left Text
e -> forall a. HasCallStack => [Char] -> a
Prelude.error (forall a b. ConvertText a b => a -> b
toS Text
e)

-- | Return `Statistics` as the result of the creation of a value
--   of a given type
makeStatisticsEither :: forall a ins out. (Typeable a) => Registry ins out -> Either Text Statistics
makeStatisticsEither :: forall {k} (a :: k) (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> Either Text Statistics
makeStatisticsEither Registry ins out
registry =
  let values :: Values
values = forall a. Monoid a => a
mempty
      entries :: Entries
entries = forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Entries
_entries Registry ins out
registry
      specializations :: Specializations
specializations = forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Specializations
_specializations Registry ins out
registry
      modifiers :: Modifiers
modifiers = forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Modifiers
_modifiers Registry ins out
registry
      targetType :: SomeTypeRep
targetType = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
   in -- use the makeUntyped function to create an element of the target type from a list of values and functions
      -- the list of values is kept as some State so that newly created values can be added to the current state
      case forall a. Values -> Stack a -> Either Text Statistics
evalStackWithValues
        Values
values
        (SomeTypeRep
-> Context
-> Entries
-> Specializations
-> Modifiers
-> Stack (Maybe Value)
makeUntyped SomeTypeRep
targetType ([(SomeTypeRep, Maybe SomeTypeRep)] -> Context
Context [(SomeTypeRep
targetType, forall a. Maybe a
Nothing)]) Entries
entries Specializations
specializations Modifiers
modifiers) of
        Left Text
e ->
          forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
            Text
"could not create a " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv [Char] b) => a -> b
show SomeTypeRep
targetType forall a. Semigroup a => a -> a -> a
<> Text
" out of the registry because " forall a. Semigroup a => a -> a -> a
<> Text
e forall a. Semigroup a => a -> a -> a
<> Text
"\nThe registry is\n"
              forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv [Char] b) => a -> b
show Registry ins out
registry
        Either Text Statistics
other ->
          Either Text Statistics
other