{-# LANGUAGE QuasiQuotes #-}

-- |
-- Exposes subspecies types of Char.
-- e.g. `[a-z]`, `[A-Z]`, and `[0-9]`.
module Data.Char.Cases
  ( AlphaNumChar (..)
  , alphaNumToChar
  , alphaNumChar
  , charToAlphaNum
  , alphaNumCharQ
  , AlphaChar (..)
  , alphaToChar
  , charToAlpha
  , alphaChar
  , alphaCharQ
  , UpperChar (..)
  , upperToChar
  , upperChar
  , charToUpper
  , upperCharQ
  , LowerChar (..)
  , lowerToChar
  , lowerChar
  , charToLower
  , lowerCharQ
  , DigitChar (..)
  , digitToChar
  , digitChar
  , charToDigit
  , digitCharQ
  , SnakeChar (..)
  , snakeToChar
  , snakeChar
  , charToSnake
  , snakeCharQ
  , SnakeHeadChar (..)
  , snakeHeadToChar
  , snakeHeadChar
  , charToSnakeHead
  , snakeHeadCharQ
  , UpperSnakeHeadChar (..)
  , upperSnakeHeadToChar
  , upperSnakeHeadChar
  , charToUpperSnakeHead
  , upperSnakeHeadCharQ
  , UpperSnakeChar (..)
  , upperSnakeToChar
  , upperSnakeChar
  , charToUpperSnake
  , upperSnakeCharQ
  ) where

import Cases.Megaparsec
import Control.Applicative
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import Data.Tuple (swap)
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P

-- $setup
-- >>> :set -XQuasiQuotes

dual :: Ord a => Map k a -> Map a k
dual :: Map k a -> Map a k
dual (Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toList -> [(k, a)]
x) =
  [(a, k)] -> Map a k
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(a, k)] -> Map a k) -> [(a, k)] -> Map a k
forall a b. (a -> b) -> a -> b
$ ((k, a) -> (a, k)) -> [(k, a)] -> [(a, k)]
forall a b. (a -> b) -> [a] -> [b]
map (k, a) -> (a, k)
forall a b. (a, b) -> (b, a)
swap [(k, a)]
x


-- | '[A-Za-z0-9]'
data AlphaNumChar = AlphaNumAlpha AlphaChar
                  | AlphaNumDigit DigitChar
  deriving (Int -> AlphaNumChar -> ShowS
[AlphaNumChar] -> ShowS
AlphaNumChar -> String
(Int -> AlphaNumChar -> ShowS)
-> (AlphaNumChar -> String)
-> ([AlphaNumChar] -> ShowS)
-> Show AlphaNumChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlphaNumChar] -> ShowS
$cshowList :: [AlphaNumChar] -> ShowS
show :: AlphaNumChar -> String
$cshow :: AlphaNumChar -> String
showsPrec :: Int -> AlphaNumChar -> ShowS
$cshowsPrec :: Int -> AlphaNumChar -> ShowS
Show, AlphaNumChar -> AlphaNumChar -> Bool
(AlphaNumChar -> AlphaNumChar -> Bool)
-> (AlphaNumChar -> AlphaNumChar -> Bool) -> Eq AlphaNumChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlphaNumChar -> AlphaNumChar -> Bool
$c/= :: AlphaNumChar -> AlphaNumChar -> Bool
== :: AlphaNumChar -> AlphaNumChar -> Bool
$c== :: AlphaNumChar -> AlphaNumChar -> Bool
Eq, Eq AlphaNumChar
Eq AlphaNumChar =>
(AlphaNumChar -> AlphaNumChar -> Ordering)
-> (AlphaNumChar -> AlphaNumChar -> Bool)
-> (AlphaNumChar -> AlphaNumChar -> Bool)
-> (AlphaNumChar -> AlphaNumChar -> Bool)
-> (AlphaNumChar -> AlphaNumChar -> Bool)
-> (AlphaNumChar -> AlphaNumChar -> AlphaNumChar)
-> (AlphaNumChar -> AlphaNumChar -> AlphaNumChar)
-> Ord AlphaNumChar
AlphaNumChar -> AlphaNumChar -> Bool
AlphaNumChar -> AlphaNumChar -> Ordering
AlphaNumChar -> AlphaNumChar -> AlphaNumChar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AlphaNumChar -> AlphaNumChar -> AlphaNumChar
$cmin :: AlphaNumChar -> AlphaNumChar -> AlphaNumChar
max :: AlphaNumChar -> AlphaNumChar -> AlphaNumChar
$cmax :: AlphaNumChar -> AlphaNumChar -> AlphaNumChar
>= :: AlphaNumChar -> AlphaNumChar -> Bool
$c>= :: AlphaNumChar -> AlphaNumChar -> Bool
> :: AlphaNumChar -> AlphaNumChar -> Bool
$c> :: AlphaNumChar -> AlphaNumChar -> Bool
<= :: AlphaNumChar -> AlphaNumChar -> Bool
$c<= :: AlphaNumChar -> AlphaNumChar -> Bool
< :: AlphaNumChar -> AlphaNumChar -> Bool
$c< :: AlphaNumChar -> AlphaNumChar -> Bool
compare :: AlphaNumChar -> AlphaNumChar -> Ordering
$ccompare :: AlphaNumChar -> AlphaNumChar -> Ordering
$cp1Ord :: Eq AlphaNumChar
Ord)

alphaNumToChar :: AlphaNumChar -> Char
alphaNumToChar :: AlphaNumChar -> Char
alphaNumToChar (AlphaNumAlpha x :: AlphaChar
x) = AlphaChar -> Char
alphaToChar AlphaChar
x
alphaNumToChar (AlphaNumDigit x :: DigitChar
x) = DigitChar -> Char
digitToChar DigitChar
x

alphaNumChar :: CodeParsing m => m AlphaNumChar
alphaNumChar :: m AlphaNumChar
alphaNumChar =
  AlphaChar -> AlphaNumChar
AlphaNumAlpha (AlphaChar -> AlphaNumChar) -> m AlphaChar -> m AlphaNumChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m AlphaChar
forall (m :: * -> *). CodeParsing m => m AlphaChar
alphaChar m AlphaNumChar -> m AlphaNumChar -> m AlphaNumChar
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  DigitChar -> AlphaNumChar
AlphaNumDigit (DigitChar -> AlphaNumChar) -> m DigitChar -> m AlphaNumChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m DigitChar
forall (m :: * -> *). CodeParsing m => m DigitChar
digitChar

charToAlphaNum :: Char -> Maybe AlphaNumChar
charToAlphaNum :: Char -> Maybe AlphaNumChar
charToAlphaNum x :: Char
x = Parsec Void String AlphaNumChar -> String -> Maybe AlphaNumChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String AlphaNumChar
forall (m :: * -> *). CodeParsing m => m AlphaNumChar
alphaNumChar [Char
x]

-- |
-- Simular to 'alphaCharQ' and 'digitCharQ'.
--
-- >>> [alphaNumCharQ|x|]
-- AlphaNumAlpha (AlphaLower X_)
--
-- >>> [alphaNumCharQ|X|]
-- AlphaNumAlpha (AlphaUpper X)
--
-- >>> [alphaNumCharQ|1|]
-- AlphaNumDigit D1
alphaNumCharQ :: QuasiQuoter
alphaNumCharQ :: QuasiQuoter
alphaNumCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "alphaNumCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe AlphaNumChar
charToAlphaNum Char
x of
      Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not an AlphaNumChar."
      Just (AlphaNumAlpha _) ->
        (Name -> Exp
ConE (String -> Name
mkName "AlphaNumAlpha") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
alphaCharQ) [Char
x]
      Just (AlphaNumDigit _) ->
        (Name -> Exp
ConE (String -> Name
mkName "AlphaNumDigit") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
digitCharQ) [Char
x]

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "alphaNumCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs


-- | '[A-Za-z]'
data AlphaChar = AlphaLower LowerChar
               | AlphaUpper UpperChar
  deriving (Int -> AlphaChar -> ShowS
[AlphaChar] -> ShowS
AlphaChar -> String
(Int -> AlphaChar -> ShowS)
-> (AlphaChar -> String)
-> ([AlphaChar] -> ShowS)
-> Show AlphaChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlphaChar] -> ShowS
$cshowList :: [AlphaChar] -> ShowS
show :: AlphaChar -> String
$cshow :: AlphaChar -> String
showsPrec :: Int -> AlphaChar -> ShowS
$cshowsPrec :: Int -> AlphaChar -> ShowS
Show, AlphaChar -> AlphaChar -> Bool
(AlphaChar -> AlphaChar -> Bool)
-> (AlphaChar -> AlphaChar -> Bool) -> Eq AlphaChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlphaChar -> AlphaChar -> Bool
$c/= :: AlphaChar -> AlphaChar -> Bool
== :: AlphaChar -> AlphaChar -> Bool
$c== :: AlphaChar -> AlphaChar -> Bool
Eq, Eq AlphaChar
Eq AlphaChar =>
(AlphaChar -> AlphaChar -> Ordering)
-> (AlphaChar -> AlphaChar -> Bool)
-> (AlphaChar -> AlphaChar -> Bool)
-> (AlphaChar -> AlphaChar -> Bool)
-> (AlphaChar -> AlphaChar -> Bool)
-> (AlphaChar -> AlphaChar -> AlphaChar)
-> (AlphaChar -> AlphaChar -> AlphaChar)
-> Ord AlphaChar
AlphaChar -> AlphaChar -> Bool
AlphaChar -> AlphaChar -> Ordering
AlphaChar -> AlphaChar -> AlphaChar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AlphaChar -> AlphaChar -> AlphaChar
$cmin :: AlphaChar -> AlphaChar -> AlphaChar
max :: AlphaChar -> AlphaChar -> AlphaChar
$cmax :: AlphaChar -> AlphaChar -> AlphaChar
>= :: AlphaChar -> AlphaChar -> Bool
$c>= :: AlphaChar -> AlphaChar -> Bool
> :: AlphaChar -> AlphaChar -> Bool
$c> :: AlphaChar -> AlphaChar -> Bool
<= :: AlphaChar -> AlphaChar -> Bool
$c<= :: AlphaChar -> AlphaChar -> Bool
< :: AlphaChar -> AlphaChar -> Bool
$c< :: AlphaChar -> AlphaChar -> Bool
compare :: AlphaChar -> AlphaChar -> Ordering
$ccompare :: AlphaChar -> AlphaChar -> Ordering
$cp1Ord :: Eq AlphaChar
Ord)

alphaToChar :: AlphaChar -> Char
alphaToChar :: AlphaChar -> Char
alphaToChar (AlphaLower x :: LowerChar
x) = LowerChar -> Char
lowerToChar LowerChar
x
alphaToChar (AlphaUpper x :: UpperChar
x) = UpperChar -> Char
upperToChar UpperChar
x

charToAlpha :: Char -> Maybe AlphaChar
charToAlpha :: Char -> Maybe AlphaChar
charToAlpha x :: Char
x = Parsec Void String AlphaChar -> String -> Maybe AlphaChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String AlphaChar
forall (m :: * -> *). CodeParsing m => m AlphaChar
alphaChar [Char
x]

alphaChar :: CodeParsing m => m AlphaChar
alphaChar :: m AlphaChar
alphaChar =
  LowerChar -> AlphaChar
AlphaLower (LowerChar -> AlphaChar) -> m LowerChar -> m AlphaChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LowerChar
forall (m :: * -> *). CodeParsing m => m LowerChar
lowerChar m AlphaChar -> m AlphaChar -> m AlphaChar
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  UpperChar -> AlphaChar
AlphaUpper (UpperChar -> AlphaChar) -> m UpperChar -> m AlphaChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UpperChar
forall (m :: * -> *). CodeParsing m => m UpperChar
upperChar

-- | Simular to 'lowerCharQ' and 'upperCharQ'.
alphaCharQ :: QuasiQuoter
alphaCharQ :: QuasiQuoter
alphaCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "alphaCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe AlphaChar
charToAlpha Char
x of
      Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not an AlphaChar."
      Just (AlphaLower _) ->
        (Name -> Exp
ConE (String -> Name
mkName "AlphaLower") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
lowerCharQ) [Char
x]
      Just (AlphaUpper _) ->
        (Name -> Exp
ConE (String -> Name
mkName "AlphaUpper") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
upperCharQ) [Char
x]

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "alphaCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs


-- | '[A-Z]'
data UpperChar = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
  deriving (Int -> UpperChar -> ShowS
[UpperChar] -> ShowS
UpperChar -> String
(Int -> UpperChar -> ShowS)
-> (UpperChar -> String)
-> ([UpperChar] -> ShowS)
-> Show UpperChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpperChar] -> ShowS
$cshowList :: [UpperChar] -> ShowS
show :: UpperChar -> String
$cshow :: UpperChar -> String
showsPrec :: Int -> UpperChar -> ShowS
$cshowsPrec :: Int -> UpperChar -> ShowS
Show, UpperChar -> UpperChar -> Bool
(UpperChar -> UpperChar -> Bool)
-> (UpperChar -> UpperChar -> Bool) -> Eq UpperChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpperChar -> UpperChar -> Bool
$c/= :: UpperChar -> UpperChar -> Bool
== :: UpperChar -> UpperChar -> Bool
$c== :: UpperChar -> UpperChar -> Bool
Eq, Eq UpperChar
Eq UpperChar =>
(UpperChar -> UpperChar -> Ordering)
-> (UpperChar -> UpperChar -> Bool)
-> (UpperChar -> UpperChar -> Bool)
-> (UpperChar -> UpperChar -> Bool)
-> (UpperChar -> UpperChar -> Bool)
-> (UpperChar -> UpperChar -> UpperChar)
-> (UpperChar -> UpperChar -> UpperChar)
-> Ord UpperChar
UpperChar -> UpperChar -> Bool
UpperChar -> UpperChar -> Ordering
UpperChar -> UpperChar -> UpperChar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpperChar -> UpperChar -> UpperChar
$cmin :: UpperChar -> UpperChar -> UpperChar
max :: UpperChar -> UpperChar -> UpperChar
$cmax :: UpperChar -> UpperChar -> UpperChar
>= :: UpperChar -> UpperChar -> Bool
$c>= :: UpperChar -> UpperChar -> Bool
> :: UpperChar -> UpperChar -> Bool
$c> :: UpperChar -> UpperChar -> Bool
<= :: UpperChar -> UpperChar -> Bool
$c<= :: UpperChar -> UpperChar -> Bool
< :: UpperChar -> UpperChar -> Bool
$c< :: UpperChar -> UpperChar -> Bool
compare :: UpperChar -> UpperChar -> Ordering
$ccompare :: UpperChar -> UpperChar -> Ordering
$cp1Ord :: Eq UpperChar
Ord)

upperToChar :: UpperChar -> Char
upperToChar :: UpperChar -> Char
upperToChar = Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Char -> Char)
-> (UpperChar -> Maybe Char) -> UpperChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpperChar -> Map UpperChar Char -> Maybe Char)
-> Map UpperChar Char -> UpperChar -> Maybe Char
forall a b c. (a -> b -> c) -> b -> a -> c
flip UpperChar -> Map UpperChar Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map UpperChar Char
uppers

uppers :: Map UpperChar Char
uppers :: Map UpperChar Char
uppers = [(UpperChar, Char)] -> Map UpperChar Char
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (UpperChar
A, 'A'), (UpperChar
B, 'B'), (UpperChar
C, 'C')
  , (UpperChar
D, 'D'), (UpperChar
E, 'E'), (UpperChar
F, 'F')
  , (UpperChar
G, 'G'), (UpperChar
H, 'H'), (UpperChar
I, 'I')
  , (UpperChar
J, 'J'), (UpperChar
K, 'K'), (UpperChar
L, 'L')
  , (UpperChar
M, 'M'), (UpperChar
N, 'N'), (UpperChar
O, 'O')
  , (UpperChar
P, 'P'), (UpperChar
Q, 'Q'), (UpperChar
R, 'R')
  , (UpperChar
S, 'S'), (UpperChar
T, 'T'), (UpperChar
U, 'U')
  , (UpperChar
V, 'V'), (UpperChar
W, 'W'), (UpperChar
X, 'X')
  , (UpperChar
Y, 'Y'), (UpperChar
Z, 'Z')
  ]

upperChar :: CodeParsing m => m UpperChar
upperChar :: m UpperChar
upperChar = do
  Char
char <- m Char
forall e s (m :: * -> *).
(MonadParsec e s m, (Token s :: *) ~ (Char :: *)) =>
m (Token s)
P.upperChar
  let maybeUpper :: Maybe UpperChar
maybeUpper = Char -> Map Char UpperChar -> Maybe UpperChar
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
char (Map Char UpperChar -> Maybe UpperChar)
-> Map Char UpperChar -> Maybe UpperChar
forall a b. (a -> b) -> a -> b
$ Map UpperChar Char -> Map Char UpperChar
forall a k. Ord a => Map k a -> Map a k
dual Map UpperChar Char
uppers
  case Maybe UpperChar
maybeUpper of
    Nothing -> String -> m UpperChar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "non upper char"
    Just x :: UpperChar
x -> UpperChar -> m UpperChar
forall (f :: * -> *) a. Applicative f => a -> f a
pure UpperChar
x

charToUpper :: Char -> Maybe UpperChar
charToUpper :: Char -> Maybe UpperChar
charToUpper x :: Char
x = Parsec Void String UpperChar -> String -> Maybe UpperChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String UpperChar
forall (m :: * -> *). CodeParsing m => m UpperChar
upperChar [Char
x]

-- |
-- Extracts a Char of [A-Z].
-- Also throws compile error if non [A-Z] is passed.
--
-- >>> [upperCharQ|X|]
-- X
--
-- >>> [upperCharQ|Y|]
-- Y
upperCharQ :: QuasiQuoter
upperCharQ :: QuasiQuoter
upperCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "upperCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe UpperChar
charToUpper Char
x of
      Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not an UpperChar."
      Just z :: UpperChar
z -> Name -> Q Exp
conE (Name -> Q Exp) -> (String -> Name) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ UpperChar -> String
forall a. Show a => a -> String
show UpperChar
z

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "upperCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs


-- | '[a-z]'
data LowerChar = A_ | B_ | C_ | D_ | E_ | F_ | G_ | H_ | I_ | J_ | K_ | L_ | M_ | N_ | O_ | P_ | Q_ | R_ | S_ | T_ | U_ | V_ | W_ | X_ | Y_ | Z_
  deriving (Int -> LowerChar -> ShowS
[LowerChar] -> ShowS
LowerChar -> String
(Int -> LowerChar -> ShowS)
-> (LowerChar -> String)
-> ([LowerChar] -> ShowS)
-> Show LowerChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LowerChar] -> ShowS
$cshowList :: [LowerChar] -> ShowS
show :: LowerChar -> String
$cshow :: LowerChar -> String
showsPrec :: Int -> LowerChar -> ShowS
$cshowsPrec :: Int -> LowerChar -> ShowS
Show, LowerChar -> LowerChar -> Bool
(LowerChar -> LowerChar -> Bool)
-> (LowerChar -> LowerChar -> Bool) -> Eq LowerChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LowerChar -> LowerChar -> Bool
$c/= :: LowerChar -> LowerChar -> Bool
== :: LowerChar -> LowerChar -> Bool
$c== :: LowerChar -> LowerChar -> Bool
Eq, Eq LowerChar
Eq LowerChar =>
(LowerChar -> LowerChar -> Ordering)
-> (LowerChar -> LowerChar -> Bool)
-> (LowerChar -> LowerChar -> Bool)
-> (LowerChar -> LowerChar -> Bool)
-> (LowerChar -> LowerChar -> Bool)
-> (LowerChar -> LowerChar -> LowerChar)
-> (LowerChar -> LowerChar -> LowerChar)
-> Ord LowerChar
LowerChar -> LowerChar -> Bool
LowerChar -> LowerChar -> Ordering
LowerChar -> LowerChar -> LowerChar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LowerChar -> LowerChar -> LowerChar
$cmin :: LowerChar -> LowerChar -> LowerChar
max :: LowerChar -> LowerChar -> LowerChar
$cmax :: LowerChar -> LowerChar -> LowerChar
>= :: LowerChar -> LowerChar -> Bool
$c>= :: LowerChar -> LowerChar -> Bool
> :: LowerChar -> LowerChar -> Bool
$c> :: LowerChar -> LowerChar -> Bool
<= :: LowerChar -> LowerChar -> Bool
$c<= :: LowerChar -> LowerChar -> Bool
< :: LowerChar -> LowerChar -> Bool
$c< :: LowerChar -> LowerChar -> Bool
compare :: LowerChar -> LowerChar -> Ordering
$ccompare :: LowerChar -> LowerChar -> Ordering
$cp1Ord :: Eq LowerChar
Ord)

lowerToChar :: LowerChar -> Char
lowerToChar :: LowerChar -> Char
lowerToChar = Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Char -> Char)
-> (LowerChar -> Maybe Char) -> LowerChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LowerChar -> Map LowerChar Char -> Maybe Char)
-> Map LowerChar Char -> LowerChar -> Maybe Char
forall a b c. (a -> b -> c) -> b -> a -> c
flip LowerChar -> Map LowerChar Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map LowerChar Char
lowers

lowers :: Map LowerChar Char
lowers :: Map LowerChar Char
lowers = [(LowerChar, Char)] -> Map LowerChar Char
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (LowerChar
A_, 'a'), (LowerChar
B_, 'b'), (LowerChar
C_, 'c')
  , (LowerChar
D_, 'd'), (LowerChar
E_, 'e'), (LowerChar
F_, 'f')
  , (LowerChar
G_, 'g'), (LowerChar
H_, 'h'), (LowerChar
I_, 'i')
  , (LowerChar
J_, 'j'), (LowerChar
K_, 'k'), (LowerChar
L_, 'l')
  , (LowerChar
M_, 'm'), (LowerChar
N_, 'n'), (LowerChar
O_, 'o')
  , (LowerChar
P_, 'p'), (LowerChar
Q_, 'q'), (LowerChar
R_, 'r')
  , (LowerChar
S_, 's'), (LowerChar
T_, 't'), (LowerChar
U_, 'u')
  , (LowerChar
V_, 'v'), (LowerChar
W_, 'w'), (LowerChar
X_, 'x')
  , (LowerChar
Y_, 'y'), (LowerChar
Z_, 'z')
  ]

lowerChar :: CodeParsing m => m LowerChar
lowerChar :: m LowerChar
lowerChar = do
  Char
char <- m Char
forall e s (m :: * -> *).
(MonadParsec e s m, (Token s :: *) ~ (Char :: *)) =>
m (Token s)
P.lowerChar
  let maybeLower :: Maybe LowerChar
maybeLower = Char -> Map Char LowerChar -> Maybe LowerChar
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
char (Map Char LowerChar -> Maybe LowerChar)
-> Map Char LowerChar -> Maybe LowerChar
forall a b. (a -> b) -> a -> b
$ Map LowerChar Char -> Map Char LowerChar
forall a k. Ord a => Map k a -> Map a k
dual Map LowerChar Char
lowers
  case Maybe LowerChar
maybeLower of
    Nothing -> String -> m LowerChar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "non lower char"
    Just x :: LowerChar
x -> LowerChar -> m LowerChar
forall (f :: * -> *) a. Applicative f => a -> f a
pure LowerChar
x

charToLower :: Char -> Maybe LowerChar
charToLower :: Char -> Maybe LowerChar
charToLower x :: Char
x = Parsec Void String LowerChar -> String -> Maybe LowerChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String LowerChar
forall (m :: * -> *). CodeParsing m => m LowerChar
lowerChar [Char
x]

-- |
-- Extracts a Char of [a-z].
-- Also throws compile error if non [a-z] is passed.
--
-- >>> [lowerCharQ|x|]
-- X_
--
-- >>> [lowerCharQ|y|]
-- Y_
lowerCharQ :: QuasiQuoter
lowerCharQ :: QuasiQuoter
lowerCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "lowerCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe LowerChar
charToLower Char
x of
      Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not a LowerChar."
      Just z :: LowerChar
z -> Name -> Q Exp
conE (Name -> Q Exp) -> (String -> Name) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ LowerChar -> String
forall a. Show a => a -> String
show LowerChar
z

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "lowerCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs


-- | '[0-9]'
data DigitChar = D0
               | D1
               | D2
               | D3
               | D4
               | D5
               | D6
               | D7
               | D8
               | D9
  deriving (Int -> DigitChar -> ShowS
[DigitChar] -> ShowS
DigitChar -> String
(Int -> DigitChar -> ShowS)
-> (DigitChar -> String)
-> ([DigitChar] -> ShowS)
-> Show DigitChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DigitChar] -> ShowS
$cshowList :: [DigitChar] -> ShowS
show :: DigitChar -> String
$cshow :: DigitChar -> String
showsPrec :: Int -> DigitChar -> ShowS
$cshowsPrec :: Int -> DigitChar -> ShowS
Show, DigitChar -> DigitChar -> Bool
(DigitChar -> DigitChar -> Bool)
-> (DigitChar -> DigitChar -> Bool) -> Eq DigitChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DigitChar -> DigitChar -> Bool
$c/= :: DigitChar -> DigitChar -> Bool
== :: DigitChar -> DigitChar -> Bool
$c== :: DigitChar -> DigitChar -> Bool
Eq, Eq DigitChar
Eq DigitChar =>
(DigitChar -> DigitChar -> Ordering)
-> (DigitChar -> DigitChar -> Bool)
-> (DigitChar -> DigitChar -> Bool)
-> (DigitChar -> DigitChar -> Bool)
-> (DigitChar -> DigitChar -> Bool)
-> (DigitChar -> DigitChar -> DigitChar)
-> (DigitChar -> DigitChar -> DigitChar)
-> Ord DigitChar
DigitChar -> DigitChar -> Bool
DigitChar -> DigitChar -> Ordering
DigitChar -> DigitChar -> DigitChar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DigitChar -> DigitChar -> DigitChar
$cmin :: DigitChar -> DigitChar -> DigitChar
max :: DigitChar -> DigitChar -> DigitChar
$cmax :: DigitChar -> DigitChar -> DigitChar
>= :: DigitChar -> DigitChar -> Bool
$c>= :: DigitChar -> DigitChar -> Bool
> :: DigitChar -> DigitChar -> Bool
$c> :: DigitChar -> DigitChar -> Bool
<= :: DigitChar -> DigitChar -> Bool
$c<= :: DigitChar -> DigitChar -> Bool
< :: DigitChar -> DigitChar -> Bool
$c< :: DigitChar -> DigitChar -> Bool
compare :: DigitChar -> DigitChar -> Ordering
$ccompare :: DigitChar -> DigitChar -> Ordering
$cp1Ord :: Eq DigitChar
Ord)

digitToChar :: DigitChar -> Char
digitToChar :: DigitChar -> Char
digitToChar = Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Char -> Char)
-> (DigitChar -> Maybe Char) -> DigitChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DigitChar -> Map DigitChar Char -> Maybe Char)
-> Map DigitChar Char -> DigitChar -> Maybe Char
forall a b c. (a -> b -> c) -> b -> a -> c
flip DigitChar -> Map DigitChar Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map DigitChar Char
digits

digits :: Map DigitChar Char
digits :: Map DigitChar Char
digits = [(DigitChar, Char)] -> Map DigitChar Char
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (DigitChar
D0, '0')
  , (DigitChar
D1, '1'), (DigitChar
D2, '2'), (DigitChar
D3, '3')
  , (DigitChar
D4, '4'), (DigitChar
D5, '5'), (DigitChar
D6, '6')
  , (DigitChar
D4, '7'), (DigitChar
D8, '8'), (DigitChar
D9, '9')
  ]

digitChar :: CodeParsing m => m DigitChar
digitChar :: m DigitChar
digitChar = do
  Char
char <- m Char
forall e s (m :: * -> *).
(MonadParsec e s m, (Token s :: *) ~ (Char :: *)) =>
m (Token s)
P.digitChar
  let maybeNum :: Maybe DigitChar
maybeNum = Char -> Map Char DigitChar -> Maybe DigitChar
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
char (Map Char DigitChar -> Maybe DigitChar)
-> Map Char DigitChar -> Maybe DigitChar
forall a b. (a -> b) -> a -> b
$ Map DigitChar Char -> Map Char DigitChar
forall a k. Ord a => Map k a -> Map a k
dual Map DigitChar Char
digits
  case Maybe DigitChar
maybeNum of
    Nothing -> String -> m DigitChar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "non numeric char"
    Just x :: DigitChar
x -> DigitChar -> m DigitChar
forall (f :: * -> *) a. Applicative f => a -> f a
pure DigitChar
x

charToDigit :: Char -> Maybe DigitChar
charToDigit :: Char -> Maybe DigitChar
charToDigit x :: Char
x = Parsec Void String DigitChar -> String -> Maybe DigitChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String DigitChar
forall (m :: * -> *). CodeParsing m => m DigitChar
digitChar [Char
x]

-- |
-- Extracts a Char of [0-9].
-- Also throws compile error if non [a-z] is passed.
--
-- >>> [digitCharQ|0|]
-- D0
--
-- >>> [digitCharQ|9|]
-- D9
digitCharQ :: QuasiQuoter
digitCharQ :: QuasiQuoter
digitCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "digitCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe DigitChar
charToDigit Char
x of
      Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not a DigitChar."
      Just z :: DigitChar
z -> Name -> Q Exp
conE (Name -> Q Exp) -> (String -> Name) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ DigitChar -> String
forall a. Show a => a -> String
show DigitChar
z

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "digitCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs


-- |
-- '[a-zA-Z0-9_]'
--
-- Please see 'Data.String.Cases.Snake'.
data SnakeChar = SnakeUnderscore -- ^ _
               | SnakeAlphaNum AlphaNumChar -- ^ [a-zA-Z0-9]
  deriving (Int -> SnakeChar -> ShowS
[SnakeChar] -> ShowS
SnakeChar -> String
(Int -> SnakeChar -> ShowS)
-> (SnakeChar -> String)
-> ([SnakeChar] -> ShowS)
-> Show SnakeChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnakeChar] -> ShowS
$cshowList :: [SnakeChar] -> ShowS
show :: SnakeChar -> String
$cshow :: SnakeChar -> String
showsPrec :: Int -> SnakeChar -> ShowS
$cshowsPrec :: Int -> SnakeChar -> ShowS
Show, SnakeChar -> SnakeChar -> Bool
(SnakeChar -> SnakeChar -> Bool)
-> (SnakeChar -> SnakeChar -> Bool) -> Eq SnakeChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnakeChar -> SnakeChar -> Bool
$c/= :: SnakeChar -> SnakeChar -> Bool
== :: SnakeChar -> SnakeChar -> Bool
$c== :: SnakeChar -> SnakeChar -> Bool
Eq)

snakeToChar :: SnakeChar -> Char
snakeToChar :: SnakeChar -> Char
snakeToChar SnakeUnderscore = '_'
snakeToChar (SnakeAlphaNum x :: AlphaNumChar
x) = AlphaNumChar -> Char
alphaNumToChar AlphaNumChar
x

snakeChar :: CodeParsing m => m SnakeChar
snakeChar :: m SnakeChar
snakeChar =
  SnakeChar
SnakeUnderscore SnakeChar -> m Char -> m SnakeChar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String -> m (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, (Token s :: *) ~ (Char :: *)) =>
Token s -> m (Token s)
P.char Token String
'_' m SnakeChar -> m SnakeChar -> m SnakeChar
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  AlphaNumChar -> SnakeChar
SnakeAlphaNum (AlphaNumChar -> SnakeChar) -> m AlphaNumChar -> m SnakeChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m AlphaNumChar
forall (m :: * -> *). CodeParsing m => m AlphaNumChar
alphaNumChar

charToSnake :: Char -> Maybe SnakeChar
charToSnake :: Char -> Maybe SnakeChar
charToSnake x :: Char
x = Parsec Void String SnakeChar -> String -> Maybe SnakeChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String SnakeChar
forall (m :: * -> *). CodeParsing m => m SnakeChar
snakeChar [Char
x]

-- |
-- Extracts a Char of [a-zA-Z0-9_].
-- Also throws compile error if non [a-zA-Z0-9_] is passed.
--
-- >>> [snakeCharQ|x|]
-- SnakeAlphaNum (AlphaNumAlpha (AlphaLower X_))
--
-- >>> [snakeCharQ|X|]
-- SnakeAlphaNum (AlphaNumAlpha (AlphaUpper X))
--
-- >>> [snakeCharQ|_|]
-- SnakeUnderscore
--
-- >>> [snakeCharQ|9|]
-- SnakeAlphaNum (AlphaNumDigit D9)
snakeCharQ :: QuasiQuoter
snakeCharQ :: QuasiQuoter
snakeCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "snakeCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe SnakeChar
charToSnake Char
x of
      Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not a SnakeChar."
      Just SnakeUnderscore ->
        Name -> Q Exp
conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "SnakeUnderscore"
      Just (SnakeAlphaNum _) ->
        (Name -> Exp
ConE (String -> Name
mkName "SnakeAlphaNum") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
alphaNumCharQ) [Char
x]

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "snakeCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs


-- |
-- '[a-zA-Z_]'
--
-- Please see 'Data.String.Cases.Snake'.
data SnakeHeadChar = SnakeHeadUnderscore
                   | SnakeHeadAlpha AlphaChar
  deriving (Int -> SnakeHeadChar -> ShowS
[SnakeHeadChar] -> ShowS
SnakeHeadChar -> String
(Int -> SnakeHeadChar -> ShowS)
-> (SnakeHeadChar -> String)
-> ([SnakeHeadChar] -> ShowS)
-> Show SnakeHeadChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnakeHeadChar] -> ShowS
$cshowList :: [SnakeHeadChar] -> ShowS
show :: SnakeHeadChar -> String
$cshow :: SnakeHeadChar -> String
showsPrec :: Int -> SnakeHeadChar -> ShowS
$cshowsPrec :: Int -> SnakeHeadChar -> ShowS
Show, SnakeHeadChar -> SnakeHeadChar -> Bool
(SnakeHeadChar -> SnakeHeadChar -> Bool)
-> (SnakeHeadChar -> SnakeHeadChar -> Bool) -> Eq SnakeHeadChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnakeHeadChar -> SnakeHeadChar -> Bool
$c/= :: SnakeHeadChar -> SnakeHeadChar -> Bool
== :: SnakeHeadChar -> SnakeHeadChar -> Bool
$c== :: SnakeHeadChar -> SnakeHeadChar -> Bool
Eq)

snakeHeadToChar :: SnakeHeadChar -> Char
snakeHeadToChar :: SnakeHeadChar -> Char
snakeHeadToChar SnakeHeadUnderscore = '_'
snakeHeadToChar (SnakeHeadAlpha x :: AlphaChar
x) = AlphaChar -> Char
alphaToChar AlphaChar
x

snakeHeadChar :: CodeParsing m => m SnakeHeadChar
snakeHeadChar :: m SnakeHeadChar
snakeHeadChar =
  SnakeHeadChar
SnakeHeadUnderscore SnakeHeadChar -> m Char -> m SnakeHeadChar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String -> m (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, (Token s :: *) ~ (Char :: *)) =>
Token s -> m (Token s)
P.char Token String
'_' m SnakeHeadChar -> m SnakeHeadChar -> m SnakeHeadChar
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  AlphaChar -> SnakeHeadChar
SnakeHeadAlpha (AlphaChar -> SnakeHeadChar) -> m AlphaChar -> m SnakeHeadChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m AlphaChar
forall (m :: * -> *). CodeParsing m => m AlphaChar
alphaChar

charToSnakeHead :: Char -> Maybe SnakeHeadChar
charToSnakeHead :: Char -> Maybe SnakeHeadChar
charToSnakeHead x :: Char
x = Parsec Void String SnakeHeadChar -> String -> Maybe SnakeHeadChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String SnakeHeadChar
forall (m :: * -> *). CodeParsing m => m SnakeHeadChar
snakeHeadChar [Char
x]

-- |
-- Extracts a Char of [a-zA-Z_].
-- Also throws compile error if non [a-zA-Z_] is passed.
--
-- >>> [snakeHeadCharQ|x|]
-- SnakeHeadAlpha (AlphaLower X_)
--
-- >>> [snakeHeadCharQ|X|]
-- SnakeHeadAlpha (AlphaUpper X)
--
-- >>> [snakeHeadCharQ|_|]
-- SnakeHeadUnderscore
snakeHeadCharQ :: QuasiQuoter
snakeHeadCharQ :: QuasiQuoter
snakeHeadCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "snakeHeadCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe SnakeHeadChar
charToSnakeHead Char
x of
      Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not a SnakeHeadChar."
      Just SnakeHeadUnderscore ->
        Name -> Q Exp
conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "SnakeHeadUnderscore"
      Just (SnakeHeadAlpha _) ->
        (Name -> Exp
ConE (String -> Name
mkName "SnakeHeadAlpha") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
alphaCharQ) [Char
x]

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "snakeHeadCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs


-- |
-- '[A-Z_]'
--
-- Please sese 'Data.String.Cases.UpperSnake'.
data UpperSnakeHeadChar = UpperSnakeHeadUnderscore -- ^ _
                        | UpperSnakeHeadUpper UpperChar -- ^ [A-Z]
  deriving (Int -> UpperSnakeHeadChar -> ShowS
[UpperSnakeHeadChar] -> ShowS
UpperSnakeHeadChar -> String
(Int -> UpperSnakeHeadChar -> ShowS)
-> (UpperSnakeHeadChar -> String)
-> ([UpperSnakeHeadChar] -> ShowS)
-> Show UpperSnakeHeadChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpperSnakeHeadChar] -> ShowS
$cshowList :: [UpperSnakeHeadChar] -> ShowS
show :: UpperSnakeHeadChar -> String
$cshow :: UpperSnakeHeadChar -> String
showsPrec :: Int -> UpperSnakeHeadChar -> ShowS
$cshowsPrec :: Int -> UpperSnakeHeadChar -> ShowS
Show, UpperSnakeHeadChar -> UpperSnakeHeadChar -> Bool
(UpperSnakeHeadChar -> UpperSnakeHeadChar -> Bool)
-> (UpperSnakeHeadChar -> UpperSnakeHeadChar -> Bool)
-> Eq UpperSnakeHeadChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpperSnakeHeadChar -> UpperSnakeHeadChar -> Bool
$c/= :: UpperSnakeHeadChar -> UpperSnakeHeadChar -> Bool
== :: UpperSnakeHeadChar -> UpperSnakeHeadChar -> Bool
$c== :: UpperSnakeHeadChar -> UpperSnakeHeadChar -> Bool
Eq)

upperSnakeHeadToChar :: UpperSnakeHeadChar -> Char
upperSnakeHeadToChar :: UpperSnakeHeadChar -> Char
upperSnakeHeadToChar UpperSnakeHeadUnderscore = '_'
upperSnakeHeadToChar (UpperSnakeHeadUpper x :: UpperChar
x) = UpperChar -> Char
upperToChar UpperChar
x

upperSnakeHeadChar :: CodeParsing m => m UpperSnakeHeadChar
upperSnakeHeadChar :: m UpperSnakeHeadChar
upperSnakeHeadChar =
  UpperSnakeHeadChar
UpperSnakeHeadUnderscore UpperSnakeHeadChar -> m Char -> m UpperSnakeHeadChar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String -> m (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, (Token s :: *) ~ (Char :: *)) =>
Token s -> m (Token s)
P.char Token String
'_' m UpperSnakeHeadChar
-> m UpperSnakeHeadChar -> m UpperSnakeHeadChar
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  UpperChar -> UpperSnakeHeadChar
UpperSnakeHeadUpper (UpperChar -> UpperSnakeHeadChar)
-> m UpperChar -> m UpperSnakeHeadChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UpperChar
forall (m :: * -> *). CodeParsing m => m UpperChar
upperChar

charToUpperSnakeHead :: Char -> Maybe UpperSnakeHeadChar
charToUpperSnakeHead :: Char -> Maybe UpperSnakeHeadChar
charToUpperSnakeHead x :: Char
x = Parsec Void String UpperSnakeHeadChar
-> String -> Maybe UpperSnakeHeadChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String UpperSnakeHeadChar
forall (m :: * -> *). CodeParsing m => m UpperSnakeHeadChar
upperSnakeHeadChar [Char
x]

-- |
-- >>> [upperSnakeHeadCharQ|_|]
-- UpperSnakeHeadUnderscore
--
-- >>> [upperSnakeHeadCharQ|A|]
-- UpperSnakeHeadUpper A
upperSnakeHeadCharQ :: QuasiQuoter
upperSnakeHeadCharQ :: QuasiQuoter
upperSnakeHeadCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "upperSnakeHeadCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe UpperSnakeHeadChar
charToUpperSnakeHead Char
x of
      Nothing ->
        String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not a UpperSnakeHeadChar."
      Just UpperSnakeHeadUnderscore ->
        Name -> Q Exp
conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "UpperSnakeHeadUnderscore"
      Just (UpperSnakeHeadUpper _) ->
        (Name -> Exp
ConE (String -> Name
mkName "UpperSnakeHeadUpper") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
upperCharQ) [Char
x]

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "upperSnakeHeadCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs


-- |
-- '[A-Z0-9_]'
--
-- Please see 'Data.String.Cases.UpperSnake'.
data UpperSnakeChar = UpperSnakeUnderscore -- ^ _
                    | UpperSnakeUpper UpperChar -- ^ [A-Z]
                    | UpperSnakeDigit DigitChar  -- ^ [0-9]
  deriving (Int -> UpperSnakeChar -> ShowS
[UpperSnakeChar] -> ShowS
UpperSnakeChar -> String
(Int -> UpperSnakeChar -> ShowS)
-> (UpperSnakeChar -> String)
-> ([UpperSnakeChar] -> ShowS)
-> Show UpperSnakeChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpperSnakeChar] -> ShowS
$cshowList :: [UpperSnakeChar] -> ShowS
show :: UpperSnakeChar -> String
$cshow :: UpperSnakeChar -> String
showsPrec :: Int -> UpperSnakeChar -> ShowS
$cshowsPrec :: Int -> UpperSnakeChar -> ShowS
Show, UpperSnakeChar -> UpperSnakeChar -> Bool
(UpperSnakeChar -> UpperSnakeChar -> Bool)
-> (UpperSnakeChar -> UpperSnakeChar -> Bool) -> Eq UpperSnakeChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpperSnakeChar -> UpperSnakeChar -> Bool
$c/= :: UpperSnakeChar -> UpperSnakeChar -> Bool
== :: UpperSnakeChar -> UpperSnakeChar -> Bool
$c== :: UpperSnakeChar -> UpperSnakeChar -> Bool
Eq)

upperSnakeToChar :: UpperSnakeChar -> Char
upperSnakeToChar :: UpperSnakeChar -> Char
upperSnakeToChar UpperSnakeUnderscore = '_'
upperSnakeToChar (UpperSnakeUpper x :: UpperChar
x) = UpperChar -> Char
upperToChar UpperChar
x
upperSnakeToChar (UpperSnakeDigit x :: DigitChar
x) = DigitChar -> Char
digitToChar DigitChar
x

upperSnakeChar :: CodeParsing m => m UpperSnakeChar
upperSnakeChar :: m UpperSnakeChar
upperSnakeChar =
  UpperSnakeChar
UpperSnakeUnderscore UpperSnakeChar -> m Char -> m UpperSnakeChar
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String -> m (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, (Token s :: *) ~ (Char :: *)) =>
Token s -> m (Token s)
P.char Token String
'_' m UpperSnakeChar -> m UpperSnakeChar -> m UpperSnakeChar
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  UpperChar -> UpperSnakeChar
UpperSnakeUpper (UpperChar -> UpperSnakeChar) -> m UpperChar -> m UpperSnakeChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UpperChar
forall (m :: * -> *). CodeParsing m => m UpperChar
upperChar m UpperSnakeChar -> m UpperSnakeChar -> m UpperSnakeChar
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  DigitChar -> UpperSnakeChar
UpperSnakeDigit (DigitChar -> UpperSnakeChar) -> m DigitChar -> m UpperSnakeChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m DigitChar
forall (m :: * -> *). CodeParsing m => m DigitChar
digitChar

charToUpperSnake :: Char -> Maybe UpperSnakeChar
charToUpperSnake :: Char -> Maybe UpperSnakeChar
charToUpperSnake x :: Char
x = Parsec Void String UpperSnakeChar -> String -> Maybe UpperSnakeChar
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe Parsec Void String UpperSnakeChar
forall (m :: * -> *). CodeParsing m => m UpperSnakeChar
upperSnakeChar [Char
x]

-- |
-- >>> [upperSnakeCharQ|_|]
-- UpperSnakeUnderscore
--
-- >>> [upperSnakeCharQ|A|]
-- UpperSnakeUpper A
--
-- >>> [upperSnakeCharQ|0|]
-- UpperSnakeDigit D0
upperSnakeCharQ :: QuasiQuoter
upperSnakeCharQ :: QuasiQuoter
upperSnakeCharQ = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
expQ
  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error "not supported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "not supported"
  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "not supported"
  }
  where
    expQ :: String -> Q Exp
    expQ :: String -> Q Exp
expQ [] = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "upperSnakeCharQ required a Char, but nothign is specified."

    expQ (x :: Char
x : []) = case Char -> Maybe UpperSnakeChar
charToUpperSnake Char
x of
      Nothing ->
        String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " is not a UpperSnakeChar."
      Just UpperSnakeUnderscore ->
        Name -> Q Exp
conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName "UpperSnakeUnderscore"
      Just (UpperSnakeUpper _) ->
        (Name -> Exp
ConE (String -> Name
mkName "UpperSnakeUpper") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
upperCharQ) [Char
x]
      Just (UpperSnakeDigit _) ->
        (Name -> Exp
ConE (String -> Name
mkName "UpperSnakeDigit") Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
digitCharQ) [Char
x]

    expQ xs :: String
xs@(_ : _) = String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ "upperSnakeCharQ required a Char, but a String is specified: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs