module Data.SemVer
(
Identifier (..)
, Version (..)
, defaultVersion
, versionMajor
, versionMinor
, versionPatch
, versionRelease
, versionMeta
, incrementMajor
, incrementMinor
, incrementPatch
, isDevelopment
, isPublic
, toString
, toText
, toLazyText
, toBuilder
, fromText
, fromLazyText
, parser
, Delimiters (..)
, defaultDelimiters
, delimMinor
, delimPatch
, delimRelease
, delimMeta
, delimIdent
, toDelimitedBuilder
, delimitedParser
) where
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Data.Attoparsec.Text
import Data.Char
import Data.Function (on)
import Data.List (intersperse)
import Data.Monoid
import Data.String
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as Build
import qualified Data.Text.Lazy.Builder.Int as Build
import Data.Typeable (Typeable)
import GHC.Generics
import Prelude hiding (takeWhile)
data Identifier
= INum !Int
| IText !Text
deriving (Eq, Read, Show, Generic, Typeable)
instance Ord Identifier where
compare a b = case (a, b) of
(INum x, INum y) -> x `compare` y
(IText x, IText y) -> x `compare` y
(INum _, _) -> LT
(IText _, _) -> GT
instance IsString Identifier where
fromString s
| all isDigit s = INum (read s)
| otherwise = IText (fromString s)
instance NFData Identifier where
rnf (INum n) = rnf n
rnf (IText t) = rnf t
data Version = Version
{ _versionMajor :: !Int
, _versionMinor :: !Int
, _versionPatch :: !Int
, _versionRelease :: [Identifier]
, _versionMeta :: [Identifier]
} deriving (Eq, Read, Show, Generic, Typeable)
defaultVersion :: Version
defaultVersion = Version 0 0 0 [] []
instance Ord Version where
compare a b = on compare versions a b <> on compare _versionRelease a b
where
versions Version{..} =
[ _versionMajor
, _versionMinor
, _versionPatch
]
instance NFData Version where
rnf Version{..} =
rnf _versionMajor
`seq` rnf _versionMinor
`seq` rnf _versionPatch
`seq` rnf _versionRelease
`seq` rnf _versionMeta
versionMajor :: Functor f => (Int -> f Int) -> Version -> f Version
versionMajor f x = (\y -> x { _versionMajor = y }) <$> f (_versionMajor x)
versionMinor :: Functor f => (Int -> f Int) -> Version -> f Version
versionMinor f x = (\y -> x { _versionMinor = y }) <$> f (_versionMinor x)
versionPatch :: Functor f => (Int -> f Int) -> Version -> f Version
versionPatch f x = (\y -> x { _versionPatch = y }) <$> f (_versionPatch x)
versionRelease :: Functor f
=> ([Identifier] -> f [Identifier])
-> Version
-> f Version
versionRelease f x = (\y -> x { _versionRelease = y }) <$> f (_versionRelease x)
versionMeta :: Functor f
=> ([Identifier] -> f [Identifier])
-> Version
-> f Version
versionMeta f x = (\y -> x { _versionMeta = y }) <$> f (_versionMeta x)
data Delimiters = Delimiters
{ _delimMinor :: !Char
, _delimPatch :: !Char
, _delimRelease :: !Char
, _delimMeta :: !Char
, _delimIdent :: !Char
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
defaultDelimiters :: Delimiters
defaultDelimiters = Delimiters
{ _delimMinor = '.'
, _delimPatch = '.'
, _delimRelease = '-'
, _delimMeta = '+'
, _delimIdent = '.'
}
instance NFData Delimiters where
rnf Delimiters{..} =
rnf _delimMinor
`seq` rnf _delimPatch
`seq` rnf _delimRelease
`seq` rnf _delimMeta
`seq` rnf _delimIdent
delimMinor :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
delimMinor f x = (\y -> x { _delimMinor = y }) <$> f (_delimMinor x)
delimPatch :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
delimPatch f x = (\y -> x { _delimPatch = y }) <$> f (_delimPatch x)
delimRelease :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
delimRelease f x = (\y -> x { _delimRelease = y }) <$> f (_delimRelease x)
delimMeta :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
delimMeta f x = (\y -> x { _delimMeta = y }) <$> f (_delimMeta x)
delimIdent :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
delimIdent f x = (\y -> x { _delimIdent = y }) <$> f (_delimIdent x)
incrementMajor :: Version -> Version
incrementMajor v = v
{ _versionMajor = _versionMajor v + 1
, _versionMinor = 0
, _versionPatch = 0
}
incrementMinor :: Version -> Version
incrementMinor v = v
{ _versionMinor = _versionMinor v + 1
, _versionPatch = 0
}
incrementPatch :: Version -> Version
incrementPatch v = v
{ _versionPatch = _versionPatch v + 1
}
isDevelopment :: Version -> Bool
isDevelopment = (== 0) . _versionMajor
isPublic :: Version -> Bool
isPublic = (>= 1) . _versionMajor
toString :: Version -> String
toString = toMonoid (:[]) show Text.unpack defaultDelimiters
toText :: Version -> Text
toText = LText.toStrict . toLazyText
toLazyText :: Version -> LText.Text
toLazyText = Build.toLazyTextWith 24 . toBuilder
toBuilder :: Version -> Builder
toBuilder = toDelimitedBuilder defaultDelimiters
toDelimitedBuilder :: Delimiters -> Version -> Builder
toDelimitedBuilder = toMonoid Build.singleton Build.decimal Build.fromText
toMonoid :: Monoid m
=> (Char -> m)
-> (Int -> m)
-> (Text -> m)
-> Delimiters
-> Version
-> m
toMonoid del int txt Delimiters{..} Version{..} = mconcat
[ int _versionMajor
, del _delimMinor
, int _versionMinor
, del _delimPatch
, int _versionPatch
, f _delimRelease _versionRelease
, f _delimMeta _versionMeta
]
where
f _ [] = mempty
f c xs = del c <> mconcat (intersperse (del _delimIdent) (map g xs))
g (INum n) = int n
g (IText t) = txt t
fromText :: Text -> Either String Version
fromText = parseOnly parser
fromLazyText :: LText.Text -> Either String Version
fromLazyText = fromText . LText.toStrict
parser :: Parser Version
parser = delimitedParser defaultDelimiters
delimitedParser :: Delimiters -> Parser Version
delimitedParser Delimiters{..} = Version
<$> (nonNegative <* char _delimMinor)
<*> (nonNegative <* char _delimPatch)
<*> nonNegative
<*> option [] (try (char _delimRelease) *> identifiers)
<*> option [] (try (char _delimMeta) *> identifiers)
<* endOfInput
where
nonNegative :: (Show a, Integral a) => Parser a
nonNegative = do
n <- decimal
when (n < 0) $
fail ("Numeric value must be non-negative: " ++ show n)
return n
identifiers :: Parser [Identifier]
identifiers = many (num <|> text)
num = INum
<$> nonNegative
<* (void (char _delimIdent) <|> endOfInput)
text = IText
<$> takeWhile1 (inClass "0-9A-Za-z-")
<* optional (char _delimIdent)