NumericIdentifier.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE LambdaCase #-}

module Data.SemanticVersion.NumericIdentifier where

import Control.Applicative
import Control.Lens
import Data.Digit
import Text.Parser.Char

-- $setup
-- >>> import Text.Parsec(parse)
-- >>> import Data.Either(isLeft)

-- <numeric identifier> ::= "0"
--                        | <positive digit>
--                        | <positive digit> <digits>
data NumericIdentifier =
  NumericIdentifierZero
  | NumericIdentifierDigits DecDigitNoZero [DecDigit]
  deriving (Eq, Show)

class HasNumericIdentifier a where
  numericIdentifier ::
    Lens' a NumericIdentifier

instance HasNumericIdentifier NumericIdentifier where
  numericIdentifier =
    id

class AsNumericIdentifier a where
  _NumericIdentifier ::
    Prism' a NumericIdentifier
  _NumericIdentifierZero ::
    Prism' a ()
  _NumericIdentifierZero =
    _NumericIdentifier .
    prism'
      (\() -> NumericIdentifierZero)
      (\case
        NumericIdentifierZero ->
          Just ()
        _ ->
          Nothing)
  _NumericIdentifierDigits ::
    Prism' a (DecDigitNoZero, [DecDigit])
  _NumericIdentifierDigits =
    _NumericIdentifier .
    prism'
      (uncurry NumericIdentifierDigits)
      (\case
        NumericIdentifierDigits d ds ->
          Just (d, ds)
        _ ->
          Nothing)

instance AsNumericIdentifier NumericIdentifier where
  _NumericIdentifier =
    id

-- |
--
-- >>> parse (parseNumericIdentifier <* eof) "parseNumericIdentifier" "0"
-- Right NumericIdentifierZero
--
-- >>> isLeft (parse parseNumericIdentifier "parseNumericIdentifier" "")
-- True
--
-- >>> parse parseNumericIdentifier "parseNumericIdentifier" "01"
-- Right NumericIdentifierZero
--
-- >>> parse parseNumericIdentifier "parseNumericIdentifier" "10"
-- Right (NumericIdentifierDigits DecDigitNoZero1 [DecDigit0])
--
-- >>> parse parseNumericIdentifier "parseNumericIdentifier" "38012"
-- Right (NumericIdentifierDigits DecDigitNoZero3 [DecDigit8,DecDigit0,DecDigit1,DecDigit2])
--
-- >>> isLeft (parse parseNumericIdentifier "parseNumericIdentifier" "a")
-- True
--
-- >>> isLeft (parse parseNumericIdentifier "parseNumericIdentifier" "-")
-- True
parseNumericIdentifier ::
  CharParsing p =>
  p NumericIdentifier
parseNumericIdentifier =
  NumericIdentifierZero <$ char '0' <|>
  NumericIdentifierDigits <$> parseDecimalNoZero <*> many parseDecimal