{-# 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 (a :: k) (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> Either Text Statistics
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 -> [Char] -> Statistics
forall a. HasCallStack => [Char] -> a
Prelude.error (Text -> [Char]
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 = Values
forall a. Monoid a => a
mempty
      entries :: Entries
entries = Registry ins out -> Entries
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Entries
_entries Registry ins out
registry
      specializations :: Specializations
specializations = Registry ins out -> Specializations
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Specializations
_specializations Registry ins out
registry
      modifiers :: Modifiers
modifiers = Registry ins out -> Modifiers
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Modifiers
_modifiers Registry ins out
registry
      targetType :: SomeTypeRep
targetType = 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)
   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 Values -> Stack (Maybe Value) -> Either Text Statistics
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, Maybe SomeTypeRep
forall a. Maybe a
Nothing)]) Entries
entries Specializations
specializations Modifiers
modifiers) of
        Left Text
e ->
          Text -> Either Text Statistics
forall a b. a -> Either a b
Left (Text -> Either Text Statistics) -> Text -> Either Text Statistics
forall a b. (a -> b) -> a -> b
$
            Text
"could not create a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Text
forall a b. (Show a, StringConv [Char] b) => a -> b
show SomeTypeRep
targetType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of the registry because " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nThe registry is\n"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Registry ins out -> Text
forall a b. (Show a, StringConv [Char] b) => a -> b
show Registry ins out
registry
        Either Text Statistics
other ->
          Either Text Statistics
other