module Language.PureScript.TypeClassDictionaries where

import Prelude

import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Data.Text (Text, pack)

import Language.PureScript.AST.Declarations.ChainId (ChainId)
import Language.PureScript.Names (Ident, ProperName(..), ProperNameType(..), Qualified, disqualify)
import Language.PureScript.Types (SourceConstraint, SourceType)

--
-- Data representing a type class dictionary which is in scope
--
data TypeClassDictionaryInScope v
  = TypeClassDictionaryInScope {
    -- | The instance chain
      forall v. TypeClassDictionaryInScope v -> Maybe ChainId
tcdChain :: Maybe ChainId
    -- | Index of the instance chain
    , forall v. TypeClassDictionaryInScope v -> Integer
tcdIndex :: Integer
    -- | The value with which the dictionary can be accessed at runtime
    , forall v. TypeClassDictionaryInScope v -> v
tcdValue :: v
    -- | How to obtain this instance via superclass relationships
    , forall v.
TypeClassDictionaryInScope v
-> [(Qualified (ProperName 'ClassName), Integer)]
tcdPath :: [(Qualified (ProperName 'ClassName), Integer)]
    -- | The name of the type class to which this type class instance applies
    , forall v.
TypeClassDictionaryInScope v -> Qualified (ProperName 'ClassName)
tcdClassName :: Qualified (ProperName 'ClassName)
    -- | Quantification of type variables in the instance head and dependencies
    , forall v. TypeClassDictionaryInScope v -> [(Text, SourceType)]
tcdForAll :: [(Text, SourceType)]
    -- | The kinds to which this type class instance applies
    , forall v. TypeClassDictionaryInScope v -> [SourceType]
tcdInstanceKinds :: [SourceType]
    -- | The types to which this type class instance applies
    , forall v. TypeClassDictionaryInScope v -> [SourceType]
tcdInstanceTypes :: [SourceType]
    -- | Type class dependencies which must be satisfied to construct this dictionary
    , forall v. TypeClassDictionaryInScope v -> Maybe [SourceConstraint]
tcdDependencies :: Maybe [SourceConstraint]
    -- | If this instance was unnamed, the type to use when describing it in
    -- error messages
    , forall v. TypeClassDictionaryInScope v -> Maybe SourceType
tcdDescription :: Maybe SourceType
    }
    deriving (Int -> TypeClassDictionaryInScope v -> ShowS
forall v. Show v => Int -> TypeClassDictionaryInScope v -> ShowS
forall v. Show v => [TypeClassDictionaryInScope v] -> ShowS
forall v. Show v => TypeClassDictionaryInScope v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeClassDictionaryInScope v] -> ShowS
$cshowList :: forall v. Show v => [TypeClassDictionaryInScope v] -> ShowS
show :: TypeClassDictionaryInScope v -> String
$cshow :: forall v. Show v => TypeClassDictionaryInScope v -> String
showsPrec :: Int -> TypeClassDictionaryInScope v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> TypeClassDictionaryInScope v -> ShowS
Show, forall a b.
a -> TypeClassDictionaryInScope b -> TypeClassDictionaryInScope a
forall a b.
(a -> b)
-> TypeClassDictionaryInScope a -> TypeClassDictionaryInScope b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a -> TypeClassDictionaryInScope b -> TypeClassDictionaryInScope a
$c<$ :: forall a b.
a -> TypeClassDictionaryInScope b -> TypeClassDictionaryInScope a
fmap :: forall a b.
(a -> b)
-> TypeClassDictionaryInScope a -> TypeClassDictionaryInScope b
$cfmap :: forall a b.
(a -> b)
-> TypeClassDictionaryInScope a -> TypeClassDictionaryInScope b
Functor, forall a. Eq a => a -> TypeClassDictionaryInScope a -> Bool
forall a. Num a => TypeClassDictionaryInScope a -> a
forall a. Ord a => TypeClassDictionaryInScope a -> a
forall m. Monoid m => TypeClassDictionaryInScope m -> m
forall a. TypeClassDictionaryInScope a -> Bool
forall a. TypeClassDictionaryInScope a -> Int
forall a. TypeClassDictionaryInScope a -> [a]
forall a. (a -> a -> a) -> TypeClassDictionaryInScope a -> a
forall m a.
Monoid m =>
(a -> m) -> TypeClassDictionaryInScope a -> m
forall b a. (b -> a -> b) -> b -> TypeClassDictionaryInScope a -> b
forall a b. (a -> b -> b) -> b -> TypeClassDictionaryInScope a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => TypeClassDictionaryInScope a -> a
$cproduct :: forall a. Num a => TypeClassDictionaryInScope a -> a
sum :: forall a. Num a => TypeClassDictionaryInScope a -> a
$csum :: forall a. Num a => TypeClassDictionaryInScope a -> a
minimum :: forall a. Ord a => TypeClassDictionaryInScope a -> a
$cminimum :: forall a. Ord a => TypeClassDictionaryInScope a -> a
maximum :: forall a. Ord a => TypeClassDictionaryInScope a -> a
$cmaximum :: forall a. Ord a => TypeClassDictionaryInScope a -> a
elem :: forall a. Eq a => a -> TypeClassDictionaryInScope a -> Bool
$celem :: forall a. Eq a => a -> TypeClassDictionaryInScope a -> Bool
length :: forall a. TypeClassDictionaryInScope a -> Int
$clength :: forall a. TypeClassDictionaryInScope a -> Int
null :: forall a. TypeClassDictionaryInScope a -> Bool
$cnull :: forall a. TypeClassDictionaryInScope a -> Bool
toList :: forall a. TypeClassDictionaryInScope a -> [a]
$ctoList :: forall a. TypeClassDictionaryInScope a -> [a]
foldl1 :: forall a. (a -> a -> a) -> TypeClassDictionaryInScope a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TypeClassDictionaryInScope a -> a
foldr1 :: forall a. (a -> a -> a) -> TypeClassDictionaryInScope a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> TypeClassDictionaryInScope a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> TypeClassDictionaryInScope a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TypeClassDictionaryInScope a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TypeClassDictionaryInScope a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TypeClassDictionaryInScope a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TypeClassDictionaryInScope a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TypeClassDictionaryInScope a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TypeClassDictionaryInScope a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> TypeClassDictionaryInScope a -> b
foldMap' :: forall m a.
Monoid m =>
(a -> m) -> TypeClassDictionaryInScope a -> m
$cfoldMap' :: forall m a.
Monoid m =>
(a -> m) -> TypeClassDictionaryInScope a -> m
foldMap :: forall m a.
Monoid m =>
(a -> m) -> TypeClassDictionaryInScope a -> m
$cfoldMap :: forall m a.
Monoid m =>
(a -> m) -> TypeClassDictionaryInScope a -> m
fold :: forall m. Monoid m => TypeClassDictionaryInScope m -> m
$cfold :: forall m. Monoid m => TypeClassDictionaryInScope m -> m
Foldable, Functor TypeClassDictionaryInScope
Foldable TypeClassDictionaryInScope
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
TypeClassDictionaryInScope (m a)
-> m (TypeClassDictionaryInScope a)
forall (f :: * -> *) a.
Applicative f =>
TypeClassDictionaryInScope (f a)
-> f (TypeClassDictionaryInScope a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> TypeClassDictionaryInScope a -> m (TypeClassDictionaryInScope b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> TypeClassDictionaryInScope a -> f (TypeClassDictionaryInScope b)
sequence :: forall (m :: * -> *) a.
Monad m =>
TypeClassDictionaryInScope (m a)
-> m (TypeClassDictionaryInScope a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
TypeClassDictionaryInScope (m a)
-> m (TypeClassDictionaryInScope a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> TypeClassDictionaryInScope a -> m (TypeClassDictionaryInScope b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> TypeClassDictionaryInScope a -> m (TypeClassDictionaryInScope b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
TypeClassDictionaryInScope (f a)
-> f (TypeClassDictionaryInScope a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TypeClassDictionaryInScope (f a)
-> f (TypeClassDictionaryInScope a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> TypeClassDictionaryInScope a -> f (TypeClassDictionaryInScope b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> TypeClassDictionaryInScope a -> f (TypeClassDictionaryInScope b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x.
Rep (TypeClassDictionaryInScope v) x
-> TypeClassDictionaryInScope v
forall v x.
TypeClassDictionaryInScope v
-> Rep (TypeClassDictionaryInScope v) x
$cto :: forall v x.
Rep (TypeClassDictionaryInScope v) x
-> TypeClassDictionaryInScope v
$cfrom :: forall v x.
TypeClassDictionaryInScope v
-> Rep (TypeClassDictionaryInScope v) x
Generic)

instance NFData v => NFData (TypeClassDictionaryInScope v)

type NamedDict = TypeClassDictionaryInScope (Qualified Ident)

-- | Generate a name for a superclass reference which can be used in
-- generated code.
superclassName :: Qualified (ProperName 'ClassName) -> Integer -> Text
superclassName :: Qualified (ProperName 'ClassName) -> Integer -> Text
superclassName Qualified (ProperName 'ClassName)
pn Integer
index = forall (a :: ProperNameType). ProperName a -> Text
runProperName (forall a. Qualified a -> a
disqualify Qualified (ProperName 'ClassName)
pn) forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Integer
index)