{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Registry.Make where
import Data.Dynamic
import Data.Registry.Internal.Make
import Data.Registry.Internal.Stack
import Data.Registry.Internal.Types
import Data.Registry.Registry
import Data.Registry.Solver
import Data.Typeable (Typeable)
import qualified Prelude (error)
import Protolude as P hiding (Constructor)
import Type.Reflection
make :: forall a ins out .
(Typeable a, Contains a out, Solvable ins out)
=> Registry ins out
-> a
make = makeUnsafe
makeFast :: forall a ins out .
(Typeable a, Contains a out)
=> Registry ins out
-> a
makeFast = makeUnsafe
makeEither :: forall a ins out . (Typeable a) => Registry ins out -> Either Text a
makeEither registry =
let values = _values registry
functions = _functions registry
specializations = _specializations registry
modifiers = _modifiers registry
targetType = someTypeRep (Proxy :: Proxy a)
in
case
runStackWithValues values
(makeUntyped targetType (Context [targetType]) functions specializations modifiers)
of
Left e ->
Left $ "could not create a " <> show targetType <> " out of the registry because " <> e <> "\nThe registry is\n" <>
show registry
Right Nothing ->
Left $ "could not create a " <> show targetType <> " out of the registry." <> "\nThe registry is\n" <>
show registry
Right (Just result) -> fromMaybe
(Left $ "could not cast the computed value to a " <> show targetType <> ". The value is of type: " <> show (valueDynTypeRep result))
(Right <$> fromDynamic (valueDyn result))
makeUnsafe :: forall a ins out . (Typeable a) => Registry ins out -> a
makeUnsafe registry =
case makeEither registry of
Right a -> a
Left e -> Prelude.error (toS e)