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

module Data.SemanticVersion.IdentifierCharacter where

import Control.Applicative
import Control.Lens
import Data.Char.Alpha
import Data.Digit
import Data.SemanticVersion.NonDigit
import Text.Parser.Char

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

-- <identifier character> ::= <digit>
--                          | <non-digit>
data IdentifierCharacter =
  IdentifierCharacterDigit DecDigit
  | IdentifierCharacterNonDigit NonDigit
  deriving (Eq, Show)

class HasIdentifierCharacter a where
  identifierCharacter ::
    Lens' a IdentifierCharacter

instance HasIdentifierCharacter IdentifierCharacter where
  identifierCharacter =
    id

class AsIdentifierCharacter a where
  _IdentifierCharacter ::
    Prism' a IdentifierCharacter
  _IdentifierCharacterDigit ::
    Prism' a DecDigit
  _IdentifierCharacterDigit =
    _IdentifierCharacter .
    prism'
      IdentifierCharacterDigit
      (\case
          IdentifierCharacterDigit a ->
            Just a
          _ ->
            Nothing)

instance AsIdentifierCharacter IdentifierCharacter where
  _IdentifierCharacter =
    id

instance AsNonDigit IdentifierCharacter where
  _NonDigit =
    prism'
      IdentifierCharacterNonDigit
      (\case
          IdentifierCharacterNonDigit a ->
            Just a
          _ ->
            Nothing)

instance CA IdentifierCharacter where _A' = _NonDigit . _A'
instance CB IdentifierCharacter where _B' = _NonDigit . _B'
instance CC IdentifierCharacter where _C' = _NonDigit . _C'
instance CD IdentifierCharacter where _D' = _NonDigit . _D'
instance CE IdentifierCharacter where _E' = _NonDigit . _E'
instance CF IdentifierCharacter where _F' = _NonDigit . _F'
instance CG IdentifierCharacter where _G' = _NonDigit . _G'
instance CH IdentifierCharacter where _H' = _NonDigit . _H'
instance CI IdentifierCharacter where _I' = _NonDigit . _I'
instance CJ IdentifierCharacter where _J' = _NonDigit . _J'
instance CK IdentifierCharacter where _K' = _NonDigit . _K'
instance CL IdentifierCharacter where _L' = _NonDigit . _L'
instance CM IdentifierCharacter where _M' = _NonDigit . _M'
instance CN IdentifierCharacter where _N' = _NonDigit . _N'
instance CO IdentifierCharacter where _O' = _NonDigit . _O'
instance CP IdentifierCharacter where _P' = _NonDigit . _P'
instance CQ IdentifierCharacter where _Q' = _NonDigit . _Q'
instance CR IdentifierCharacter where _R' = _NonDigit . _R'
instance CS IdentifierCharacter where _S' = _NonDigit . _S'
instance CT IdentifierCharacter where _T' = _NonDigit . _T'
instance CU IdentifierCharacter where _U' = _NonDigit . _U'
instance CV IdentifierCharacter where _V' = _NonDigit . _V'
instance CW IdentifierCharacter where _W' = _NonDigit . _W'
instance CX IdentifierCharacter where _X' = _NonDigit . _X'
instance CY IdentifierCharacter where _Y' = _NonDigit . _Y'
instance CZ IdentifierCharacter where _Z' = _NonDigit . _Z'
instance Ca IdentifierCharacter where _a' = _NonDigit . _a'
instance Cb IdentifierCharacter where _b' = _NonDigit . _b'
instance Cc IdentifierCharacter where _c' = _NonDigit . _c'
instance Cd IdentifierCharacter where _d' = _NonDigit . _d'
instance Ce IdentifierCharacter where _e' = _NonDigit . _e'
instance Cf IdentifierCharacter where _f' = _NonDigit . _f'
instance Cg IdentifierCharacter where _g' = _NonDigit . _g'
instance Ch IdentifierCharacter where _h' = _NonDigit . _h'
instance Ci IdentifierCharacter where _i' = _NonDigit . _i'
instance Cj IdentifierCharacter where _j' = _NonDigit . _j'
instance Ck IdentifierCharacter where _k' = _NonDigit . _k'
instance Cl IdentifierCharacter where _l' = _NonDigit . _l'
instance Cm IdentifierCharacter where _m' = _NonDigit . _m'
instance Cn IdentifierCharacter where _n' = _NonDigit . _n'
instance Co IdentifierCharacter where _o' = _NonDigit . _o'
instance Cp IdentifierCharacter where _p' = _NonDigit . _p'
instance Cq IdentifierCharacter where _q' = _NonDigit . _q'
instance Cr IdentifierCharacter where _r' = _NonDigit . _r'
instance Cs IdentifierCharacter where _s' = _NonDigit . _s'
instance Ct IdentifierCharacter where _t' = _NonDigit . _t'
instance Cu IdentifierCharacter where _u' = _NonDigit . _u'
instance Cv IdentifierCharacter where _v' = _NonDigit . _v'
instance Cw IdentifierCharacter where _w' = _NonDigit . _w'
instance Cx IdentifierCharacter where _x' = _NonDigit . _x'
instance Cy IdentifierCharacter where _y' = _NonDigit . _y'
instance Cz IdentifierCharacter where _z' = _NonDigit . _z'
instance D0 IdentifierCharacter where d0 = _IdentifierCharacterDigit . d0
instance D1 IdentifierCharacter where d1 = _IdentifierCharacterDigit . d1
instance D2 IdentifierCharacter where d2 = _IdentifierCharacterDigit . d2
instance D3 IdentifierCharacter where d3 = _IdentifierCharacterDigit . d3
instance D4 IdentifierCharacter where d4 = _IdentifierCharacterDigit . d4
instance D5 IdentifierCharacter where d5 = _IdentifierCharacterDigit . d5
instance D6 IdentifierCharacter where d6 = _IdentifierCharacterDigit . d6
instance D7 IdentifierCharacter where d7 = _IdentifierCharacterDigit . d7
instance D8 IdentifierCharacter where d8 = _IdentifierCharacterDigit . d8
instance D9 IdentifierCharacter where d9 = _IdentifierCharacterDigit . d9

-- |
--
-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "a"
-- Right (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a)))
--
-- >>> isLeft (parse parseIdentifierCharacter "parseIdentifierCharacter" "")
-- True
--
-- >>> parse parseIdentifierCharacter "parseIdentifierCharacter" "Abc"
-- Right (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_A)))
--
-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "-"
-- Right (IdentifierCharacterNonDigit NonDigitHyphen)
--
-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "0"
-- Right (IdentifierCharacterDigit DecDigit0)
--
-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "9"
-- Right (IdentifierCharacterDigit DecDigit9)
--
-- >>> isLeft (parse parseIdentifierCharacter "parseIdentifierCharacter" "+")
-- True
--
-- >>> isLeft (parse parseIdentifierCharacter "parseIdentifierCharacter" "")
-- True
--
-- >>> parse parseIdentifierCharacter "parseIdentifierCharacter" "01"
-- Right (IdentifierCharacterDigit DecDigit0)
--
-- >>> parse parseIdentifierCharacter "parseIdentifierCharacter" "10"
-- Right (IdentifierCharacterDigit DecDigit1)
--
-- >>> parse parseIdentifierCharacter "parseIdentifierCharacter" "38012"
-- Right (IdentifierCharacterDigit DecDigit3)
--
-- >>> parse (parseIdentifierCharacter <* eof) "parseIdentifierCharacter" "a"
-- Right (IdentifierCharacterNonDigit (NonDigitLetter (AlphaLower Lower_a)))
parseIdentifierCharacter ::
  CharParsing p =>
  p IdentifierCharacter
parseIdentifierCharacter =
  IdentifierCharacterDigit <$> parseDecimal <|>
  IdentifierCharacterNonDigit <$> parseNonDigit