NonDigit.hs

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

module Data.SemanticVersion.NonDigit where

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

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

-- <non-digit> ::= <letter>
--               | "-"
data NonDigit =
  NonDigitHyphen
  | NonDigitLetter Alpha
  deriving (Eq, Show)

class HasNonDigit a where
  nonDigit ::
    Lens' a NonDigit

instance HasNonDigit NonDigit where
  nonDigit =
    id

class AsNonDigit a where
  _NonDigit ::
    Prism' a NonDigit
  _NonDigitHyphen ::
    Prism' a ()
  _NonDigitHyphen =
    _NonDigit .
    prism'
      (\() -> NonDigitHyphen)
      (\case
        NonDigitHyphen ->
          Just ()
        _ ->
          Nothing)
  _NonDigitLetter ::
    Prism' a Alpha
  _NonDigitLetter =
    _NonDigit .
    prism'
      NonDigitLetter
      (\case
        NonDigitLetter a ->
          Just a
        _ ->
          Nothing)

instance AsNonDigit NonDigit where
  _NonDigit =
    id

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

-- |
--
-- >>> parse parseNonDigit "parseNonDigit" "a"
-- Right (NonDigitLetter (AlphaLower Lower_a))
--
-- >>> isLeft (parse parseNonDigit "parseNonDigit" "")
-- True
--
-- >>> parse parseIdentifierCharacter "parseNonDigit" "Abc"
-- Right (IdentifierCharacterNonDigit (NonDigitLetter (AlphaUpper Upper_A)))
--
-- >>> parse parseIdentifierCharacter "parseNonDigit" "0"
-- Right (IdentifierCharacterDigit DecDigit0)
--
-- >>> parse parseIdentifierCharacter "parseNonDigit" "-"
-- Right (IdentifierCharacterNonDigit NonDigitHyphen)
--
-- >>> isLeft (parse parseNonDigit "parseNonDigit" "+")
-- True
--
-- >>> isLeft (parse parseNonDigit "parseNonDigit" "9")
-- True
parseNonDigit ::
  CharParsing p =>
  p NonDigit
parseNonDigit =
  NonDigitLetter <$> parse_alpha <|>
  NonDigitHyphen <$ char '-'