module Data.Version.Package.Internal
( PackageVersion (..),
ValidationError (..),
ReadStringError (..),
ReadFileError (..),
mkPackageVersion,
toText,
)
where
import Control.DeepSeq (NFData)
import Control.Exception (Exception (displayException))
import Data.Foldable qualified as F
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NE
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Language.Haskell.TH.Syntax (Lift)
newtype PackageVersion = MkPackageVersion
{
PackageVersion -> NonEmpty Word
unPackageVersion :: NonEmpty Word
}
deriving stock
(
(forall x. PackageVersion -> Rep PackageVersion x)
-> (forall x. Rep PackageVersion x -> PackageVersion)
-> Generic PackageVersion
forall x. Rep PackageVersion x -> PackageVersion
forall x. PackageVersion -> Rep PackageVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PackageVersion -> Rep PackageVersion x
from :: forall x. PackageVersion -> Rep PackageVersion x
$cto :: forall x. Rep PackageVersion x -> PackageVersion
to :: forall x. Rep PackageVersion x -> PackageVersion
Generic,
(forall (m :: * -> *). Quote m => PackageVersion -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
PackageVersion -> Code m PackageVersion)
-> Lift PackageVersion
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PackageVersion -> m Exp
forall (m :: * -> *).
Quote m =>
PackageVersion -> Code m PackageVersion
$clift :: forall (m :: * -> *). Quote m => PackageVersion -> m Exp
lift :: forall (m :: * -> *). Quote m => PackageVersion -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
PackageVersion -> Code m PackageVersion
liftTyped :: forall (m :: * -> *).
Quote m =>
PackageVersion -> Code m PackageVersion
Lift,
Int -> PackageVersion -> ShowS
[PackageVersion] -> ShowS
PackageVersion -> String
(Int -> PackageVersion -> ShowS)
-> (PackageVersion -> String)
-> ([PackageVersion] -> ShowS)
-> Show PackageVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageVersion -> ShowS
showsPrec :: Int -> PackageVersion -> ShowS
$cshow :: PackageVersion -> String
show :: PackageVersion -> String
$cshowList :: [PackageVersion] -> ShowS
showList :: [PackageVersion] -> ShowS
Show
)
deriving anyclass
(
PackageVersion -> ()
(PackageVersion -> ()) -> NFData PackageVersion
forall a. (a -> ()) -> NFData a
$crnf :: PackageVersion -> ()
rnf :: PackageVersion -> ()
NFData
)
instance Eq PackageVersion where
MkPackageVersion NonEmpty Word
v1 == :: PackageVersion -> PackageVersion -> Bool
== MkPackageVersion NonEmpty Word
v2 =
NonEmpty Word -> [Word]
forall a. (Eq a, Num a) => NonEmpty a -> [a]
dropTrailingZeroes NonEmpty Word
v1 [Word] -> [Word] -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty Word -> [Word]
forall a. (Eq a, Num a) => NonEmpty a -> [a]
dropTrailingZeroes NonEmpty Word
v2
instance Ord PackageVersion where
MkPackageVersion NonEmpty Word
v1 compare :: PackageVersion -> PackageVersion -> Ordering
`compare` MkPackageVersion NonEmpty Word
v2 =
NonEmpty Word -> [Word]
forall a. (Eq a, Num a) => NonEmpty a -> [a]
dropTrailingZeroes NonEmpty Word
v1 [Word] -> [Word] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` NonEmpty Word -> [Word]
forall a. (Eq a, Num a) => NonEmpty a -> [a]
dropTrailingZeroes NonEmpty Word
v2
instance Semigroup PackageVersion where
PackageVersion
x <> :: PackageVersion -> PackageVersion -> PackageVersion
<> PackageVersion
y =
if PackageVersion
x PackageVersion -> PackageVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= PackageVersion
y
then PackageVersion
x
else PackageVersion
y
instance Monoid PackageVersion where
mempty :: PackageVersion
mempty = NonEmpty Word -> PackageVersion
MkPackageVersion (Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [])
dropTrailingZeroes :: (Eq a, Num a) => NonEmpty a -> [a]
dropTrailingZeroes :: forall a. (Eq a, Num a) => NonEmpty a -> [a]
dropTrailingZeroes NonEmpty a
xs = Int -> NonEmpty a -> [a]
forall a. Int -> NonEmpty a -> [a]
NE.take (NonEmpty a -> Int
lastNonZero NonEmpty a
xs) NonEmpty a
xs
where
lastNonZero :: NonEmpty a -> Int
lastNonZero = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int)
-> (NonEmpty a -> (Int, Int)) -> NonEmpty a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> a -> (Int, Int))
-> (Int, Int) -> NonEmpty a -> (Int, Int)
forall b a. (b -> a -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (Int, Int) -> a -> (Int, Int)
forall {a} {b}. (Eq a, Num a, Num b) => (b, b) -> a -> (b, b)
go (Int
0, Int
0)
go :: (b, b) -> a -> (b, b)
go (!b
idx, !b
acc) a
x
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 = (b
idx b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, b
idx b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
| Bool
otherwise = (b
idx b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, b
acc)
data ValidationError
=
ValidationErrorEmpty
|
ValidationErrorNegative Int
deriving stock
(
ValidationError -> ValidationError -> Bool
(ValidationError -> ValidationError -> Bool)
-> (ValidationError -> ValidationError -> Bool)
-> Eq ValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
/= :: ValidationError -> ValidationError -> Bool
Eq,
(forall x. ValidationError -> Rep ValidationError x)
-> (forall x. Rep ValidationError x -> ValidationError)
-> Generic ValidationError
forall x. Rep ValidationError x -> ValidationError
forall x. ValidationError -> Rep ValidationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValidationError -> Rep ValidationError x
from :: forall x. ValidationError -> Rep ValidationError x
$cto :: forall x. Rep ValidationError x -> ValidationError
to :: forall x. Rep ValidationError x -> ValidationError
Generic,
Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
(Int -> ValidationError -> ShowS)
-> (ValidationError -> String)
-> ([ValidationError] -> ShowS)
-> Show ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationError -> ShowS
showsPrec :: Int -> ValidationError -> ShowS
$cshow :: ValidationError -> String
show :: ValidationError -> String
$cshowList :: [ValidationError] -> ShowS
showList :: [ValidationError] -> ShowS
Show
)
deriving anyclass
(
ValidationError -> ()
(ValidationError -> ()) -> NFData ValidationError
forall a. (a -> ()) -> NFData a
$crnf :: ValidationError -> ()
rnf :: ValidationError -> ()
NFData
)
instance Exception ValidationError where
displayException :: ValidationError -> String
displayException ValidationError
ValidationErrorEmpty = String
"PVP number cannot be empty"
displayException (ValidationErrorNegative Int
i) =
String
"PVP numbers cannot be negative: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i
data ReadStringError
=
ReadStringErrorParse String
|
ReadStringErrorValidate ValidationError
deriving stock
(
ReadStringError -> ReadStringError -> Bool
(ReadStringError -> ReadStringError -> Bool)
-> (ReadStringError -> ReadStringError -> Bool)
-> Eq ReadStringError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadStringError -> ReadStringError -> Bool
== :: ReadStringError -> ReadStringError -> Bool
$c/= :: ReadStringError -> ReadStringError -> Bool
/= :: ReadStringError -> ReadStringError -> Bool
Eq,
(forall x. ReadStringError -> Rep ReadStringError x)
-> (forall x. Rep ReadStringError x -> ReadStringError)
-> Generic ReadStringError
forall x. Rep ReadStringError x -> ReadStringError
forall x. ReadStringError -> Rep ReadStringError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReadStringError -> Rep ReadStringError x
from :: forall x. ReadStringError -> Rep ReadStringError x
$cto :: forall x. Rep ReadStringError x -> ReadStringError
to :: forall x. Rep ReadStringError x -> ReadStringError
Generic,
Int -> ReadStringError -> ShowS
[ReadStringError] -> ShowS
ReadStringError -> String
(Int -> ReadStringError -> ShowS)
-> (ReadStringError -> String)
-> ([ReadStringError] -> ShowS)
-> Show ReadStringError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadStringError -> ShowS
showsPrec :: Int -> ReadStringError -> ShowS
$cshow :: ReadStringError -> String
show :: ReadStringError -> String
$cshowList :: [ReadStringError] -> ShowS
showList :: [ReadStringError] -> ShowS
Show
)
deriving anyclass
(
ReadStringError -> ()
(ReadStringError -> ()) -> NFData ReadStringError
forall a. (a -> ()) -> NFData a
$crnf :: ReadStringError -> ()
rnf :: ReadStringError -> ()
NFData
)
instance Exception ReadStringError where
displayException :: ReadStringError -> String
displayException (ReadStringErrorParse String
err) = String
"Read error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err
displayException (ReadStringErrorValidate ValidationError
i) =
String
"Validation error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ValidationError -> String
forall e. Exception e => e -> String
displayException ValidationError
i
data ReadFileError
=
ReadFileErrorGeneral String
|
ReadFileErrorVersionNotFound FilePath
|
ReadFileErrorReadString ReadStringError
deriving stock
(
ReadFileError -> ReadFileError -> Bool
(ReadFileError -> ReadFileError -> Bool)
-> (ReadFileError -> ReadFileError -> Bool) -> Eq ReadFileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadFileError -> ReadFileError -> Bool
== :: ReadFileError -> ReadFileError -> Bool
$c/= :: ReadFileError -> ReadFileError -> Bool
/= :: ReadFileError -> ReadFileError -> Bool
Eq,
(forall x. ReadFileError -> Rep ReadFileError x)
-> (forall x. Rep ReadFileError x -> ReadFileError)
-> Generic ReadFileError
forall x. Rep ReadFileError x -> ReadFileError
forall x. ReadFileError -> Rep ReadFileError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReadFileError -> Rep ReadFileError x
from :: forall x. ReadFileError -> Rep ReadFileError x
$cto :: forall x. Rep ReadFileError x -> ReadFileError
to :: forall x. Rep ReadFileError x -> ReadFileError
Generic,
Int -> ReadFileError -> ShowS
[ReadFileError] -> ShowS
ReadFileError -> String
(Int -> ReadFileError -> ShowS)
-> (ReadFileError -> String)
-> ([ReadFileError] -> ShowS)
-> Show ReadFileError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadFileError -> ShowS
showsPrec :: Int -> ReadFileError -> ShowS
$cshow :: ReadFileError -> String
show :: ReadFileError -> String
$cshowList :: [ReadFileError] -> ShowS
showList :: [ReadFileError] -> ShowS
Show
)
deriving anyclass
(
ReadFileError -> ()
(ReadFileError -> ()) -> NFData ReadFileError
forall a. (a -> ()) -> NFData a
$crnf :: ReadFileError -> ()
rnf :: ReadFileError -> ()
NFData
)
instance Exception ReadFileError where
displayException :: ReadFileError -> String
displayException (ReadFileErrorGeneral String
f) = String
"File not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
f
displayException (ReadFileErrorVersionNotFound String
f) = String
"Version not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
f
displayException (ReadFileErrorReadString ReadStringError
i) = String
"Read error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ReadStringError -> String
forall e. Exception e => e -> String
displayException ReadStringError
i
mkPackageVersion :: [Int] -> Either ValidationError PackageVersion
mkPackageVersion :: [Int] -> Either ValidationError PackageVersion
mkPackageVersion vers :: [Int]
vers@(Int
v : [Int]
vs) = case (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) [Int]
vers of
[] -> PackageVersion -> Either ValidationError PackageVersion
forall a b. b -> Either a b
Right (PackageVersion -> Either ValidationError PackageVersion)
-> PackageVersion -> Either ValidationError PackageVersion
forall a b. (a -> b) -> a -> b
$ NonEmpty Word -> PackageVersion
MkPackageVersion (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
vs)
(Int
neg : [Int]
_) -> ValidationError -> Either ValidationError PackageVersion
forall a b. a -> Either a b
Left (ValidationError -> Either ValidationError PackageVersion)
-> ValidationError -> Either ValidationError PackageVersion
forall a b. (a -> b) -> a -> b
$ Int -> ValidationError
ValidationErrorNegative Int
neg
mkPackageVersion [] = ValidationError -> Either ValidationError PackageVersion
forall a b. a -> Either a b
Left ValidationError
ValidationErrorEmpty
toText :: PackageVersion -> Text
toText :: PackageVersion -> Text
toText =
Text -> [Text] -> Text
T.intercalate Text
"."
([Text] -> Text)
-> (PackageVersion -> [Text]) -> PackageVersion -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Text) -> [Word] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text) -> (Word -> String) -> Word -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> String
forall a. Show a => a -> String
show)
([Word] -> [Text])
-> (PackageVersion -> [Word]) -> PackageVersion -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Word -> [Word]
forall a. NonEmpty a -> [a]
NE.toList
(NonEmpty Word -> [Word])
-> (PackageVersion -> NonEmpty Word) -> PackageVersion -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageVersion -> NonEmpty Word
unPackageVersion