{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Version.Package.Internal
( PackageVersion (MkPackageVersion, ..),
ValidationError (..),
ReadStringError (..),
ReadFileError (..),
mkPackageVersion,
unPackageVersion,
toText,
prettyString,
)
where
import Control.DeepSeq (NFData (..))
import Control.Exception.Safe (Exception (..))
import Data.Foldable qualified as F
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import GHC.Read qualified as RD
import Language.Haskell.TH.Syntax (Lift (..))
#if MIN_VERSION_prettyprinter(1, 7, 1)
import Prettyprinter (Pretty (..), defaultLayoutOptions, layoutSmart, (<+>))
import Prettyprinter.Render.String (renderString)
#else
import Data.Text.Prettyprint.Doc (Pretty (..), defaultLayoutOptions, layoutPretty, (<+>))
import Data.Text.Prettyprint.Doc.Render.String (renderString)
#endif
import Text.Read qualified as TR
newtype PackageVersion = UnsafePackageVersion [Int]
deriving stock
(
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
$cto :: forall x. Rep PackageVersion x -> PackageVersion
$cfrom :: forall x. PackageVersion -> Rep PackageVersion x
Generic,
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
liftTyped :: forall (m :: * -> *).
Quote m =>
PackageVersion -> Code m PackageVersion
$cliftTyped :: forall (m :: * -> *).
Quote m =>
PackageVersion -> Code m PackageVersion
lift :: forall (m :: * -> *). Quote m => PackageVersion -> m Exp
$clift :: forall (m :: * -> *). Quote m => PackageVersion -> m Exp
Lift,
Int -> PackageVersion -> ShowS
[PackageVersion] -> ShowS
PackageVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageVersion] -> ShowS
$cshowList :: [PackageVersion] -> ShowS
show :: PackageVersion -> String
$cshow :: PackageVersion -> String
showsPrec :: Int -> PackageVersion -> ShowS
$cshowsPrec :: Int -> PackageVersion -> ShowS
Show
)
deriving anyclass
(
PackageVersion -> ()
forall a. (a -> ()) -> NFData a
rnf :: PackageVersion -> ()
$crnf :: PackageVersion -> ()
NFData
)
pattern MkPackageVersion :: [Int] -> PackageVersion
pattern $mMkPackageVersion :: forall {r}. PackageVersion -> ([Int] -> r) -> ((# #) -> r) -> r
MkPackageVersion v <- UnsafePackageVersion v
{-# COMPLETE MkPackageVersion #-}
unPackageVersion :: PackageVersion -> [Int]
unPackageVersion :: PackageVersion -> [Int]
unPackageVersion (UnsafePackageVersion [Int]
x) = [Int]
x
{-# INLINE unPackageVersion #-}
instance Eq PackageVersion where
UnsafePackageVersion [Int]
v1 == :: PackageVersion -> PackageVersion -> Bool
== UnsafePackageVersion [Int]
v2 =
forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [Int]
v1 forall a. Eq a => a -> a -> Bool
== forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [Int]
v2
instance Ord PackageVersion where
UnsafePackageVersion [Int]
v1 compare :: PackageVersion -> PackageVersion -> Ordering
`compare` UnsafePackageVersion [Int]
v2 =
forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [Int]
v1 forall a. Ord a => a -> a -> Ordering
`compare` forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [Int]
v2
instance Semigroup PackageVersion where
PackageVersion
pv1 <> :: PackageVersion -> PackageVersion -> PackageVersion
<> PackageVersion
pv2 =
case PackageVersion
pv1 forall a. Ord a => a -> a -> Ordering
`compare` PackageVersion
pv2 of
Ordering
LT -> PackageVersion
pv2
Ordering
_ -> PackageVersion
pv1
instance Monoid PackageVersion where
mempty :: PackageVersion
mempty = [Int] -> PackageVersion
UnsafePackageVersion [Int
0]
instance Read PackageVersion where
readPrec :: ReadPrec PackageVersion
readPrec = forall a. ReadPrec a -> ReadPrec a
TR.parens forall a b. (a -> b) -> a -> b
$
forall a. Int -> ReadPrec a -> ReadPrec a
TR.prec Int
10 forall a b. (a -> b) -> a -> b
$ do
Lexeme -> ReadPrec ()
RD.expectP forall a b. (a -> b) -> a -> b
$ String -> Lexeme
TR.Ident String
"UnsafePackageVersion"
[Int]
intList <- forall a. ReadPrec a -> ReadPrec a
TR.step forall a. Read a => ReadPrec a
RD.readPrec
case [Int] -> Either ValidationError PackageVersion
mkPackageVersion [Int]
intList of
Left ValidationError
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> String
prettyString ValidationError
err
Right PackageVersion
pv -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageVersion
pv
readListPrec :: ReadPrec [PackageVersion]
readListPrec = forall a. Read a => ReadPrec [a]
TR.readListPrecDefault
instance Pretty PackageVersion where
pretty :: forall ann. PackageVersion -> Doc ann
pretty = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageVersion -> Text
toText
dropTrailingZeroes :: (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes :: forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [a]
xs = forall a. Int -> [a] -> [a]
take ([a] -> Int
lastNonZero [a]
xs) [a]
xs
where
lastNonZero :: [a] -> Int
lastNonZero = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' 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 forall a. Eq a => a -> a -> Bool
/= a
0 = (b
idx forall a. Num a => a -> a -> a
+ b
1, b
idx forall a. Num a => a -> a -> a
+ b
1)
| Bool
otherwise = (b
idx forall a. Num a => a -> a -> a
+ b
1, b
acc)
data ValidationError
=
ValidationErrorEmpty
|
ValidationErrorNegative Int
deriving stock
(
ValidationError -> ValidationError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c== :: ValidationError -> ValidationError -> Bool
Eq,
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
$cto :: forall x. Rep ValidationError x -> ValidationError
$cfrom :: forall x. ValidationError -> Rep ValidationError x
Generic,
Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationError] -> ShowS
$cshowList :: [ValidationError] -> ShowS
show :: ValidationError -> String
$cshow :: ValidationError -> String
showsPrec :: Int -> ValidationError -> ShowS
$cshowsPrec :: Int -> ValidationError -> ShowS
Show
)
deriving anyclass
(
ValidationError -> ()
forall a. (a -> ()) -> NFData a
rnf :: ValidationError -> ()
$crnf :: ValidationError -> ()
NFData
)
instance Pretty ValidationError where
pretty :: forall ann. ValidationError -> Doc ann
pretty ValidationError
ValidationErrorEmpty = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"PVP number cannot be empty"
pretty (ValidationErrorNegative Int
i) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"PVP numbers cannot be negative:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
i
instance Exception ValidationError where
displayException :: ValidationError -> String
displayException = forall a. Pretty a => a -> String
prettyString
data ReadStringError
=
ReadStringErrorParse String
|
ReadStringErrorValidate ValidationError
deriving stock
(
ReadStringError -> ReadStringError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadStringError -> ReadStringError -> Bool
$c/= :: ReadStringError -> ReadStringError -> Bool
== :: ReadStringError -> ReadStringError -> Bool
$c== :: ReadStringError -> ReadStringError -> Bool
Eq,
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
$cto :: forall x. Rep ReadStringError x -> ReadStringError
$cfrom :: forall x. ReadStringError -> Rep ReadStringError x
Generic,
Int -> ReadStringError -> ShowS
[ReadStringError] -> ShowS
ReadStringError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadStringError] -> ShowS
$cshowList :: [ReadStringError] -> ShowS
show :: ReadStringError -> String
$cshow :: ReadStringError -> String
showsPrec :: Int -> ReadStringError -> ShowS
$cshowsPrec :: Int -> ReadStringError -> ShowS
Show
)
deriving anyclass
(
ReadStringError -> ()
forall a. (a -> ()) -> NFData a
rnf :: ReadStringError -> ()
$crnf :: ReadStringError -> ()
NFData
)
instance Pretty ReadStringError where
pretty :: forall ann. ReadStringError -> Doc ann
pretty (ReadStringErrorParse String
err) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"Read error:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
err
pretty (ReadStringErrorValidate ValidationError
i) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"Validation error:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ValidationError
i
instance Exception ReadStringError where
displayException :: ReadStringError -> String
displayException = forall a. Pretty a => a -> String
prettyString
data ReadFileError
=
ReadFileErrorGeneral String
|
ReadFileErrorVersionNotFound FilePath
|
ReadFileErrorReadString ReadStringError
deriving stock
(
ReadFileError -> ReadFileError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadFileError -> ReadFileError -> Bool
$c/= :: ReadFileError -> ReadFileError -> Bool
== :: ReadFileError -> ReadFileError -> Bool
$c== :: ReadFileError -> ReadFileError -> Bool
Eq,
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
$cto :: forall x. Rep ReadFileError x -> ReadFileError
$cfrom :: forall x. ReadFileError -> Rep ReadFileError x
Generic,
Int -> ReadFileError -> ShowS
[ReadFileError] -> ShowS
ReadFileError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadFileError] -> ShowS
$cshowList :: [ReadFileError] -> ShowS
show :: ReadFileError -> String
$cshow :: ReadFileError -> String
showsPrec :: Int -> ReadFileError -> ShowS
$cshowsPrec :: Int -> ReadFileError -> ShowS
Show
)
deriving anyclass
(
ReadFileError -> ()
forall a. (a -> ()) -> NFData a
rnf :: ReadFileError -> ()
$crnf :: ReadFileError -> ()
NFData
)
instance Pretty ReadFileError where
pretty :: forall ann. ReadFileError -> Doc ann
pretty (ReadFileErrorGeneral String
f) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"File not found:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
f
pretty (ReadFileErrorVersionNotFound String
f) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"Version not found:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
f
pretty (ReadFileErrorReadString ReadStringError
i) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"Read error:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ReadStringError
i
instance Exception ReadFileError where
displayException :: ReadFileError -> String
displayException = forall a. Pretty a => a -> String
prettyString
mkPackageVersion :: [Int] -> Either ValidationError PackageVersion
mkPackageVersion :: [Int] -> Either ValidationError PackageVersion
mkPackageVersion v :: [Int]
v@(Int
_ : [Int]
_) = case forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
< Int
0) [Int]
v of
[] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Int] -> PackageVersion
UnsafePackageVersion [Int]
v
(Int
neg : [Int]
_) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int -> ValidationError
ValidationErrorNegative Int
neg
mkPackageVersion [] = forall a b. a -> Either a b
Left ValidationError
ValidationErrorEmpty
toText :: PackageVersion -> Text
toText :: PackageVersion -> Text
toText = Text -> [Text] -> Text
T.intercalate Text
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageVersion -> [Int]
unPackageVersion
prettyString :: Pretty a => a -> String
prettyString :: forall a. Pretty a => a -> String
prettyString =
forall ann. SimpleDocStream ann -> String
renderString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty