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

module Data.Registry.Statistics (
  module S
, makeStatistics
, makeStatisticsEither
) where

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

-- | 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 :: Registry ins out -> Statistics
makeStatistics Registry ins out
registry =
  case Registry ins out -> Either Text Statistics
forall a (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 :: Registry ins out -> Either Text Statistics
makeStatisticsEither Registry ins out
registry =
  let values :: Values
values          = Registry ins out -> Values
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Values
_values Registry ins out
registry
      functions :: Functions
functions       = Registry ins out -> Functions
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Functions
_functions 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
-> Functions
-> Specializations
-> Modifiers
-> Stack (Maybe Value)
makeUntyped SomeTypeRep
targetType ([(SomeTypeRep, Maybe SomeTypeRep)] -> Context
Context [(SomeTypeRep
targetType, Maybe SomeTypeRep
forall a. Maybe a
Nothing)]) Functions
functions 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, ConvertText [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, ConvertText [Char] b) => a -> b
show Registry ins out
registry

        Either Text Statistics
other ->
          Either Text Statistics
other