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

-- Module      : Data.SemVer.Delimited
-- 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)

-- | A set of delimiters can be used to encode/decode a 'Version' and specify
-- alternative serialisation strategies.
--
-- Lenses can be used to modify the default delimiter set, as in the following
-- example - using alpha characters to encode the version as a valid
-- DNS CNAME (assuming operators from lens or lens-family-core):
--
-- @
-- let Right v = fromText \"1.2.3+40\"
-- let alpha = semantic & major .~ \'m\' & patch .~ \'p\' & release .~ \'r\' & metadata .~ \'d\' & identifier .~ \'i\'
--
-- Data.Text.Lazy.Builder.toLazyText (\"app01-\" <> toBuilder alpha v <> \".dmz.internal\")
-- @
--
-- Would result in the following 'LText.Text':
--
-- @
-- app01-1m2p3d40.dmz.internal
-- @
--
-- Using the same 'Delimiters' set with 'parser' would ensure
-- correct decoding behaviour.
module Data.SemVer.Delimited
    (
    -- * Delimiters
      Delimiters
    -- ** Constructor
    , semantic
    -- ** Lenses
    , minor
    , patch
    , release
    , metadata
    , identifier
    -- ** Encoding
    , toBuilder
    -- ** Decoding
    , parser
    ) where

import           Control.Applicative
import           Control.Monad
import           Data.Attoparsec.Text
import           Data.SemVer.Internal
import           Data.Text.Lazy.Builder     (Builder)
import qualified Data.Text.Lazy.Builder     as Build
import qualified Data.Text.Lazy.Builder.Int as Build

-- | The default set of delimiters used in the semantic version specification.
--
-- Example: Given exhaustive version components would result in the
-- following hypothetical version:
--
-- @
-- 1.2.3-alpha.1+sha.exp.12ab3d9
-- @
semantic :: Delimiters
semantic :: Delimiters
semantic = Delimiters :: Char -> Char -> Char -> Char -> Char -> Delimiters
Delimiters
    { _delimMinor :: Char
_delimMinor   = Char
'.'
    , _delimPatch :: Char
_delimPatch   = Char
'.'
    , _delimRelease :: Char
_delimRelease = Char
'-'
    , _delimMeta :: Char
_delimMeta    = Char
'+'
    , _delimIdent :: Char
_delimIdent   = Char
'.'
    }

-- | Lens for the minor version delimiter. Default: @.@
minor :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
minor :: (Char -> f Char) -> Delimiters -> f Delimiters
minor Char -> f Char
f Delimiters
x = (\Char
y -> Delimiters
x { _delimMinor :: Char
_delimMinor = Char
y }) (Char -> Delimiters) -> f Char -> f Delimiters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> f Char
f (Delimiters -> Char
_delimMinor Delimiters
x)
{-# INLINE minor #-}

-- | Lens for the patch version delimiter. Default: @.@
patch :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
patch :: (Char -> f Char) -> Delimiters -> f Delimiters
patch Char -> f Char
f Delimiters
x = (\Char
y -> Delimiters
x { _delimPatch :: Char
_delimPatch = Char
y }) (Char -> Delimiters) -> f Char -> f Delimiters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> f Char
f (Delimiters -> Char
_delimPatch Delimiters
x)
{-# INLINE patch #-}

-- | Lens for the release component delimiter. Default: @-@
release :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
release :: (Char -> f Char) -> Delimiters -> f Delimiters
release Char -> f Char
f Delimiters
x = (\Char
y -> Delimiters
x { _delimRelease :: Char
_delimRelease = Char
y }) (Char -> Delimiters) -> f Char -> f Delimiters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> f Char
f (Delimiters -> Char
_delimRelease Delimiters
x)
{-# INLINE release #-}

-- | Lens for the metadata component delimiter. Default: @+@
metadata :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
metadata :: (Char -> f Char) -> Delimiters -> f Delimiters
metadata Char -> f Char
f Delimiters
x = (\Char
y -> Delimiters
x { _delimMeta :: Char
_delimMeta = Char
y }) (Char -> Delimiters) -> f Char -> f Delimiters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> f Char
f (Delimiters -> Char
_delimMeta Delimiters
x)
{-# INLINE metadata #-}

-- | Lens for the individual identifier delimiter. Default: @.@
identifier :: Functor f => (Char -> f Char) -> Delimiters -> f Delimiters
identifier :: (Char -> f Char) -> Delimiters -> f Delimiters
identifier Char -> f Char
f Delimiters
x = (\Char
y -> Delimiters
x { _delimIdent :: Char
_delimIdent = Char
y }) (Char -> Delimiters) -> f Char -> f Delimiters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> f Char
f (Delimiters -> Char
_delimIdent Delimiters
x)
{-# INLINE identifier #-}

-- | Convert a 'Version' to a 'Builder' using the specified 'Delimiters' set.
toBuilder :: Delimiters -> Version -> Builder
toBuilder :: Delimiters -> Version -> Builder
toBuilder = (Char -> Builder)
-> (Int -> Builder)
-> (Text -> Builder)
-> Delimiters
-> Version
-> Builder
forall m.
Monoid m =>
(Char -> m)
-> (Int -> m) -> (Text -> m) -> Delimiters -> Version -> m
toMonoid Char -> Builder
Build.singleton Int -> Builder
forall a. Integral a => a -> Builder
Build.decimal Text -> Builder
Build.fromText

-- | A greedy attoparsec 'Parser' using the specified 'Delimiters' set
-- which requires the entire 'Text' input to match.
parser :: Delimiters -> Bool -> Parser Version
parser :: Delimiters -> Bool -> Parser Version
parser 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
..} Bool
requireAtEnd = Int -> Int -> Int -> [Identifier] -> [Identifier] -> Version
Version
    (Int -> Int -> Int -> [Identifier] -> [Identifier] -> Version)
-> Parser Text Int
-> Parser
     Text (Int -> Int -> [Identifier] -> [Identifier] -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Int
forall a. (Show a, Integral a) => Parser a
nonNegative Parser Text Int -> Parser Text Char -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
_delimMinor)
    Parser Text (Int -> Int -> [Identifier] -> [Identifier] -> Version)
-> Parser Text Int
-> Parser Text (Int -> [Identifier] -> [Identifier] -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Int
forall a. (Show a, Integral a) => Parser a
nonNegative Parser Text Int -> Parser Text Char -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
_delimPatch)
    Parser Text (Int -> [Identifier] -> [Identifier] -> Version)
-> Parser Text Int
-> Parser Text ([Identifier] -> [Identifier] -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Int
forall a. (Show a, Integral a) => Parser a
nonNegative
    Parser Text ([Identifier] -> [Identifier] -> Version)
-> Parser Text [Identifier]
-> Parser Text ([Identifier] -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Identifier]
-> Parser Text [Identifier] -> Parser Text [Identifier]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] (Parser Text Char -> Parser Text Char
forall i a. Parser i a -> Parser i a
try (Char -> Parser Text Char
char Char
_delimRelease)  Parser Text Char
-> Parser Text [Identifier] -> Parser Text [Identifier]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text [Identifier]
identifiers)
    Parser Text ([Identifier] -> Version)
-> Parser Text [Identifier] -> Parser Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Identifier]
-> Parser Text [Identifier] -> Parser Text [Identifier]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] (Parser Text Char -> Parser Text Char
forall i a. Parser i a -> Parser i a
try (Char -> Parser Text Char
char Char
_delimMeta) Parser Text Char
-> Parser Text [Identifier] -> Parser Text [Identifier]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text [Identifier]
identifiers)
    Parser Version -> Parser Text () -> Parser Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
requireAtEnd Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput
  where
    identifiers :: Parser [Identifier]
    identifiers :: Parser Text [Identifier]
identifiers = Parser Text Identifier -> Parser Text [Identifier]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text () -> Parser Text Identifier
identifierParser (Parser Text () -> Parser Text Identifier)
-> Parser Text () -> Parser Text Identifier
forall a b. (a -> b) -> a -> b
$ Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Text Char
char Char
_delimIdent))