{-# 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 = makeEitherWithContext (Context [someTypeRep (Proxy :: Proxy a)])
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)
makeSpecialized :: forall a b ins out . (Typeable a, Typeable b, Contains b out, Solvable ins out) => Registry ins out -> b
makeSpecialized = makeSpecializedUnsafe @a @b
makeSpecializedPath :: forall path b ins out . (PathToTypeReps path, Typeable b, Contains b out, Solvable ins out) => Registry ins out -> b
makeSpecializedPath = makeSpecializedPathUnsafe @path @b
makeSpecializedFast :: forall a b ins out . (Typeable a, Typeable b, Contains b out) => Registry ins out -> b
makeSpecializedFast = makeSpecializedUnsafe @a @b
makeSpecializedPathFast :: forall path b ins out . (PathToTypeReps path, Typeable b, Contains b out) => Registry ins out -> b
makeSpecializedPathFast = makeSpecializedPathUnsafe @path @b
makeSpecializedUnsafe :: forall a b ins out . (Typeable a, Typeable b) => Registry ins out -> b
makeSpecializedUnsafe registry =
case makeSpecializedEither @a @b registry of
Right a -> a
Left e -> Prelude.error (toS e)
makeSpecializedPathUnsafe :: forall path b ins out . (PathToTypeReps path, Typeable b) => Registry ins out -> b
makeSpecializedPathUnsafe registry =
case makeSpecializedPathEither @path @b registry of
Right a -> a
Left e -> Prelude.error (toS e)
makeSpecializedEither :: forall a b ins out . (Typeable a, Typeable b) => Registry ins out -> Either Text b
makeSpecializedEither = makeEitherWithContext (Context [someTypeRep (Proxy :: Proxy a), someTypeRep (Proxy :: Proxy b)])
makeSpecializedPathEither :: forall path b ins out . (PathToTypeReps path, Typeable b) => Registry ins out -> Either Text b
makeSpecializedPathEither = makeEitherWithContext (Context (toList $ someTypeReps (Proxy :: Proxy path)))
makeEitherWithContext :: forall a ins out . (Typeable a) => Context -> Registry ins out -> Either Text a
makeEitherWithContext context 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 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))