{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

-- Module      : Data.SemVer.Internal
-- Copyright   : (c) 2014-2019 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Data.SemVer.Internal where

import           Control.Applicative
import           Control.DeepSeq
import           Control.Monad
import           Data.Attoparsec.Text
import           Data.Function        (on)
import           Data.Hashable
import           Data.List            (intersperse)
import           Data.Monoid
import           Data.Text            (Text)

-- | An opaque type representing a successfully decoded or constructed
-- semantic version. See the related functions and lenses for modification and
-- update.
--
-- * The 'Eq' instance represents exhaustive equality with all
-- components considered.
--
-- * The 'Ord' instance implements the precedence rules from the semantic
-- version specification with metadata being ignored.
data Version = Version
    { Version -> Int
_versionMajor   :: !Int
    , Version -> Int
_versionMinor   :: !Int
    , Version -> Int
_versionPatch   :: !Int
    , Version -> [Identifier]
_versionRelease :: [Identifier]
    , Version -> [Identifier]
_versionMeta    :: [Identifier]
    } deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)

instance Ord Version where
    compare :: Version -> Version -> Ordering
compare Version
a Version
b = ([Int] -> [Int] -> Ordering)
-> (Version -> [Int]) -> Version -> Version -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [Int] -> [Int] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Version -> [Int]
versions Version
a Version
b Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
release
      where
        versions :: Version -> [Int]
versions Version{Int
[Identifier]
_versionMeta :: [Identifier]
_versionRelease :: [Identifier]
_versionPatch :: Int
_versionMinor :: Int
_versionMajor :: Int
_versionMeta :: Version -> [Identifier]
_versionRelease :: Version -> [Identifier]
_versionPatch :: Version -> Int
_versionMinor :: Version -> Int
_versionMajor :: Version -> Int
..} =
            [ Int
_versionMajor
            , Int
_versionMinor
            , Int
_versionPatch
            ]

        -- | Compare version releases.
        --
        -- Note: Contrary to 'List's, @[] `compare` [xs]@ equals to @GT@
        release :: Ordering
release =
            case (Version -> [Identifier]
_versionRelease Version
a, Version -> [Identifier]
_versionRelease Version
b) of
                ([], Identifier
_:[Identifier]
_) -> Ordering
GT
                (Identifier
_:[Identifier]
_, []) -> Ordering
LT
                ([Identifier]
x, [Identifier]
y)  -> [Identifier]
x [Identifier] -> [Identifier] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` [Identifier]
y

instance NFData Version where
    rnf :: Version -> ()
rnf Version{Int
[Identifier]
_versionMeta :: [Identifier]
_versionRelease :: [Identifier]
_versionPatch :: Int
_versionMinor :: Int
_versionMajor :: Int
_versionMeta :: Version -> [Identifier]
_versionRelease :: Version -> [Identifier]
_versionPatch :: Version -> Int
_versionMinor :: Version -> Int
_versionMajor :: Version -> Int
..} =
              Int -> ()
forall a. NFData a => a -> ()
rnf Int
_versionMajor
        () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
_versionMinor
        () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
_versionPatch
        () -> () -> ()
`seq` [Identifier] -> ()
forall a. NFData a => a -> ()
rnf [Identifier]
_versionRelease
        () -> () -> ()
`seq` [Identifier] -> ()
forall a. NFData a => a -> ()
rnf [Identifier]
_versionMeta

instance Hashable Version where
    hashWithSalt :: Int -> Version -> Int
hashWithSalt Int
s Version {Int
[Identifier]
_versionMeta :: [Identifier]
_versionRelease :: [Identifier]
_versionPatch :: Int
_versionMinor :: Int
_versionMajor :: Int
_versionMeta :: Version -> [Identifier]
_versionRelease :: Version -> [Identifier]
_versionPatch :: Version -> Int
_versionMinor :: Version -> Int
_versionMajor :: Version -> Int
..} =
        Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
_versionMajor
          Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
_versionMinor
          Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
_versionPatch
          Int -> [Identifier] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [Identifier]
_versionRelease
          Int -> [Identifier] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [Identifier]
_versionMeta

-- | A type representing an individual identifier from the release
-- or metadata components of a 'Version'.
--
-- * The 'Ord' instance implements precedence according to the semantic version
-- specification, with numeric identifiers being of /lower/ precedence than
-- textual identifiers, otherwise lexicographic ordering is used.
--
-- The functions 'numeric' and 'textual' can be used to construct an 'Identifier'.
data Identifier
    = INum  !Int
    | IText !Text
      deriving (Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq, Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identifier] -> ShowS
$cshowList :: [Identifier] -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show)

instance Ord Identifier where
    compare :: Identifier -> Identifier -> Ordering
compare Identifier
a Identifier
b = case (Identifier
a, Identifier
b) of
        (INum  Int
x, INum  Int
y) -> Int
x Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
y
        (IText Text
x, IText Text
y) -> Text
x Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Text
y
        (INum  Int
_, Identifier
_)       -> Ordering
LT
        (IText Text
_, Identifier
_)       -> Ordering
GT

instance NFData Identifier where
    rnf :: Identifier -> ()
rnf (INum  Int
n) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
n
    rnf (IText Text
t) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t

instance Hashable Identifier where
    hashWithSalt :: Int -> Identifier -> Int
hashWithSalt Int
s (INum  Int
n) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
n
    hashWithSalt Int
s (IText Text
t) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
t

identifierParser :: Parser () -> Parser Identifier
identifierParser :: Parser () -> Parser Identifier
identifierParser Parser ()
p =
    (Int -> Identifier)
-> (Text -> Identifier) -> Either Int Text -> Identifier
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Int -> Identifier
INum Text -> Identifier
IText (Either Int Text -> Identifier)
-> Parser Text (Either Int Text) -> Parser Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
-> Parser Text Text -> Parser Text (Either Int Text)
forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
eitherP (Parser () -> Parser Text Int
numericParser Parser ()
p) (Parser () -> Parser Text Text
textualParser Parser ()
p)

numericParser :: Parser () -> Parser Int
numericParser :: Parser () -> Parser Text Int
numericParser Parser ()
p = Parser Text Int
forall a. (Show a, Integral a) => Parser a
nonNegative Parser Text Int -> Parser () -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ()
p Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall t. Chunk t => Parser t ()
endOfInput)

textualParser :: Parser () -> Parser Text
textualParser :: Parser () -> Parser Text Text
textualParser Parser ()
p = (Char -> Bool) -> Parser Text Text
takeWhile1 (String -> Char -> Bool
inClass String
"0-9A-Za-z-") Parser Text Text -> Parser Text (Maybe ()) -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
p

nonNegative :: (Show a, Integral a) => Parser a
nonNegative :: Parser a
nonNegative = do
    a
n <- Parser a
forall a. Integral a => Parser a
decimal
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
        String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Numeric value must be non-negative: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n)
    a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
n

-- | An opaque set representing the seperators used to delimit semantic
-- version components.
data Delimiters = Delimiters
    { Delimiters -> Char
_delimMinor   :: !Char
    , Delimiters -> Char
_delimPatch   :: !Char
    , Delimiters -> Char
_delimRelease :: !Char
    , Delimiters -> Char
_delimMeta    :: !Char
    , Delimiters -> Char
_delimIdent   :: !Char
    } deriving (Delimiters -> Delimiters -> Bool
(Delimiters -> Delimiters -> Bool)
-> (Delimiters -> Delimiters -> Bool) -> Eq Delimiters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delimiters -> Delimiters -> Bool
$c/= :: Delimiters -> Delimiters -> Bool
== :: Delimiters -> Delimiters -> Bool
$c== :: Delimiters -> Delimiters -> Bool
Eq, Eq Delimiters
Eq Delimiters
-> (Delimiters -> Delimiters -> Ordering)
-> (Delimiters -> Delimiters -> Bool)
-> (Delimiters -> Delimiters -> Bool)
-> (Delimiters -> Delimiters -> Bool)
-> (Delimiters -> Delimiters -> Bool)
-> (Delimiters -> Delimiters -> Delimiters)
-> (Delimiters -> Delimiters -> Delimiters)
-> Ord Delimiters
Delimiters -> Delimiters -> Bool
Delimiters -> Delimiters -> Ordering
Delimiters -> Delimiters -> Delimiters
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Delimiters -> Delimiters -> Delimiters
$cmin :: Delimiters -> Delimiters -> Delimiters
max :: Delimiters -> Delimiters -> Delimiters
$cmax :: Delimiters -> Delimiters -> Delimiters
>= :: Delimiters -> Delimiters -> Bool
$c>= :: Delimiters -> Delimiters -> Bool
> :: Delimiters -> Delimiters -> Bool
$c> :: Delimiters -> Delimiters -> Bool
<= :: Delimiters -> Delimiters -> Bool
$c<= :: Delimiters -> Delimiters -> Bool
< :: Delimiters -> Delimiters -> Bool
$c< :: Delimiters -> Delimiters -> Bool
compare :: Delimiters -> Delimiters -> Ordering
$ccompare :: Delimiters -> Delimiters -> Ordering
$cp1Ord :: Eq Delimiters
Ord, Int -> Delimiters -> ShowS
[Delimiters] -> ShowS
Delimiters -> String
(Int -> Delimiters -> ShowS)
-> (Delimiters -> String)
-> ([Delimiters] -> ShowS)
-> Show Delimiters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delimiters] -> ShowS
$cshowList :: [Delimiters] -> ShowS
show :: Delimiters -> String
$cshow :: Delimiters -> String
showsPrec :: Int -> Delimiters -> ShowS
$cshowsPrec :: Int -> Delimiters -> ShowS
Show)

instance NFData Delimiters where
    rnf :: Delimiters -> ()
rnf Delimiters{Char
_delimIdent :: Char
_delimMeta :: Char
_delimRelease :: Char
_delimPatch :: Char
_delimMinor :: Char
_delimIdent :: Delimiters -> Char
_delimMeta :: Delimiters -> Char
_delimRelease :: Delimiters -> Char
_delimPatch :: Delimiters -> Char
_delimMinor :: Delimiters -> Char
..} =
              Char -> ()
forall a. NFData a => a -> ()
rnf Char
_delimMinor
        () -> () -> ()
`seq` Char -> ()
forall a. NFData a => a -> ()
rnf Char
_delimPatch
        () -> () -> ()
`seq` Char -> ()
forall a. NFData a => a -> ()
rnf Char
_delimRelease
        () -> () -> ()
`seq` Char -> ()
forall a. NFData a => a -> ()
rnf Char
_delimMeta
        () -> () -> ()
`seq` Char -> ()
forall a. NFData a => a -> ()
rnf Char
_delimIdent

toMonoid :: Monoid m
         => (Char -> m)
         -> (Int  -> m)
         -> (Text -> m)
         -> Delimiters
         -> Version
         -> m
toMonoid :: (Char -> m)
-> (Int -> m) -> (Text -> m) -> Delimiters -> Version -> m
toMonoid Char -> m
del Int -> m
int Text -> m
txt Delimiters{Char
_delimIdent :: Char
_delimMeta :: Char
_delimRelease :: Char
_delimPatch :: Char
_delimMinor :: Char
_delimIdent :: Delimiters -> Char
_delimMeta :: Delimiters -> Char
_delimRelease :: Delimiters -> Char
_delimPatch :: Delimiters -> Char
_delimMinor :: Delimiters -> Char
..} Version{Int
[Identifier]
_versionMeta :: [Identifier]
_versionRelease :: [Identifier]
_versionPatch :: Int
_versionMinor :: Int
_versionMajor :: Int
_versionMeta :: Version -> [Identifier]
_versionRelease :: Version -> [Identifier]
_versionPatch :: Version -> Int
_versionMinor :: Version -> Int
_versionMajor :: Version -> Int
..} = [m] -> m
forall a. Monoid a => [a] -> a
mconcat
     [ Int -> m
int Int
_versionMajor
     , Char -> m
del Char
_delimMinor
     , Int -> m
int Int
_versionMinor
     , Char -> m
del Char
_delimPatch
     , Int -> m
int Int
_versionPatch
     , Char -> [Identifier] -> m
f Char
_delimRelease [Identifier]
_versionRelease
     , Char -> [Identifier] -> m
f Char
_delimMeta    [Identifier]
_versionMeta
     ]
  where
    f :: Char -> [Identifier] -> m
f Char
_ [] = m
forall a. Monoid a => a
mempty
    f Char
c [Identifier]
xs = Char -> m
del Char
c m -> m -> m
forall a. Semigroup a => a -> a -> a
<> [m] -> m
forall a. Monoid a => [a] -> a
mconcat (m -> [m] -> [m]
forall a. a -> [a] -> [a]
intersperse (Char -> m
del Char
_delimIdent) ((Identifier -> m) -> [Identifier] -> [m]
forall a b. (a -> b) -> [a] -> [b]
map Identifier -> m
g [Identifier]
xs))

    g :: Identifier -> m
g (INum  Int
n) = Int -> m
int Int
n
    g (IText Text
t) = Text -> m
txt Text
t
{-# INLINE toMonoid #-}