{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}


-- | Bcc eras, sometimes we have to distinguish them.
--
module Bcc.Api.Eras
  ( -- * Eras
    ColeEra
  , SophieEra
  , EvieEra
  , JenEra
  , AurumEra
  , BccEra(..)
  , IsBccEra(..)
  , AnyBccEra(..)
  , anyBccEra
  , InAnyBccEra(..)

    -- * Deprecated aliases
  , Cole
  , Sophie
  , Evie
  , Jen

    -- * Sophie-based eras
  , SophieBasedEra(..)
  , IsSophieBasedEra(..)
  , InAnySophieBasedEra(..)
  , sophieBasedToBccEra

    -- ** Mapping to era types from the Sophie ledger library
  , SophieLedgerEra

    -- * Bcc eras, as Cole vs Sophie-based
  , BccEraStyle(..)
  , bccEraStyle

    -- * Data family instances
  , AsType(AsColeEra, AsSophieEra, AsEvieEra, AsJenEra, AsAurumEra,
           AsCole,    AsSophie,    AsEvie,    AsJen)
  ) where

import           Prelude

import           Data.Aeson (ToJSON, toJSON)
import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))

import           Shardagnostic.Consensus.Sophie.Eras as Ledger
                   (StandardSophie,
                    StandardEvie,
                    StandardJen,
                    StandardAurum)

import           Bcc.Api.HasTypeProxy


-- | A type used as a tag to distinguish the Cole era.
data ColeEra

-- | A type used as a tag to distinguish the Sophie era.
data SophieEra

-- | A type used as a tag to distinguish the Evie era.
data EvieEra

-- | A type used as a tag to distinguish the Jen era.
data JenEra

-- | A type used as a tag to distinguish the Aurum era.
data AurumEra

instance HasTypeProxy ColeEra where
    data AsType ColeEra = AsColeEra
    proxyToAsType :: Proxy ColeEra -> AsType ColeEra
proxyToAsType Proxy ColeEra
_ = AsType ColeEra
AsColeEra

instance HasTypeProxy SophieEra where
    data AsType SophieEra = AsSophieEra
    proxyToAsType :: Proxy SophieEra -> AsType SophieEra
proxyToAsType Proxy SophieEra
_ = AsType SophieEra
AsSophieEra

instance HasTypeProxy EvieEra where
    data AsType EvieEra = AsEvieEra
    proxyToAsType :: Proxy EvieEra -> AsType EvieEra
proxyToAsType Proxy EvieEra
_ = AsType EvieEra
AsEvieEra

instance HasTypeProxy JenEra where
    data AsType JenEra = AsJenEra
    proxyToAsType :: Proxy JenEra -> AsType JenEra
proxyToAsType Proxy JenEra
_ = AsType JenEra
AsJenEra

instance HasTypeProxy AurumEra where
    data AsType AurumEra = AsAurumEra
    proxyToAsType :: Proxy AurumEra -> AsType AurumEra
proxyToAsType Proxy AurumEra
_ = AsType AurumEra
AsAurumEra


-- ----------------------------------------------------------------------------
-- Deprecated aliases
--

type Cole   = ColeEra
type Sophie = SophieEra
type Evie = EvieEra
type Jen    = JenEra

{-# DEPRECATED Cole   "Use 'ColeEra' or 'ColeAddr' as appropriate" #-}
{-# DEPRECATED Sophie "Use 'SophieEra' or 'SophieAddr' as appropriate" #-}
{-# DEPRECATED Evie "Use 'EvieEra' instead" #-}
{-# DEPRECATED Jen    "Use 'JenEra' instead" #-}

pattern AsCole   :: AsType ColeEra
pattern $bAsCole :: AsType ColeEra
$mAsCole :: forall r. AsType ColeEra -> (Void# -> r) -> (Void# -> r) -> r
AsCole    = AsColeEra

pattern AsSophie :: AsType SophieEra
pattern $bAsSophie :: AsType SophieEra
$mAsSophie :: forall r. AsType SophieEra -> (Void# -> r) -> (Void# -> r) -> r
AsSophie  = AsSophieEra

pattern AsEvie :: AsType EvieEra
pattern $bAsEvie :: AsType EvieEra
$mAsEvie :: forall r. AsType EvieEra -> (Void# -> r) -> (Void# -> r) -> r
AsEvie  = AsEvieEra

pattern AsJen    :: AsType JenEra
pattern $bAsJen :: AsType JenEra
$mAsJen :: forall r. AsType JenEra -> (Void# -> r) -> (Void# -> r) -> r
AsJen     = AsJenEra

{-# DEPRECATED AsCole   "Use 'AsColeEra' instead" #-}
{-# DEPRECATED AsSophie "Use 'AsSophieEra' instead" #-}
{-# DEPRECATED AsEvie "Use 'AsEvieEra' instead" #-}
{-# DEPRECATED AsJen    "Use 'AsJenEra' instead" #-}

-- ----------------------------------------------------------------------------
-- Value level representation for Bcc eras
--

-- | This GADT provides a value-level representation of all the Bcc eras.
-- This enables pattern matching on the era to allow them to be treated in a
-- non-uniform way.
--
-- This can be used in combination with the 'IsBccEra' class to get access
-- to this value.
--
-- In combination this can often enable code that handles all eras, and does
-- so uniformly where possible, and non-uniformly where necessary.
--
data BccEra era where
     ColeEra   :: BccEra ColeEra
     SophieEra :: BccEra SophieEra
     EvieEra :: BccEra EvieEra
     JenEra    :: BccEra JenEra
     AurumEra  :: BccEra AurumEra

deriving instance Eq   (BccEra era)
deriving instance Ord  (BccEra era)
deriving instance Show (BccEra era)

instance ToJSON (BccEra era) where
   toJSON :: BccEra era -> Value
toJSON BccEra era
ColeEra   = Value
"Cole"
   toJSON BccEra era
SophieEra = Value
"Sophie"
   toJSON BccEra era
EvieEra = Value
"Evie"
   toJSON BccEra era
JenEra    = Value
"Jen"
   toJSON BccEra era
AurumEra  = Value
"Aurum"

instance TestEquality BccEra where
    testEquality :: BccEra a -> BccEra b -> Maybe (a :~: b)
testEquality BccEra a
ColeEra   BccEra b
ColeEra   = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality BccEra a
SophieEra BccEra b
SophieEra = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality BccEra a
EvieEra BccEra b
EvieEra = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality BccEra a
JenEra    BccEra b
JenEra    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality BccEra a
AurumEra  BccEra b
AurumEra  = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality BccEra a
_          BccEra b
_          = Maybe (a :~: b)
forall a. Maybe a
Nothing


-- | The class of Bcc eras. This allows uniform handling of all Bcc
-- eras, but also non-uniform by making case distinctions on the 'BccEra'
-- constructors, or the 'BccEraStyle' constructors via `bccEraStyle`.
--
class HasTypeProxy era => IsBccEra era where
   bccEra      :: BccEra era

instance IsBccEra ColeEra where
   bccEra :: BccEra ColeEra
bccEra      = BccEra ColeEra
ColeEra

instance IsBccEra SophieEra where
   bccEra :: BccEra SophieEra
bccEra      = BccEra SophieEra
SophieEra

instance IsBccEra EvieEra where
   bccEra :: BccEra EvieEra
bccEra      = BccEra EvieEra
EvieEra

instance IsBccEra JenEra where
   bccEra :: BccEra JenEra
bccEra      = BccEra JenEra
JenEra

instance IsBccEra AurumEra where
   bccEra :: BccEra AurumEra
bccEra      = BccEra AurumEra
AurumEra

data AnyBccEra where
     AnyBccEra :: IsBccEra era  -- Provide class constraint
                   => BccEra era    -- and explicit value.
                   -> AnyBccEra

deriving instance Show AnyBccEra

instance Eq AnyBccEra where
    AnyBccEra BccEra era
era == :: AnyBccEra -> AnyBccEra -> Bool
== AnyBccEra BccEra era
era' =
      case BccEra era -> BccEra era -> Maybe (era :~: era)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality BccEra era
era BccEra era
era' of
        Maybe (era :~: era)
Nothing   -> Bool
False
        Just era :~: era
Refl -> Bool
True -- since no constructors share types

instance ToJSON AnyBccEra where
   toJSON :: AnyBccEra -> Value
toJSON (AnyBccEra BccEra era
era) = BccEra era -> Value
forall a. ToJSON a => a -> Value
toJSON BccEra era
era

-- | Like the 'AnyBccEra' constructor but does not demand a 'IsBccEra'
-- class constraint.
--
anyBccEra :: BccEra era -> AnyBccEra
anyBccEra :: BccEra era -> AnyBccEra
anyBccEra BccEra era
ColeEra   = BccEra ColeEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra ColeEra
ColeEra
anyBccEra BccEra era
SophieEra = BccEra SophieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra SophieEra
SophieEra
anyBccEra BccEra era
EvieEra = BccEra EvieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra EvieEra
EvieEra
anyBccEra BccEra era
JenEra    = BccEra JenEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra JenEra
JenEra
anyBccEra BccEra era
AurumEra  = BccEra AurumEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra AurumEra
AurumEra

-- | This pairs up some era-dependent type with a 'BccEra' value that tells
-- us what era it is, but hides the era type. This is useful when the era is
-- not statically known, for example when deserialising from a file.
--
data InAnyBccEra thing where
     InAnyBccEra :: IsBccEra era  -- Provide class constraint
                     => BccEra era    -- and explicit value.
                     -> thing era
                     -> InAnyBccEra thing


-- ----------------------------------------------------------------------------
-- Sophie-based eras
--

-- | While the Cole and Sophie eras are quite different, there are several
-- eras that are based on Sophie with only minor differences. It is useful
-- to be able to treat the Sophie-based eras in a mostly-uniform way.
--
-- Values of this type witness the fact that the era is Sophie-based. This
-- can be used to constrain the era to being a Sophie-based on. It allows
-- non-uniform handling making case distinctions on the constructor.
--
data SophieBasedEra era where
     SophieBasedEraSophie :: SophieBasedEra SophieEra
     SophieBasedEraEvie :: SophieBasedEra EvieEra
     SophieBasedEraJen    :: SophieBasedEra JenEra
     SophieBasedEraAurum  :: SophieBasedEra AurumEra

deriving instance Eq   (SophieBasedEra era)
deriving instance Ord  (SophieBasedEra era)
deriving instance Show (SophieBasedEra era)

-- | The class of eras that are based on Sophie. This allows uniform handling
-- of Sophie-based eras, but also non-uniform by making case distinctions on
-- the 'SophieBasedEra' constructors.
--
class IsBccEra era => IsSophieBasedEra era where
   sophieBasedEra :: SophieBasedEra era

instance IsSophieBasedEra SophieEra where
   sophieBasedEra :: SophieBasedEra SophieEra
sophieBasedEra = SophieBasedEra SophieEra
SophieBasedEraSophie

instance IsSophieBasedEra EvieEra where
   sophieBasedEra :: SophieBasedEra EvieEra
sophieBasedEra = SophieBasedEra EvieEra
SophieBasedEraEvie

instance IsSophieBasedEra JenEra where
   sophieBasedEra :: SophieBasedEra JenEra
sophieBasedEra = SophieBasedEra JenEra
SophieBasedEraJen

instance IsSophieBasedEra AurumEra where
   sophieBasedEra :: SophieBasedEra AurumEra
sophieBasedEra = SophieBasedEra AurumEra
SophieBasedEraAurum

-- | This pairs up some era-dependent type with a 'SophieBasedEra' value that
-- tells us what era it is, but hides the era type. This is useful when the era
-- is not statically known, for example when deserialising from a file.
--
data InAnySophieBasedEra thing where
     InAnySophieBasedEra :: IsSophieBasedEra era -- Provide class constraint
                          => SophieBasedEra era   -- and explicit value.
                          -> thing era
                          -> InAnySophieBasedEra thing


-- | Converts a 'SophieBasedEra' to the broader 'BccEra'.
sophieBasedToBccEra :: SophieBasedEra era -> BccEra era
sophieBasedToBccEra :: SophieBasedEra era -> BccEra era
sophieBasedToBccEra SophieBasedEra era
SophieBasedEraSophie = BccEra era
BccEra SophieEra
SophieEra
sophieBasedToBccEra SophieBasedEra era
SophieBasedEraEvie = BccEra era
BccEra EvieEra
EvieEra
sophieBasedToBccEra SophieBasedEra era
SophieBasedEraJen    = BccEra era
BccEra JenEra
JenEra
sophieBasedToBccEra SophieBasedEra era
SophieBasedEraAurum  = BccEra era
BccEra AurumEra
AurumEra


-- ----------------------------------------------------------------------------
-- Bcc eras factored as Cole vs Sophie-based
--

-- | This is the same essential information as 'BccEra' but instead of a
-- flat set of alternative eras, it is factored into the legcy Cole era and
-- the current Sophie-based eras.
--
-- This way of factoring the eras is useful because in many cases the
-- major differences are between the Cole and Sophie-based eras, and
-- the Sophie-based eras can often be treated uniformly.
--
data BccEraStyle era where
     LegacyColeEra  :: BccEraStyle ColeEra
     SophieBasedEra :: IsSophieBasedEra era -- Also provide class constraint
                     => SophieBasedEra era
                     -> BccEraStyle era

deriving instance Eq   (BccEraStyle era)
deriving instance Ord  (BccEraStyle era)
deriving instance Show (BccEraStyle era)

-- | The 'BccEraStyle' for a 'BccEra'.
--
bccEraStyle :: BccEra era -> BccEraStyle era
bccEraStyle :: BccEra era -> BccEraStyle era
bccEraStyle BccEra era
ColeEra   = BccEraStyle era
BccEraStyle ColeEra
LegacyColeEra
bccEraStyle BccEra era
SophieEra = SophieBasedEra SophieEra -> BccEraStyle SophieEra
forall era.
IsSophieBasedEra era =>
SophieBasedEra era -> BccEraStyle era
SophieBasedEra SophieBasedEra SophieEra
SophieBasedEraSophie
bccEraStyle BccEra era
EvieEra = SophieBasedEra EvieEra -> BccEraStyle EvieEra
forall era.
IsSophieBasedEra era =>
SophieBasedEra era -> BccEraStyle era
SophieBasedEra SophieBasedEra EvieEra
SophieBasedEraEvie
bccEraStyle BccEra era
JenEra    = SophieBasedEra JenEra -> BccEraStyle JenEra
forall era.
IsSophieBasedEra era =>
SophieBasedEra era -> BccEraStyle era
SophieBasedEra SophieBasedEra JenEra
SophieBasedEraJen
bccEraStyle BccEra era
AurumEra  = SophieBasedEra AurumEra -> BccEraStyle AurumEra
forall era.
IsSophieBasedEra era =>
SophieBasedEra era -> BccEraStyle era
SophieBasedEra SophieBasedEra AurumEra
SophieBasedEraAurum


-- ----------------------------------------------------------------------------
-- Conversion to Sophie ledger library types
--

-- | A type family that connects our era type tags to equivalent type tags used
-- in the Sophie ledger library.
--
-- This type mapping  connect types from this API with types in the Sophie
-- ledger library which allows writing conversion functions in a more generic
-- way.
--
type family SophieLedgerEra era where

  SophieLedgerEra SophieEra = Ledger.StandardSophie
  SophieLedgerEra EvieEra = Ledger.StandardEvie
  SophieLedgerEra JenEra    = Ledger.StandardJen
  SophieLedgerEra AurumEra  = Ledger.StandardAurum