{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Internal module. Exposes the invariant-breaking 'UnsafePackageVersion'
-- constructor.
--
-- @since 0.1.0.0
module Data.Version.Package.Internal
  ( PackageVersion (MkPackageVersion, ..),
    ValidationError (..),
    ReadStringError (..),
    ReadFileError (..),
    mkPackageVersion,
    toText,
  )
where

import Control.DeepSeq (NFData (..))
import Control.DeepSeq qualified as DS
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 (..), (<+>))
#else
import Data.Text.Prettyprint.Doc (Pretty (..), (<+>))
#endif
import Text.Read qualified as TR

-- | 'PackageVersion' represents [PVP](https://pvp.haskell.org/) version
-- numbers. It is similar to "Data.Version"'s 'Data.Version' (i.e. wraps a
-- @['Int']@) except:
--
-- 1. 'PackageVersion' has no 'Data.Version.versionTags'.
-- 2. We enforce PVP's "tags must be at least A.B" invariant via the
--    smart-constructor pattern.
-- 3. Trailing zeroes are ignored in 'Eq', 'Ord', 'Semigroup', and 'Monoid'.
--
-- That is, we declare an equivalence class up to trailing zeroes.
-- In particular, the 'Monoid' identity is
--
-- @
-- [0] = { [0,0], [0,0,0], ... }
-- @
--
-- and its 'Semigroup' instance takes the greatest version (based on 'Ord').
--
-- Note: Because we export the underlying list in various ways,
-- (e.g. 'show'), 'Eq'\'s extensionality law,
--
-- @
-- x == y ==> f x == f y
-- @
--
-- can be broken. Take care that you do not rely on this law if you are
-- using its underlying @['Int']@ (or 'String') representation.
--
-- ==== __Examples__
-- >>> UnsafePackageVersion [0,0,0,0] == UnsafePackageVersion [0,0,0]
-- True
--
-- >>> UnsafePackageVersion [4,0,0] > UnsafePackageVersion [1,2,0,0]
-- True
--
-- >>> UnsafePackageVersion [5,6,0] <> UnsafePackageVersion [9,0,0]
-- UnsafePackageVersion {unPackageVersion = [9,0,0]}
--
-- >>> UnsafePackageVersion [0,9] <> UnsafePackageVersion [0,9,0,0]
-- UnsafePackageVersion {unPackageVersion = [0,9]}
--
-- >>> TR.readEither @PackageVersion "UnsafePackageVersion {unPackageVersion = [3,2,1]}"
-- Right (UnsafePackageVersion {unPackageVersion = [3,2,1]})
--
-- >>> TR.readEither @PackageVersion "UnsafePackageVersion {unPackageVersion = [3]}"
-- Left "Prelude.read: no parse"
--
-- @since 0.1.0.0
newtype PackageVersion = UnsafePackageVersion
  { -- | @since 0.1.0.0
    PackageVersion -> [Int]
unPackageVersion :: [Int]
  }
  deriving stock
    ( -- | @since 0.1.0.0
      (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
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,
      -- | @since 0.1.0.0
      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
showList :: [PackageVersion] -> ShowS
$cshowList :: [PackageVersion] -> ShowS
show :: PackageVersion -> String
$cshow :: PackageVersion -> String
showsPrec :: Int -> PackageVersion -> ShowS
$cshowsPrec :: Int -> PackageVersion -> ShowS
Show
    )

-- | @since 0.1.0.0
pattern MkPackageVersion :: [Int] -> PackageVersion
pattern $mMkPackageVersion :: forall {r}. PackageVersion -> ([Int] -> r) -> ((# #) -> r) -> r
MkPackageVersion v <- UnsafePackageVersion v

{-# COMPLETE MkPackageVersion #-}

-- | @since 0.1.0.0
instance Eq PackageVersion where
  UnsafePackageVersion [Int]
v1 == :: PackageVersion -> PackageVersion -> Bool
== UnsafePackageVersion [Int]
v2 =
    [Int] -> [Int]
forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [Int]
v1 [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> [Int]
forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [Int]
v2

-- | @since 0.1.0.0
instance Ord PackageVersion where
  UnsafePackageVersion [Int]
v1 compare :: PackageVersion -> PackageVersion -> Ordering
`compare` UnsafePackageVersion [Int]
v2 =
    [Int] -> [Int]
forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [Int]
v1 [Int] -> [Int] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` [Int] -> [Int]
forall a. (Eq a, Num a) => [a] -> [a]
dropTrailingZeroes [Int]
v2

-- | @since 0.1.0.0
instance Semigroup PackageVersion where
  PackageVersion
pv1 <> :: PackageVersion -> PackageVersion -> PackageVersion
<> PackageVersion
pv2 =
    case PackageVersion
pv1 PackageVersion -> PackageVersion -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` PackageVersion
pv2 of
      Ordering
LT -> PackageVersion
pv2
      Ordering
_ -> PackageVersion
pv1

-- | @since 0.1.0.0
instance Monoid PackageVersion where
  mempty :: PackageVersion
mempty = [Int] -> PackageVersion
UnsafePackageVersion [Int
0, Int
0]

-- | Derived by GHC 8.10.7 with validation via 'mkPackageVersion'.
--
-- @since 0.1.0.0
instance Read PackageVersion where
  readPrec :: ReadPrec PackageVersion
readPrec = ReadPrec PackageVersion -> ReadPrec PackageVersion
forall a. ReadPrec a -> ReadPrec a
TR.parens (ReadPrec PackageVersion -> ReadPrec PackageVersion)
-> ReadPrec PackageVersion -> ReadPrec PackageVersion
forall a b. (a -> b) -> a -> b
$
    Int -> ReadPrec PackageVersion -> ReadPrec PackageVersion
forall a. Int -> ReadPrec a -> ReadPrec a
TR.prec Int
11 (ReadPrec PackageVersion -> ReadPrec PackageVersion)
-> ReadPrec PackageVersion -> ReadPrec PackageVersion
forall a b. (a -> b) -> a -> b
$ do
      Lexeme -> ReadPrec ()
RD.expectP (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
TR.Ident String
"UnsafePackageVersion"
      Lexeme -> ReadPrec ()
RD.expectP (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
TR.Punc String
"{"
      [Int]
intList <- String -> ReadPrec [Int] -> ReadPrec [Int]
forall a. String -> ReadPrec a -> ReadPrec a
RD.readField String
"unPackageVersion" (ReadPrec [Int] -> ReadPrec [Int]
forall a. ReadPrec a -> ReadPrec a
TR.reset ReadPrec [Int]
forall a. Read a => ReadPrec a
RD.readPrec)
      Lexeme -> ReadPrec ()
RD.expectP (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
TR.Punc String
"}"
      case [Int] -> Either ValidationError PackageVersion
mkPackageVersion [Int]
intList of
        Left ValidationError
_ -> ReadPrec PackageVersion
forall a. ReadPrec a
TR.pfail
        Right PackageVersion
pv -> PackageVersion -> ReadPrec PackageVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageVersion
pv

-- | @since 0.1.0.0
instance NFData PackageVersion where
  rnf :: PackageVersion -> ()
rnf (UnsafePackageVersion [Int]
xs) = [Int] -> () -> ()
forall a b. NFData a => a -> b -> b
DS.deepseq [Int]
xs ()

-- | @since 0.1.0.0
instance Pretty PackageVersion where
  pretty :: forall ann. PackageVersion -> Doc ann
pretty = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann)
-> (PackageVersion -> Text) -> PackageVersion -> Doc ann
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 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
lastNonZero [a]
xs) [a]
xs
  where
    lastNonZero :: [a] -> Int
lastNonZero = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> ([a] -> (Int, Int)) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> a -> (Int, Int)) -> (Int, Int) -> [a] -> (Int, Int)
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)

-- | Errors that can occur when validating PVP version numbers.
--
-- @since 0.1.0.0
data ValidationError
  = -- | PVP version numbers must be at least A.B
    --
    -- @since 0.1.0.0
    VTooShortErr [Int]
  | -- | PVP version numbers cannot be negative.
    --
    -- @since 0.1.0.0
    VNegativeErr Int
  deriving stock
    ( -- | @since 0.1.0.0
      ValidationError -> ValidationError -> Bool
(ValidationError -> ValidationError -> Bool)
-> (ValidationError -> ValidationError -> Bool)
-> Eq ValidationError
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,
      -- | @since 0.1.0.0
      (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
$cto :: forall x. Rep ValidationError x -> ValidationError
$cfrom :: forall x. ValidationError -> Rep ValidationError x
Generic,
      -- | @since 0.1.0.0
      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
showList :: [ValidationError] -> ShowS
$cshowList :: [ValidationError] -> ShowS
show :: ValidationError -> String
$cshow :: ValidationError -> String
showsPrec :: Int -> ValidationError -> ShowS
$cshowsPrec :: Int -> ValidationError -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1.0.0
      Show ValidationError
Typeable ValidationError
Typeable ValidationError
-> Show ValidationError
-> (ValidationError -> SomeException)
-> (SomeException -> Maybe ValidationError)
-> (ValidationError -> String)
-> Exception ValidationError
SomeException -> Maybe ValidationError
ValidationError -> String
ValidationError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ValidationError -> String
$cdisplayException :: ValidationError -> String
fromException :: SomeException -> Maybe ValidationError
$cfromException :: SomeException -> Maybe ValidationError
toException :: ValidationError -> SomeException
$ctoException :: ValidationError -> SomeException
Exception
    )

-- | @since 0.1.0.0
instance Pretty ValidationError where
  pretty :: forall ann. ValidationError -> Doc ann
pretty (VTooShortErr [Int]
xs) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"PVP numbers must be at least A.B:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Int] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Int]
xs
  pretty (VNegativeErr Int
i) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"PVP numbers cannot be negative:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i

-- | Errors that can occur when reading PVP version numbers.
--
-- @since 0.1.0.0
data ReadStringError
  = -- | Error when reading a string.
    --
    -- @since 0.1.0.0
    RsReadStrErr String
  | -- | Validation error.
    --
    -- @since 0.1.0.0
    RsValidateErr ValidationError
  deriving stock
    ( -- | @since 0.1.0.0
      ReadStringError -> ReadStringError -> Bool
(ReadStringError -> ReadStringError -> Bool)
-> (ReadStringError -> ReadStringError -> Bool)
-> Eq ReadStringError
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,
      -- | @since 0.1.0.0
      (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
$cto :: forall x. Rep ReadStringError x -> ReadStringError
$cfrom :: forall x. ReadStringError -> Rep ReadStringError x
Generic,
      -- | @since 0.1.0.0
      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
showList :: [ReadStringError] -> ShowS
$cshowList :: [ReadStringError] -> ShowS
show :: ReadStringError -> String
$cshow :: ReadStringError -> String
showsPrec :: Int -> ReadStringError -> ShowS
$cshowsPrec :: Int -> ReadStringError -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1.0.0
      Show ReadStringError
Typeable ReadStringError
Typeable ReadStringError
-> Show ReadStringError
-> (ReadStringError -> SomeException)
-> (SomeException -> Maybe ReadStringError)
-> (ReadStringError -> String)
-> Exception ReadStringError
SomeException -> Maybe ReadStringError
ReadStringError -> String
ReadStringError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ReadStringError -> String
$cdisplayException :: ReadStringError -> String
fromException :: SomeException -> Maybe ReadStringError
$cfromException :: SomeException -> Maybe ReadStringError
toException :: ReadStringError -> SomeException
$ctoException :: ReadStringError -> SomeException
Exception
    )

-- | @since 0.1.0.0
instance Pretty ReadStringError where
  pretty :: forall ann. ReadStringError -> Doc ann
pretty (RsReadStrErr String
err) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"Read error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
err
  pretty (RsValidateErr ValidationError
i) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"Validation error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ValidationError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ValidationError
i

-- | Errors that can occur when reading PVP version numbers from a file.
--
-- @since 0.1.0.0
data ReadFileError
  = -- | Error for missing file.
    --
    -- @since 0.1.0.0
    RfFileNotFoundErr String
  | -- | Error for missing version.
    --
    -- @since 0.1.0.0
    RfVersionNotFoundErr FilePath
  | -- | Read/Validation error.
    --
    -- @since 0.1.0.0
    RfReadValidateErr ReadStringError
  deriving stock
    ( -- | @since 0.1.0.0
      ReadFileError -> ReadFileError -> Bool
(ReadFileError -> ReadFileError -> Bool)
-> (ReadFileError -> ReadFileError -> Bool) -> Eq ReadFileError
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,
      -- | @since 0.1.0.0
      (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
$cto :: forall x. Rep ReadFileError x -> ReadFileError
$cfrom :: forall x. ReadFileError -> Rep ReadFileError x
Generic,
      -- | @since 0.1.0.0
      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
showList :: [ReadFileError] -> ShowS
$cshowList :: [ReadFileError] -> ShowS
show :: ReadFileError -> String
$cshow :: ReadFileError -> String
showsPrec :: Int -> ReadFileError -> ShowS
$cshowsPrec :: Int -> ReadFileError -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1.0.0
      Show ReadFileError
Typeable ReadFileError
Typeable ReadFileError
-> Show ReadFileError
-> (ReadFileError -> SomeException)
-> (SomeException -> Maybe ReadFileError)
-> (ReadFileError -> String)
-> Exception ReadFileError
SomeException -> Maybe ReadFileError
ReadFileError -> String
ReadFileError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ReadFileError -> String
$cdisplayException :: ReadFileError -> String
fromException :: SomeException -> Maybe ReadFileError
$cfromException :: SomeException -> Maybe ReadFileError
toException :: ReadFileError -> SomeException
$ctoException :: ReadFileError -> SomeException
Exception
    )

-- | @since 0.1.0.0
instance Pretty ReadFileError where
  pretty :: forall ann. ReadFileError -> Doc ann
pretty (RfFileNotFoundErr String
f) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"File not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
f
  pretty (RfVersionNotFoundErr String
f) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"Version not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
f
  pretty (RfReadValidateErr ReadStringError
i) = forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
"Read/validation error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ReadStringError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ReadStringError
i

-- | Smart constructor for 'PackageVersion'. The length of the list must be
-- > 1 to match PVP's minimal A.B. Furthermore, all digits must be non-negative.
--
-- ==== __Examples__
--
-- >>> mkPackageVersion [1,2]
-- Right (UnsafePackageVersion {unPackageVersion = [1,2]})
--
-- >>> mkPackageVersion [2,87,7,1]
-- Right (UnsafePackageVersion {unPackageVersion = [2,87,7,1]})
--
-- >>> mkPackageVersion [1,2,-3,-4,5]
-- Left (VNegativeErr (-3))
--
-- >>> mkPackageVersion [3]
-- Left (VTooShortErr [3])
--
-- >>> mkPackageVersion []
-- Left (VTooShortErr [])
--
-- @since 0.1.0.0
mkPackageVersion :: [Int] -> Either ValidationError PackageVersion
mkPackageVersion :: [Int] -> Either ValidationError PackageVersion
mkPackageVersion v :: [Int]
v@(Int
_ : Int
_ : [Int]
_) = 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]
v 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
$ [Int] -> PackageVersion
UnsafePackageVersion [Int]
v
  (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
VNegativeErr Int
neg
mkPackageVersion [Int]
short = 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
VTooShortErr [Int]
short

-- | Displays 'PackageVersion' in 'Text' format.
--
-- ==== __Examples__
-- >>> toText (UnsafePackageVersion [2,7,10,0])
-- "2.7.10.0"
--
-- @since 0.1.0.0
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
. (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) ([Int] -> [Text])
-> (PackageVersion -> [Int]) -> PackageVersion -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageVersion -> [Int]
unPackageVersion