{-# 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
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
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 = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Ord a => a -> a -> Ordering
compare Version -> [Int]
versions Version
a Version
b 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 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
..} =
              forall a. NFData a => a -> ()
rnf Int
_versionMajor
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Int
_versionMinor
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Int
_versionPatch
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Identifier]
_versionRelease
        seq :: forall a b. a -> b -> b
`seq` 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 forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
_versionMajor
          forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
_versionMinor
          forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
_versionPatch
          forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [Identifier]
_versionRelease
          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
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
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 forall a. Ord a => a -> a -> Ordering
`compare` Int
y
        (IText Text
x, IText Text
y) -> Text
x 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) = forall a. NFData a => a -> ()
rnf Int
n
    rnf (IText Text
t) = forall a. NFData a => a -> ()
rnf Text
t

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

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

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

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

nonNegative :: (Show a, Integral a) => Parser a
nonNegative :: forall a. (Show a, Integral a) => Parser a
nonNegative = do
    a
n <- forall a. Integral a => Parser a
decimal
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
n forall a. Ord a => a -> a -> Bool
< a
0) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Numeric value must be non-negative: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n)
    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
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
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
Ord, Int -> Delimiters -> ShowS
[Delimiters] -> ShowS
Delimiters -> String
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
..} =
              forall a. NFData a => a -> ()
rnf Char
_delimMinor
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Char
_delimPatch
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Char
_delimRelease
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Char
_delimMeta
        seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Char
_delimIdent

toMonoid :: Monoid m
         => (Char -> m)
         -> (Int  -> m)
         -> (Text -> m)
         -> Delimiters
         -> Version
         -> m
toMonoid :: forall m.
Monoid m =>
(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
..} = 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
_ [] = forall a. Monoid a => a
mempty
    f Char
c [Identifier]
xs = Char -> m
del Char
c forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> m
del Char
_delimIdent) (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 #-}