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

module Data.SemanticVersion.AlphanumericIdentifier where

import Control.Applicative
import Control.Lens
import Data.Digit
import Data.List.NonEmpty
import Data.SemanticVersion.NonDigit
import Data.SemanticVersion.IdentifierCharacter
import Data.SemanticVersion.IdentifierCharacters
import Text.Parser.Char
import Text.Parser.Combinators

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

-- <alphanumeric identifier> ::= <non-digit>
--                             | <non-digit> <identifier characters>
--                             | <identifier characters> <non-digit>
--                             | <identifier characters> <non-digit> <identifier characters>
data AlphanumericIdentifier =
  AlphanumericIdentifierNonDigit NonDigit
  | AlphanumericIdentifierNonDigits NonDigit IdentifierCharacters
  | AlphanumericIdentifierCharacters IdentifierCharacters NonDigit
  | AlphanumericIdentifierCharacters2 IdentifierCharacters NonDigit IdentifierCharacters
  deriving (AlphanumericIdentifier -> AlphanumericIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlphanumericIdentifier -> AlphanumericIdentifier -> Bool
$c/= :: AlphanumericIdentifier -> AlphanumericIdentifier -> Bool
== :: AlphanumericIdentifier -> AlphanumericIdentifier -> Bool
$c== :: AlphanumericIdentifier -> AlphanumericIdentifier -> Bool
Eq, Int -> AlphanumericIdentifier -> ShowS
[AlphanumericIdentifier] -> ShowS
AlphanumericIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlphanumericIdentifier] -> ShowS
$cshowList :: [AlphanumericIdentifier] -> ShowS
show :: AlphanumericIdentifier -> String
$cshow :: AlphanumericIdentifier -> String
showsPrec :: Int -> AlphanumericIdentifier -> ShowS
$cshowsPrec :: Int -> AlphanumericIdentifier -> ShowS
Show)

class HasAlphanumericIdentifier a where
  alphanumericIdentifier ::
    Lens' a AlphanumericIdentifier

instance HasAlphanumericIdentifier AlphanumericIdentifier where
  alphanumericIdentifier :: Lens' AlphanumericIdentifier AlphanumericIdentifier
alphanumericIdentifier =
    forall a. a -> a
id

class AsAlphanumericIdentifier a where
  _AlphanumericIdentifier ::
    Prism' a AlphanumericIdentifier
  _AlphanumericIdentifierNonDigit ::
    Prism' a NonDigit
  _AlphanumericIdentifierNonDigit =
    forall a.
AsAlphanumericIdentifier a =>
Prism' a AlphanumericIdentifier
_AlphanumericIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      NonDigit -> AlphanumericIdentifier
AlphanumericIdentifierNonDigit
      (\case
        AlphanumericIdentifierNonDigit NonDigit
a ->
          forall a. a -> Maybe a
Just NonDigit
a
        AlphanumericIdentifier
_ ->
          forall a. Maybe a
Nothing)
  _AlphanumericIdentifierNonDigits ::
    Prism' a (NonDigit, IdentifierCharacters)
  _AlphanumericIdentifierNonDigits =
    forall a.
AsAlphanumericIdentifier a =>
Prism' a AlphanumericIdentifier
_AlphanumericIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NonDigit -> IdentifierCharacters -> AlphanumericIdentifier
AlphanumericIdentifierNonDigits)
      (\case
        AlphanumericIdentifierNonDigits NonDigit
d IdentifierCharacters
cs ->
          forall a. a -> Maybe a
Just (NonDigit
d, IdentifierCharacters
cs)
        AlphanumericIdentifier
_ ->
          forall a. Maybe a
Nothing)
  _AlphanumericIdentifierCharacters ::
    Prism' a (IdentifierCharacters, NonDigit)
  _AlphanumericIdentifierCharacters =
    forall a.
AsAlphanumericIdentifier a =>
Prism' a AlphanumericIdentifier
_AlphanumericIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry IdentifierCharacters -> NonDigit -> AlphanumericIdentifier
AlphanumericIdentifierCharacters)
      (\case
        AlphanumericIdentifierCharacters IdentifierCharacters
cs NonDigit
d ->
          forall a. a -> Maybe a
Just (IdentifierCharacters
cs, NonDigit
d)
        AlphanumericIdentifier
_ ->
          forall a. Maybe a
Nothing)
  _AlphanumericIdentifierCharacters2 ::
    Prism' a (IdentifierCharacters, NonDigit, IdentifierCharacters)
  _AlphanumericIdentifierCharacters2 =
    forall a.
AsAlphanumericIdentifier a =>
Prism' a AlphanumericIdentifier
_AlphanumericIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
      (\(IdentifierCharacters
cs1, NonDigit
d, IdentifierCharacters
cs2) -> IdentifierCharacters
-> NonDigit -> IdentifierCharacters -> AlphanumericIdentifier
AlphanumericIdentifierCharacters2 IdentifierCharacters
cs1 NonDigit
d IdentifierCharacters
cs2)
      (\case
        AlphanumericIdentifierCharacters2 IdentifierCharacters
cs1 NonDigit
d IdentifierCharacters
cs2 ->
          forall a. a -> Maybe a
Just (IdentifierCharacters
cs1, NonDigit
d, IdentifierCharacters
cs2)
        AlphanumericIdentifier
_ ->
          forall a. Maybe a
Nothing)

instance AsAlphanumericIdentifier AlphanumericIdentifier where
  _AlphanumericIdentifier :: Prism' AlphanumericIdentifier AlphanumericIdentifier
_AlphanumericIdentifier =
    forall a. a -> a
id

instance HasNonDigit AlphanumericIdentifier where
  nonDigit :: Lens' AlphanumericIdentifier NonDigit
nonDigit NonDigit -> f NonDigit
f (AlphanumericIdentifierNonDigit NonDigit
d) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonDigit -> AlphanumericIdentifier
AlphanumericIdentifierNonDigit (NonDigit -> f NonDigit
f NonDigit
d)
  nonDigit NonDigit -> f NonDigit
f (AlphanumericIdentifierNonDigits NonDigit
d IdentifierCharacters
cs) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonDigit -> IdentifierCharacters -> AlphanumericIdentifier
`AlphanumericIdentifierNonDigits` IdentifierCharacters
cs) (NonDigit -> f NonDigit
f NonDigit
d)
  nonDigit NonDigit -> f NonDigit
f (AlphanumericIdentifierCharacters IdentifierCharacters
cs NonDigit
d) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IdentifierCharacters -> NonDigit -> AlphanumericIdentifier
AlphanumericIdentifierCharacters IdentifierCharacters
cs) (NonDigit -> f NonDigit
f NonDigit
d)
  nonDigit NonDigit -> f NonDigit
f (AlphanumericIdentifierCharacters2 IdentifierCharacters
cs1 NonDigit
d IdentifierCharacters
cs2) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NonDigit
d' -> IdentifierCharacters
-> NonDigit -> IdentifierCharacters -> AlphanumericIdentifier
AlphanumericIdentifierCharacters2 IdentifierCharacters
cs1 NonDigit
d' IdentifierCharacters
cs2) (NonDigit -> f NonDigit
f NonDigit
d)

-- |
--
-- >>> parse (parseAlphanumericIdentifier <* eof) "parseAlphanumericIdentifier" "A"
-- Right (AlphanumericIdentifierNonDigit (NonDigitLetter (AlphaUpper Upper_A)))
--
-- >>> isLeft (parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "")
-- True
--
-- >>> parse (parseAlphanumericIdentifier <* eof) "parseAlphanumericIdentifier" "Abc-123--XYZ"
-- Right (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaUpper Upper_A)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_b)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_c)),IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit2,IdentifierCharacterDigit DecDigit3,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_X)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_Y)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_Z))])))
--
-- >>> isLeft (parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "+")
-- True
--
-- >>> isLeft (parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "0")
-- True
--
-- >>> isLeft (parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "0+")
-- True
--
-- >>> parse (parseAlphanumericIdentifier <* eof) "parseAlphanumericIdentifier" "0a"
-- Right (AlphanumericIdentifierCharacters (IdentifierCharacters (IdentifierCharacterDigit DecDigit0 :| [])) (NonDigitLetter (AlphaLower Lower_a)))
--
-- >>> parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "-"
-- Right (AlphanumericIdentifierNonDigit NonDigitHyphen)
--
-- >>> parse parseAlphanumericIdentifier "parseAlphanumericIdentifier" "Abc-123--XYZ+"
-- Right (AlphanumericIdentifierNonDigits (NonDigitLetter (AlphaUpper Upper_A)) (IdentifierCharacters (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_b)) :| [IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_c)),IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterDigit DecDigit1,IdentifierCharacterDigit DecDigit2,IdentifierCharacterDigit DecDigit3,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit NonDigitHyphen,IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_X)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_Y)),IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_Z))])))
parseAlphanumericIdentifier ::
  CharParsing p =>
  p AlphanumericIdentifier
parseAlphanumericIdentifier :: forall (p :: * -> *). CharParsing p => p AlphanumericIdentifier
parseAlphanumericIdentifier =
  forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall b a. b -> (a -> b) -> Maybe a -> b
maybe NonDigit -> AlphanumericIdentifier
AlphanumericIdentifierNonDigit NonDigit -> IdentifierCharacters -> AlphanumericIdentifier
AlphanumericIdentifierNonDigits forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *). CharParsing p => p NonDigit
parseNonDigit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (p :: * -> *). CharParsing p => p IdentifierCharacters
parseIdentifierCharacters)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (\NonEmpty DecDigit
c NonDigit
d ->
    let c' :: IdentifierCharacters
c' = NonEmpty IdentifierCharacter -> IdentifierCharacters
IdentifierCharacters (DecDigit -> IdentifierCharacter
IdentifierCharacterDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty DecDigit
c)
    in  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IdentifierCharacters -> NonDigit -> AlphanumericIdentifier
AlphanumericIdentifierCharacters IdentifierCharacters
c' NonDigit
d) (IdentifierCharacters
-> NonDigit -> IdentifierCharacters -> AlphanumericIdentifier
AlphanumericIdentifierCharacters2 IdentifierCharacters
c' NonDigit
d)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
some1 forall d (p :: * -> *). (Decimal d, CharParsing p) => p d
parseDecimal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> *). CharParsing p => p NonDigit
parseNonDigit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (p :: * -> *). CharParsing p => p IdentifierCharacters
parseIdentifierCharacters)