{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module PlutusCore.Version (
  Version(..)
  , versionMajor
  , versionMinor
  , versionPatch
  , plcVersion100
  , plcVersion110
  , firstVersion
  , latestVersion
  , knownVersions) where

import PlutusPrelude

import Control.Lens
import Data.Hashable
import Data.Set qualified as Set
import Instances.TH.Lift ()

{- |
The version of Plutus Core used by this program.

The intention is to convey different levels of backwards compatibility for existing scripts:
- Major version changes are backwards-incompatible
- Minor version changes are backwards-compatible
- Patch version changes should be entirely invisible (and we will likely not use this level)

The version used should be changed only when the /language itself/ changes.
For example, adding a new kind of term to the language would require a minor
version bump; removing a kind of term would require a major version bump.

Similarly, changing the semantics of the language will require a version bump,
typically a major one. This is the main reason why the version is actually
tracked in the AST: we can have two language versions with identical ASTs but
different semantics, so we need to track the version explicitly.

Compatibility is about compatibility for specific scripts, not about e.g. tools which consume
scripts. Adding a new kind of term does not change how existing scripts behave, but does
change what tools would need to do to process scripts.
-}
data Version
    = Version { Version -> Natural
_versionMajor :: Natural, Version -> Natural
_versionMinor :: Natural, Version -> Natural
_versionPatch :: Natural }
    deriving stock (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Version -> Rep Version x
from :: forall x. Version -> Rep Version x
$cto :: forall x. Rep Version x -> Version
to :: forall x. Rep Version x -> Version
Generic)
    deriving anyclass (Version -> ()
(Version -> ()) -> NFData Version
forall a. (a -> ()) -> NFData a
$crnf :: Version -> ()
rnf :: Version -> ()
NFData, Eq Version
Eq Version =>
(Int -> Version -> Int) -> (Version -> Int) -> Hashable Version
Int -> Version -> Int
Version -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Version -> Int
hashWithSalt :: Int -> Version -> Int
$chash :: Version -> Int
hash :: Version -> Int
Hashable)

makeLenses ''Version

-- This is probably what the derived version would do, but better to be explicit since it's
-- important
instance Ord Version where
  compare :: Version -> Version -> Ordering
compare (Version Natural
major1 Natural
minor1 Natural
patch1) (Version Natural
major2 Natural
minor2 Natural
patch2) =
    Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Natural
major1 Natural
major2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Natural
minor1 Natural
minor2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Natural
patch1 Natural
patch2

-- | The first version of Plutus Core supported by this library.
firstVersion :: Version
firstVersion :: Version
firstVersion = Version
plcVersion100

-- | Plutus Core version 1.0.0
plcVersion100 :: Version
plcVersion100 :: Version
plcVersion100 = Natural -> Natural -> Natural -> Version
Version Natural
1 Natural
0 Natural
0

-- | Plutus Core version 1.1.0
plcVersion110 :: Version
plcVersion110 :: Version
plcVersion110 = Natural -> Natural -> Natural -> Version
Version Natural
1 Natural
1 Natural
0

-- | The latest version of Plutus Core supported by this library.
latestVersion :: Version
latestVersion :: Version
latestVersion = Version
plcVersion110

-- | The set of versions that are "known", i.e. that have been released
-- and have actual differences associated with them.
knownVersions :: Set.Set Version
knownVersions :: Set Version
knownVersions = [Version] -> Set Version
forall a. Ord a => [a] -> Set a
Set.fromList [ Version
plcVersion100, Version
plcVersion110 ]

instance Pretty Version where
    pretty :: forall ann. Version -> Doc ann
pretty (Version Natural
i Natural
j Natural
k) = Natural -> Doc ann
forall ann. Natural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Natural
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Natural -> Doc ann
forall ann. Natural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Natural
j Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Natural -> Doc ann
forall ann. Natural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Natural
k