{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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 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
data VersionFlag
= NoFlag
|
PIsPatch
|
AnyIsPatch
|
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
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
compareVersion ::
ByteString ->
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"
compareVersion' ::
VersionFlag ->
VersionFlag ->
ByteString ->
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)