{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Bindings to libversion
module Foreign.Libversion
  ( VersionString (..),
    VersionString' (..),
    VersionFlag (..),
    compareVersion,
    compareVersion',
  )
where

import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCString)
import Data.Coerce (coerce)
import Data.String (IsString)
import Foreign.C (CInt (..), CString)
import System.IO.Unsafe (unsafeDupablePerformIO)
import Unsafe.Coerce (unsafeCoerce)

foreign import ccall unsafe "version_compare2"
  _compareVersion :: CString -> CString -> CInt

foreign import ccall unsafe "version_compare4"
  _compareVersion' :: CString -> CString -> CInt -> CInt -> CInt

-- | newtype around 'ByteString' that uses 'compareVersion' to implement the 'Ord' instance
newtype VersionString = VersionString {VersionString -> ByteString
unVersionString :: ByteString}
  deriving newtype (Int -> VersionString -> ShowS
[VersionString] -> ShowS
VersionString -> String
(Int -> VersionString -> ShowS)
-> (VersionString -> String)
-> ([VersionString] -> ShowS)
-> Show VersionString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionString] -> ShowS
$cshowList :: [VersionString] -> ShowS
show :: VersionString -> String
$cshow :: VersionString -> String
showsPrec :: Int -> VersionString -> ShowS
$cshowsPrec :: Int -> VersionString -> ShowS
Show, b -> VersionString -> VersionString
NonEmpty VersionString -> VersionString
VersionString -> VersionString -> VersionString
(VersionString -> VersionString -> VersionString)
-> (NonEmpty VersionString -> VersionString)
-> (forall b. Integral b => b -> VersionString -> VersionString)
-> Semigroup VersionString
forall b. Integral b => b -> VersionString -> VersionString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> VersionString -> VersionString
$cstimes :: forall b. Integral b => b -> VersionString -> VersionString
sconcat :: NonEmpty VersionString -> VersionString
$csconcat :: NonEmpty VersionString -> VersionString
<> :: VersionString -> VersionString -> VersionString
$c<> :: VersionString -> VersionString -> VersionString
Semigroup, Semigroup VersionString
VersionString
Semigroup VersionString
-> VersionString
-> (VersionString -> VersionString -> VersionString)
-> ([VersionString] -> VersionString)
-> Monoid VersionString
[VersionString] -> VersionString
VersionString -> VersionString -> VersionString
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [VersionString] -> VersionString
$cmconcat :: [VersionString] -> VersionString
mappend :: VersionString -> VersionString -> VersionString
$cmappend :: VersionString -> VersionString -> VersionString
mempty :: VersionString
$cmempty :: VersionString
$cp1Monoid :: Semigroup VersionString
Monoid, String -> VersionString
(String -> VersionString) -> IsString VersionString
forall a. (String -> a) -> IsString a
fromString :: String -> VersionString
$cfromString :: String -> VersionString
IsString)

instance Ord VersionString where
  compare :: VersionString -> VersionString -> Ordering
compare = (ByteString -> ByteString -> Ordering)
-> VersionString -> VersionString -> Ordering
coerce ByteString -> ByteString -> Ordering
compareVersion

instance Eq VersionString where
  VersionString
v1 == :: VersionString -> VersionString -> Bool
== VersionString
v2 = VersionString
v1 VersionString -> VersionString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` VersionString
v2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- | Flags to tune the comparison behavior
data VersionFlag
  = NoFlag
  | -- | /p/ letter is treated as /patch/ (post-release) instead of /pre/ (pre-release).
    PIsPatch
  | -- | any letter sequence is treated as post-release (useful for handling patchsets as in @1.2foopatchset3.barpatchset4@).
    AnyIsPatch
  | -- | derive lowest possible version with the given prefix.
    --   For example, lower bound for @1.0@ is such imaginary version @?@ that
    --   it's higher than any release before @1.0@ and lower than any prerelease of @1.0@.
    --   E.g. @0.999@ < lower bound(@1.0@) < @1.0alpha0@.
    LowerBound
  | -- | derive highest possible version with the given prefix. Oppisite of 'LowerBound'.
    UpperBound
  deriving (Int -> VersionFlag -> ShowS
[VersionFlag] -> ShowS
VersionFlag -> String
(Int -> VersionFlag -> ShowS)
-> (VersionFlag -> String)
-> ([VersionFlag] -> ShowS)
-> Show VersionFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionFlag] -> ShowS
$cshowList :: [VersionFlag] -> ShowS
show :: VersionFlag -> String
$cshow :: VersionFlag -> String
showsPrec :: Int -> VersionFlag -> ShowS
$cshowsPrec :: Int -> VersionFlag -> ShowS
Show, VersionFlag -> VersionFlag -> Bool
(VersionFlag -> VersionFlag -> Bool)
-> (VersionFlag -> VersionFlag -> Bool) -> Eq VersionFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionFlag -> VersionFlag -> Bool
$c/= :: VersionFlag -> VersionFlag -> Bool
== :: VersionFlag -> VersionFlag -> Bool
$c== :: VersionFlag -> VersionFlag -> Bool
Eq)

instance Enum VersionFlag where
  fromEnum :: VersionFlag -> Int
fromEnum VersionFlag
NoFlag = Int
0
  fromEnum VersionFlag
PIsPatch = Int
1
  fromEnum VersionFlag
AnyIsPatch = Int
2
  fromEnum VersionFlag
LowerBound = Int
4
  fromEnum VersionFlag
UpperBound = Int
8
  toEnum :: Int -> VersionFlag
toEnum Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = VersionFlag
NoFlag
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = VersionFlag
PIsPatch
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = VersionFlag
AnyIsPatch
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = VersionFlag
LowerBound
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = VersionFlag
UpperBound
    | Bool
otherwise = String -> VersionFlag
forall a. HasCallStack => String -> a
error (String -> VersionFlag) -> String -> VersionFlag
forall a b. (a -> b) -> a -> b
$ String
"VersionFlag: fromEnum called with bad argument " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i

-- | A wrapper around 'ByteString' like 'VersionString' but has an 'VersionFlag' attached.
--   Uses 'compareVersion'' to implement the 'Ord' instance
data VersionString' = VersionString' ByteString VersionFlag
  deriving (Int -> VersionString' -> ShowS
[VersionString'] -> ShowS
VersionString' -> String
(Int -> VersionString' -> ShowS)
-> (VersionString' -> String)
-> ([VersionString'] -> ShowS)
-> Show VersionString'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionString'] -> ShowS
$cshowList :: [VersionString'] -> ShowS
show :: VersionString' -> String
$cshow :: VersionString' -> String
showsPrec :: Int -> VersionString' -> ShowS
$cshowsPrec :: Int -> VersionString' -> ShowS
Show)

instance Ord VersionString' where
  VersionString' ByteString
s1 VersionFlag
f1 compare :: VersionString' -> VersionString' -> Ordering
`compare` VersionString' ByteString
s2 VersionFlag
f2 = VersionFlag -> VersionFlag -> ByteString -> ByteString -> Ordering
compareVersion' VersionFlag
f1 VersionFlag
f2 ByteString
s1 ByteString
s2

instance Eq VersionString' where
  VersionString'
v1 == :: VersionString' -> VersionString' -> Bool
== VersionString'
v2 = VersionString'
v1 VersionString' -> VersionString' -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` VersionString'
v2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- | Compare version strings @v1@ and @v2@
compareVersion ::
  -- | v1
  ByteString ->
  -- | v2
  ByteString ->
  Ordering
compareVersion :: ByteString -> ByteString -> Ordering
compareVersion ByteString
ver1 ByteString
ver2 =
  IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CString -> IO Ordering) -> IO Ordering
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
ver1 ((CString -> IO Ordering) -> IO Ordering)
-> (CString -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \CString
v1 ->
      ByteString -> (CString -> IO Ordering) -> IO Ordering
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
ver2 ((CString -> IO Ordering) -> IO Ordering)
-> (CString -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \CString
v2 ->
        Ordering -> IO Ordering
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Ordering -> IO Ordering) -> Ordering -> IO Ordering
forall a b. (a -> b) -> a -> b
$
          case CString -> CString -> CInt
_compareVersion CString
v1 CString
v2 of
            CInt
1 -> Ordering
GT
            CInt
0 -> Ordering
EQ
            -1 -> Ordering
LT
            CInt
v -> String -> Ordering
forall a. HasCallStack => String -> a
error (String -> Ordering) -> String -> Ordering
forall a b. (a -> b) -> a -> b
$ String
"unknown return value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CInt -> String
forall a. Show a => a -> String
show CInt
v String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" from version_compare2"

-- | Compare version strings @v1@ and @v2@ with additional flags
compareVersion' ::
  -- | f1
  VersionFlag ->
  -- | f2
  VersionFlag ->
  -- | v1
  ByteString ->
  -- | v2
  ByteString ->
  Ordering
compareVersion' :: VersionFlag -> VersionFlag -> ByteString -> ByteString -> Ordering
compareVersion' VersionFlag
flag1 VersionFlag
flag2 ByteString
ver1 ByteString
ver2 =
  IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CString -> IO Ordering) -> IO Ordering
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
ver1 ((CString -> IO Ordering) -> IO Ordering)
-> (CString -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \CString
v1 ->
      ByteString -> (CString -> IO Ordering) -> IO Ordering
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
ver2 ((CString -> IO Ordering) -> IO Ordering)
-> (CString -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \CString
v2 ->
        Ordering -> IO Ordering
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Ordering -> IO Ordering) -> Ordering -> IO Ordering
forall a b. (a -> b) -> a -> b
$
          case CString -> CString -> CInt -> CInt -> CInt
_compareVersion' CString
v1 CString
v2 CInt
f1 CInt
f2 of
            CInt
1 -> Ordering
GT
            CInt
0 -> Ordering
EQ
            -1 -> Ordering
LT
            CInt
v -> String -> Ordering
forall a. HasCallStack => String -> a
error (String -> Ordering) -> String -> Ordering
forall a b. (a -> b) -> a -> b
$ String
"unknown return value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CInt -> String
forall a. Show a => a -> String
show CInt
v String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" from version_compare4"
  where
    f1 :: CInt
f1 = Int -> CInt
forall a b. a -> b
unsafeCoerce (VersionFlag -> Int
forall a. Enum a => a -> Int
fromEnum VersionFlag
flag1)
    f2 :: CInt
f2 = Int -> CInt
forall a b. a -> b
unsafeCoerce (VersionFlag -> Int
forall a. Enum a => a -> Int
fromEnum VersionFlag
flag2)