{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}

module Simplex.Messaging.Version
  ( Version,
    VersionRange (minVersion, maxVersion),
    VersionScope,
    pattern VersionRange,
    VersionI (..),
    VersionRangeI (..),
    Compatible,
    pattern Compatible,
    mkVersionRange,
    safeVersionRange,
    versionToRange,
    isCompatible,
    isCompatibleRange,
    proveCompatible,
    compatibleVersion,
    compatibleVRange,
    compatibleVRange',
  )
where

import Control.Applicative (optional)
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import Data.Aeson.Types ((.:), (.=))
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Version.Internal (Version (..))

pattern VersionRange :: Version v -> Version v -> VersionRange v
pattern $mVersionRange :: forall {r} {v}.
VersionRange v
-> (Version v -> Version v -> r) -> ((# #) -> r) -> r
VersionRange v1 v2 <- VRange v1 v2

{-# COMPLETE VersionRange #-}

data VersionRange v = VRange
  { forall v. VersionRange v -> Version v
minVersion :: Version v,
    forall v. VersionRange v -> Version v
maxVersion :: Version v
  }
  deriving (VersionRange v -> VersionRange v -> Bool
(VersionRange v -> VersionRange v -> Bool)
-> (VersionRange v -> VersionRange v -> Bool)
-> Eq (VersionRange v)
forall v. VersionRange v -> VersionRange v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. VersionRange v -> VersionRange v -> Bool
== :: VersionRange v -> VersionRange v -> Bool
$c/= :: forall v. VersionRange v -> VersionRange v -> Bool
/= :: VersionRange v -> VersionRange v -> Bool
Eq, Int -> VersionRange v -> ShowS
[VersionRange v] -> ShowS
VersionRange v -> String
(Int -> VersionRange v -> ShowS)
-> (VersionRange v -> String)
-> ([VersionRange v] -> ShowS)
-> Show (VersionRange v)
forall v. Int -> VersionRange v -> ShowS
forall v. [VersionRange v] -> ShowS
forall v. VersionRange v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Int -> VersionRange v -> ShowS
showsPrec :: Int -> VersionRange v -> ShowS
$cshow :: forall v. VersionRange v -> String
show :: VersionRange v -> String
$cshowList :: forall v. [VersionRange v] -> ShowS
showList :: [VersionRange v] -> ShowS
Show)

instance J.FromJSON (VersionRange v) where
  parseJSON :: Value -> Parser (VersionRange v)
parseJSON (J.Object Object
v) = do
    Version v
minVersion <- Object
v Object -> Key -> Parser (Version v)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minVersion"
    Version v
maxVersion <- Object
v Object -> Key -> Parser (Version v)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxVersion"
    VersionRange v -> Parser (VersionRange v)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VRange {Version v
minVersion :: Version v
minVersion :: Version v
minVersion, Version v
maxVersion :: Version v
maxVersion :: Version v
maxVersion}
  parseJSON Value
invalid =
    String -> Parser (VersionRange v) -> Parser (VersionRange v)
forall a. String -> Parser a -> Parser a
JT.prependFailure String
"bad VersionRange, " (String -> Value -> Parser (VersionRange v)
forall a. String -> Value -> Parser a
JT.typeMismatch String
"Object" Value
invalid)

instance J.ToJSON (VersionRange v) where
  toEncoding :: VersionRange v -> Encoding
toEncoding VRange {Version v
minVersion :: forall v. VersionRange v -> Version v
minVersion :: Version v
minVersion, Version v
maxVersion :: forall v. VersionRange v -> Version v
maxVersion :: Version v
maxVersion} = Series -> Encoding
JE.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ (Key
"minVersion" Key -> Version v -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Version v
minVersion) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (Key
"maxVersion" Key -> Version v -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Version v
maxVersion)
  toJSON :: VersionRange v -> Value
toJSON VRange {Version v
minVersion :: forall v. VersionRange v -> Version v
minVersion :: Version v
minVersion, Version v
maxVersion :: forall v. VersionRange v -> Version v
maxVersion :: Version v
maxVersion} = [Pair] -> Value
J.object [Key
"minVersion" Key -> Version v -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Version v
minVersion, Key
"maxVersion" Key -> Version v -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Version v
maxVersion]

class VersionScope v

-- | construct valid version range, to be used in constants
mkVersionRange :: Version v -> Version v -> VersionRange v
mkVersionRange :: forall v. Version v -> Version v -> VersionRange v
mkVersionRange Version v
v1 Version v
v2
  | Version v
v1 Version v -> Version v -> Bool
forall a. Ord a => a -> a -> Bool
<= Version v
v2 = Version v -> Version v -> VersionRange v
forall v. Version v -> Version v -> VersionRange v
VRange Version v
v1 Version v
v2
  | Bool
otherwise = String -> VersionRange v
forall a. HasCallStack => String -> a
error String
"invalid version range"

safeVersionRange :: Version v -> Version v -> Maybe (VersionRange v)
safeVersionRange :: forall v. Version v -> Version v -> Maybe (VersionRange v)
safeVersionRange Version v
v1 Version v
v2
  | Version v
v1 Version v -> Version v -> Bool
forall a. Ord a => a -> a -> Bool
<= Version v
v2 = VersionRange v -> Maybe (VersionRange v)
forall a. a -> Maybe a
Just (VersionRange v -> Maybe (VersionRange v))
-> VersionRange v -> Maybe (VersionRange v)
forall a b. (a -> b) -> a -> b
$ Version v -> Version v -> VersionRange v
forall v. Version v -> Version v -> VersionRange v
VRange Version v
v1 Version v
v2
  | Bool
otherwise = Maybe (VersionRange v)
forall a. Maybe a
Nothing

versionToRange :: Version v -> VersionRange v
versionToRange :: forall v. Version v -> VersionRange v
versionToRange Version v
v = Version v -> Version v -> VersionRange v
forall v. Version v -> Version v -> VersionRange v
VRange Version v
v Version v
v

instance VersionScope v => Encoding (VersionRange v) where
  smpEncode :: VersionRange v -> ByteString
smpEncode (VRange Version v
v1 Version v
v2) = (Version v, Version v) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (Version v
v1, Version v
v2)
  smpP :: Parser (VersionRange v)
smpP =
    Parser (VersionRange v)
-> (VersionRange v -> Parser (VersionRange v))
-> Maybe (VersionRange v)
-> Parser (VersionRange v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (VersionRange v)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid version range") VersionRange v -> Parser (VersionRange v)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Maybe (VersionRange v) -> Parser (VersionRange v))
-> Parser ByteString (Maybe (VersionRange v))
-> Parser (VersionRange v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Version v -> Version v -> Maybe (VersionRange v)
forall v. Version v -> Version v -> Maybe (VersionRange v)
safeVersionRange (Version v -> Version v -> Maybe (VersionRange v))
-> Parser ByteString (Version v)
-> Parser ByteString (Version v -> Maybe (VersionRange v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Version v)
forall a. Encoding a => Parser a
smpP Parser ByteString (Version v -> Maybe (VersionRange v))
-> Parser ByteString (Version v)
-> Parser ByteString (Maybe (VersionRange v))
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Version v)
forall a. Encoding a => Parser a
smpP

instance VersionScope v => StrEncoding (VersionRange v) where
  strEncode :: VersionRange v -> ByteString
strEncode (VRange Version v
v1 Version v
v2)
    | Version v
v1 Version v -> Version v -> Bool
forall a. Eq a => a -> a -> Bool
== Version v
v2 = Version v -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Version v
v1
    | Bool
otherwise = Version v -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Version v
v1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version v -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Version v
v2
  strP :: Parser (VersionRange v)
strP = do
    Version v
v1 <- Parser (Version v)
forall a. StrEncoding a => Parser a
strP
    Version v
v2 <- Parser (Version v)
-> (Char -> Parser (Version v)) -> Maybe Char -> Parser (Version v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Version v -> Parser (Version v)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version v
v1) (Parser (Version v) -> Char -> Parser (Version v)
forall a b. a -> b -> a
const Parser (Version v)
forall a. StrEncoding a => Parser a
strP) (Maybe Char -> Parser (Version v))
-> Parser ByteString (Maybe Char) -> Parser (Version v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
'-')
    Parser (VersionRange v)
-> (VersionRange v -> Parser (VersionRange v))
-> Maybe (VersionRange v)
-> Parser (VersionRange v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (VersionRange v)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid version range") VersionRange v -> Parser (VersionRange v)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (VersionRange v) -> Parser (VersionRange v))
-> Maybe (VersionRange v) -> Parser (VersionRange v)
forall a b. (a -> b) -> a -> b
$ Version v -> Version v -> Maybe (VersionRange v)
forall v. Version v -> Version v -> Maybe (VersionRange v)
safeVersionRange Version v
v1 Version v
v2

class VersionScope v => VersionI v a | a -> v where
  type VersionRangeT v a
  version :: a -> Version v
  toVersionRangeT :: a -> VersionRange v -> VersionRangeT v a

class VersionScope v => VersionRangeI v a | a -> v where
  type VersionT v a
  versionRange :: a -> VersionRange v
  toVersionRange :: a -> VersionRange v -> a
  toVersionT :: a -> Version v -> VersionT v a

instance VersionScope v => VersionI v (Version v) where
  type VersionRangeT v (Version v) = VersionRange v
  version :: Version v -> Version v
version = Version v -> Version v
forall a. a -> a
id
  toVersionRangeT :: Version v -> VersionRange v -> VersionRangeT v (Version v)
toVersionRangeT Version v
_ VersionRange v
vr = VersionRangeT v (Version v)
VersionRange v
vr

instance VersionScope v => VersionRangeI v (VersionRange v) where
  type VersionT v (VersionRange v) = Version v
  versionRange :: VersionRange v -> VersionRange v
versionRange = VersionRange v -> VersionRange v
forall a. a -> a
id
  toVersionRange :: VersionRange v -> VersionRange v -> VersionRange v
toVersionRange VersionRange v
_ VersionRange v
vr = VersionRange v
vr
  toVersionT :: VersionRange v -> Version v -> VersionT v (VersionRange v)
toVersionT VersionRange v
_ Version v
v = Version v
VersionT v (VersionRange v)
v

newtype Compatible a = Compatible_ a

pattern Compatible :: a -> Compatible a
pattern $mCompatible :: forall {r} {a}. Compatible a -> (a -> r) -> ((# #) -> r) -> r
Compatible a <- Compatible_ a

{-# COMPLETE Compatible #-}

isCompatible :: VersionI v a => a -> VersionRange v -> Bool
isCompatible :: forall v a. VersionI v a => a -> VersionRange v -> Bool
isCompatible a
x (VRange Version v
v1 Version v
v2) = let v :: Version v
v = a -> Version v
forall v a. VersionI v a => a -> Version v
version a
x in Version v
v1 Version v -> Version v -> Bool
forall a. Ord a => a -> a -> Bool
<= Version v
v Bool -> Bool -> Bool
&& Version v
v Version v -> Version v -> Bool
forall a. Ord a => a -> a -> Bool
<= Version v
v2

isCompatibleRange :: VersionRangeI v a => a -> VersionRange v -> Bool
isCompatibleRange :: forall v a. VersionRangeI v a => a -> VersionRange v -> Bool
isCompatibleRange a
x (VRange Version v
min2 Version v
max2) = Version v
min1 Version v -> Version v -> Bool
forall a. Ord a => a -> a -> Bool
<= Version v
max2 Bool -> Bool -> Bool
&& Version v
min2 Version v -> Version v -> Bool
forall a. Ord a => a -> a -> Bool
<= Version v
max1
  where
    VRange Version v
min1 Version v
max1 = a -> VersionRange v
forall v a. VersionRangeI v a => a -> VersionRange v
versionRange a
x

proveCompatible :: VersionI v a => a -> VersionRange v -> Maybe (Compatible a)
proveCompatible :: forall v a.
VersionI v a =>
a -> VersionRange v -> Maybe (Compatible a)
proveCompatible a
x VersionRange v
vr = a
x a -> Bool -> Maybe (Compatible a)
forall a. a -> Bool -> Maybe (Compatible a)
`mkCompatibleIf` (a
x a -> VersionRange v -> Bool
forall v a. VersionI v a => a -> VersionRange v -> Bool
`isCompatible` VersionRange v
vr)

compatibleVersion :: VersionRangeI v a => a -> VersionRange v -> Maybe (Compatible (VersionT v a))
compatibleVersion :: forall v a.
VersionRangeI v a =>
a -> VersionRange v -> Maybe (Compatible (VersionT v a))
compatibleVersion a
x VersionRange v
vr =
  a -> Version v -> VersionT v a
forall v a. VersionRangeI v a => a -> Version v -> VersionT v a
toVersionT a
x (Version v -> Version v -> Version v
forall a. Ord a => a -> a -> a
min Version v
max1 Version v
max2) VersionT v a -> Bool -> Maybe (Compatible (VersionT v a))
forall a. a -> Bool -> Maybe (Compatible a)
`mkCompatibleIf` a -> VersionRange v -> Bool
forall v a. VersionRangeI v a => a -> VersionRange v -> Bool
isCompatibleRange a
x VersionRange v
vr
  where
    max1 :: Version v
max1 = VersionRange v -> Version v
forall v. VersionRange v -> Version v
maxVersion (VersionRange v -> Version v) -> VersionRange v -> Version v
forall a b. (a -> b) -> a -> b
$ a -> VersionRange v
forall v a. VersionRangeI v a => a -> VersionRange v
versionRange a
x
    max2 :: Version v
max2 = VersionRange v -> Version v
forall v. VersionRange v -> Version v
maxVersion VersionRange v
vr

-- | intersection of version ranges
compatibleVRange :: VersionRangeI v a => a -> VersionRange v -> Maybe (Compatible a)
compatibleVRange :: forall v a.
VersionRangeI v a =>
a -> VersionRange v -> Maybe (Compatible a)
compatibleVRange a
x VersionRange v
vr =
  a -> Version v -> Version v -> Maybe (Compatible a)
forall v a.
VersionRangeI v a =>
a -> Version v -> Version v -> Maybe (Compatible a)
compatibleVRange_ a
x (Version v -> Version v -> Version v
forall a. Ord a => a -> a -> a
max Version v
min1 Version v
min2) (Version v -> Version v -> Version v
forall a. Ord a => a -> a -> a
min Version v
max1 Version v
max2)
  where
    VRange Version v
min1 Version v
max1 = a -> VersionRange v
forall v a. VersionRangeI v a => a -> VersionRange v
versionRange a
x
    VRange Version v
min2 Version v
max2 = VersionRange v
vr

-- | version range capped by compatible version
compatibleVRange' :: VersionRangeI v a => a -> Version v -> Maybe (Compatible a)
compatibleVRange' :: forall v a.
VersionRangeI v a =>
a -> Version v -> Maybe (Compatible a)
compatibleVRange' a
x Version v
v
  | Version v
v Version v -> Version v -> Bool
forall a. Ord a => a -> a -> Bool
<= Version v
max1 = a -> Version v -> Version v -> Maybe (Compatible a)
forall v a.
VersionRangeI v a =>
a -> Version v -> Version v -> Maybe (Compatible a)
compatibleVRange_ a
x Version v
min1 Version v
v
  | Bool
otherwise = Maybe (Compatible a)
forall a. Maybe a
Nothing
  where
    VRange Version v
min1 Version v
max1 = a -> VersionRange v
forall v a. VersionRangeI v a => a -> VersionRange v
versionRange a
x

compatibleVRange_ :: VersionRangeI v a => a -> Version v -> Version v -> Maybe (Compatible a)
compatibleVRange_ :: forall v a.
VersionRangeI v a =>
a -> Version v -> Version v -> Maybe (Compatible a)
compatibleVRange_ a
x Version v
v1 Version v
v2 = a -> Compatible a
forall a. a -> Compatible a
Compatible_ (a -> Compatible a)
-> (VersionRange v -> a) -> VersionRange v -> Compatible a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> VersionRange v -> a
forall v a. VersionRangeI v a => a -> VersionRange v -> a
toVersionRange a
x (VersionRange v -> Compatible a)
-> Maybe (VersionRange v) -> Maybe (Compatible a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version v -> Version v -> Maybe (VersionRange v)
forall v. Version v -> Version v -> Maybe (VersionRange v)
safeVersionRange Version v
v1 Version v
v2

mkCompatibleIf :: a -> Bool -> Maybe (Compatible a)
a
x mkCompatibleIf :: forall a. a -> Bool -> Maybe (Compatible a)
`mkCompatibleIf` Bool
cond = if Bool
cond then Compatible a -> Maybe (Compatible a)
forall a. a -> Maybe a
Just (Compatible a -> Maybe (Compatible a))
-> Compatible a -> Maybe (Compatible a)
forall a b. (a -> b) -> a -> b
$ a -> Compatible a
forall a. a -> Compatible a
Compatible_ a
x else Maybe (Compatible a)
forall a. Maybe a
Nothing