content: {-# 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 VersionRange v1 v2 <- VRange v1 v2
  
  {-# COMPLETE VersionRange #-}
  
  data VersionRange v = VRange
    { minVersion :: Version v,
      maxVersion :: Version v
    }
    deriving (Eq, Show)
  
  instance J.FromJSON (VersionRange v) where
    parseJSON (J.Object v) = do
      minVersion <- v .: "minVersion"
      maxVersion <- v .: "maxVersion"
      pure VRange {minVersion, maxVersion}
    parseJSON invalid =
      JT.prependFailure "bad VersionRange, " (JT.typeMismatch "Object" invalid)
  
  instance J.ToJSON (VersionRange v) where
    toEncoding VRange {minVersion, maxVersion} = JE.pairs $ ("minVersion" .= minVersion) <> ("maxVersion" .= maxVersion)
    toJSON VRange {minVersion, maxVersion} = J.object ["minVersion" .= minVersion, "maxVersion" .= maxVersion]
  
  class VersionScope v
  
  -- | construct valid version range, to be used in constants
  mkVersionRange :: Version v -> Version v -> VersionRange v
  mkVersionRange v1 v2
    | v1 <= v2 = VRange v1 v2
    | otherwise = error "invalid version range"
  
  safeVersionRange :: Version v -> Version v -> Maybe (VersionRange v)
  safeVersionRange v1 v2
    | v1 <= v2 = Just $ VRange v1 v2
    | otherwise = Nothing
  
  versionToRange :: Version v -> VersionRange v
  versionToRange v = VRange v v
  
  instance VersionScope v => Encoding (VersionRange v) where
    smpEncode (VRange v1 v2) = smpEncode (v1, v2)
    smpP =
      maybe (fail "invalid version range") pure
        =<< safeVersionRange <$> smpP <*> smpP
  
  instance VersionScope v => StrEncoding (VersionRange v) where
    strEncode (VRange v1 v2)
      | v1 == v2 = strEncode v1
      | otherwise = strEncode v1 <> "-" <> strEncode v2
    strP = do
      v1 <- strP
      v2 <- maybe (pure v1) (const strP) =<< optional (A.char '-')
      maybe (fail "invalid version range") pure $ safeVersionRange v1 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 = id
    toVersionRangeT _ vr = vr
  
  instance VersionScope v => VersionRangeI v (VersionRange v) where
    type VersionT v (VersionRange v) = Version v
    versionRange = id
    toVersionRange _ vr = vr
    toVersionT _ v = v
  
  newtype Compatible a = Compatible_ a
  
  pattern Compatible :: a -> Compatible a
  pattern Compatible a <- Compatible_ a
  
  {-# COMPLETE Compatible #-}
  
  isCompatible :: VersionI v a => a -> VersionRange v -> Bool
  isCompatible x (VRange v1 v2) = let v = version x in v1 <= v && v <= v2
  
  isCompatibleRange :: VersionRangeI v a => a -> VersionRange v -> Bool
  isCompatibleRange x (VRange min2 max2) = min1 <= max2 && min2 <= max1
    where
      VRange min1 max1 = versionRange x
  
  proveCompatible :: VersionI v a => a -> VersionRange v -> Maybe (Compatible a)
  proveCompatible x vr = x `mkCompatibleIf` (x `isCompatible` vr)
  
  compatibleVersion :: VersionRangeI v a => a -> VersionRange v -> Maybe (Compatible (VersionT v a))
  compatibleVersion x vr =
    toVersionT x (min max1 max2) `mkCompatibleIf` isCompatibleRange x vr
    where
      max1 = maxVersion $ versionRange x
      max2 = maxVersion vr
  
  -- | intersection of version ranges
  compatibleVRange :: VersionRangeI v a => a -> VersionRange v -> Maybe (Compatible a)
  compatibleVRange x vr =
    compatibleVRange_ x (max min1 min2) (min max1 max2)
    where
      VRange min1 max1 = versionRange x
      VRange min2 max2 = vr
  
  -- | version range capped by compatible version
  compatibleVRange' :: VersionRangeI v a => a -> Version v -> Maybe (Compatible a)
  compatibleVRange' x v
    | v <= max1 = compatibleVRange_ x min1 v
    | otherwise = Nothing
    where
      VRange min1 max1 = versionRange x
  
  compatibleVRange_ :: VersionRangeI v a => a -> Version v -> Version v -> Maybe (Compatible a)
  compatibleVRange_ x v1 v2 = Compatible_ . toVersionRange x <$> safeVersionRange v1 v2
  
  mkCompatibleIf :: a -> Bool -> Maybe (Compatible a)
  x `mkCompatibleIf` cond = if cond then Just $ Compatible_ x else Nothing
  