diff --git a/character-cases.cabal b/character-cases.cabal
--- a/character-cases.cabal
+++ b/character-cases.cabal
@@ -4,10 +4,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: df032fa0e13ccb8e3d8c1eaa637877af7b521ac787ffa94e2f3d91d64acbfb2d
+-- hash: 9ae64163844840cb8871abca02785f7de8a0e19cf7b1793390a33b068ae1a73e
 
 name:           character-cases
-version:        0.1.0.4
+version:        0.1.0.5
 synopsis:       Exposes subspecies types of Char. And naming cases.
 description:    e.g. meaning of [a-z], [A-Z], [0-9], PascalCase, camelCase, and snake_case. Please see https://github.com/aiya000/hs-character-cases#README.md
 category:       Simple
diff --git a/src/Data/Char/Cases.hs b/src/Data/Char/Cases.hs
--- a/src/Data/Char/Cases.hs
+++ b/src/Data/Char/Cases.hs
@@ -2,8 +2,54 @@
 
 -- |
 -- Exposes subspecies types of Char.
--- e.g. [a-z], [A-Z], and [0-9].
-module Data.Char.Cases where
+-- 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
@@ -25,6 +71,7 @@
   Map.fromList $ map swap x
 
 
+-- | '[A-Za-z0-9]'
 data AlphaNumChar = AlphaNumAlpha AlphaChar
                   | AlphaNumDigit DigitChar
   deriving (Show, Eq, Ord)
@@ -73,6 +120,7 @@
     expQ xs@(_ : _) = fail [i|alphaNumCharQ required a Char, but a String is specified: ${xs}|]
 
 
+-- | '[A-Za-z]'
 data AlphaChar = AlphaLower LowerChar
                | AlphaUpper UpperChar
   deriving (Show, Eq, Ord)
@@ -111,6 +159,7 @@
     expQ xs@(_ : _) = fail [i|alphaCharQ required a Char, but a String is specified: ${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 (Show, Eq, Ord)
 
@@ -168,6 +217,7 @@
     expQ xs@(_ : _) = fail [i|upperCharQ required a Char, but a String is specified: ${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 (Show, Eq, Ord)
 
@@ -225,7 +275,7 @@
     expQ xs@(_ : _) = fail [i|lowerCharQ required a Char, but a String is specified: ${xs}|]
 
 
--- | [0-9]
+-- | '[0-9]'
 data DigitChar = D0
                | D1
                | D2
@@ -288,16 +338,16 @@
 
 
 -- |
--- [a-zA-Z0-9_]
+-- '[a-zA-Z0-9_]'
 --
 -- Please see 'Snake'.
 data SnakeChar = SnakeUnderscore -- ^ _
                | SnakeAlphaNum AlphaNumChar -- ^ [a-zA-Z0-9]
   deriving (Show, Eq)
 
-unSnakeChar :: SnakeChar -> Char
-unSnakeChar SnakeUnderscore = '_'
-unSnakeChar (SnakeAlphaNum x) = alphaNumToChar x
+snakeToChar :: SnakeChar -> Char
+snakeToChar SnakeUnderscore = '_'
+snakeToChar (SnakeAlphaNum x) = alphaNumToChar x
 
 snakeChar :: CodeParsing m => m SnakeChar
 snakeChar =
@@ -344,16 +394,16 @@
 
 
 -- |
--- [a-zA-Z_]
+-- '[a-zA-Z_]'
 --
 -- Please see 'Snake'.
 data SnakeHeadChar = SnakeHeadUnderscore
                    | SnakeHeadAlpha AlphaChar
   deriving (Show, Eq)
 
-unSnakeHeadChar :: SnakeHeadChar -> Char
-unSnakeHeadChar SnakeHeadUnderscore = '_'
-unSnakeHeadChar (SnakeHeadAlpha x) = alphaToChar x
+snakeHeadToChar :: SnakeHeadChar -> Char
+snakeHeadToChar SnakeHeadUnderscore = '_'
+snakeHeadToChar (SnakeHeadAlpha x) = alphaToChar x
 
 snakeHeadChar :: CodeParsing m => m SnakeHeadChar
 snakeHeadChar =
@@ -394,3 +444,107 @@
         (ConE (mkName "SnakeHeadAlpha") `AppE`) <$> (quoteExp alphaCharQ) [x]
 
     expQ xs@(_ : _) = fail [i|snakeHeadCharQ required a Char, but a String is specified: ${xs}|]
+
+
+-- |
+-- '[A-Z_]'
+--
+-- Please sese 'UpperSnake'.
+data UpperSnakeHeadChar = UpperSnakeHeadUnderscore -- ^ _
+                        | UpperSnakeHeadUpper UpperChar -- ^ [A-Z]
+  deriving (Show, Eq)
+
+upperSnakeHeadToChar :: UpperSnakeHeadChar -> Char
+upperSnakeHeadToChar UpperSnakeHeadUnderscore = '_'
+upperSnakeHeadToChar (UpperSnakeHeadUpper x) = upperToChar x
+
+upperSnakeHeadChar :: CodeParsing m => m UpperSnakeHeadChar
+upperSnakeHeadChar =
+  UpperSnakeHeadUnderscore <$ P.char '_' <|>
+  UpperSnakeHeadUpper <$> upperChar
+
+charToUpperSnakeHead :: Char -> Maybe UpperSnakeHeadChar
+charToUpperSnakeHead x = P.parseMaybe upperSnakeHeadChar [x]
+
+-- |
+-- >>> [upperSnakeHeadCharQ|_|]
+-- UpperSnakeHeadUnderscore
+--
+-- >>> [upperSnakeHeadCharQ|A|]
+-- UpperSnakeHeadUpper A
+upperSnakeHeadCharQ :: QuasiQuoter
+upperSnakeHeadCharQ = QuasiQuoter
+  { quoteExp  = expQ
+  , quotePat  = error "not supported"
+  , quoteType = error "not supported"
+  , quoteDec  = error "not supported"
+  }
+  where
+    expQ :: String -> Q Exp
+    expQ [] = fail "upperSnakeHeadCharQ required a Char, but nothign is specified."
+
+    expQ (x : []) = case charToUpperSnakeHead x of
+      Nothing ->
+        fail [i|'${x}' is not a UpperSnakeHeadChar.|]
+      Just UpperSnakeHeadUnderscore ->
+        conE $ mkName "UpperSnakeHeadUnderscore"
+      Just (UpperSnakeHeadUpper _) ->
+        (ConE (mkName "UpperSnakeHeadUpper") `AppE`) <$> (quoteExp upperCharQ) [x]
+
+    expQ xs@(_ : _) = fail [i|upperSnakeHeadCharQ required a Char, but a String is specified: ${xs}|]
+
+
+-- |
+-- '[A-Z0-9_]'
+--
+-- Please see 'Snake'.
+data UpperSnakeChar = UpperSnakeUnderscore -- ^ _
+                    | UpperSnakeUpper UpperChar -- ^ [A-Z]
+                    | UpperSnakeDigit DigitChar  -- ^ [0-9]
+  deriving (Show, Eq)
+
+upperSnakeToChar :: UpperSnakeChar -> Char
+upperSnakeToChar UpperSnakeUnderscore = '_'
+upperSnakeToChar (UpperSnakeUpper x) = upperToChar x
+upperSnakeToChar (UpperSnakeDigit x) = digitToChar x
+
+upperSnakeChar :: CodeParsing m => m UpperSnakeChar
+upperSnakeChar =
+  UpperSnakeUnderscore <$ P.char '_' <|>
+  UpperSnakeUpper <$> upperChar <|>
+  UpperSnakeDigit <$> digitChar
+
+charToUpperSnake :: Char -> Maybe UpperSnakeChar
+charToUpperSnake x = P.parseMaybe upperSnakeChar [x]
+
+-- |
+-- >>> [upperSnakeCharQ|_|]
+-- UpperSnakeUnderscore
+--
+-- >>> [upperSnakeCharQ|A|]
+-- UpperSnakeUpper A
+--
+-- >>> [upperSnakeCharQ|0|]
+-- UpperSnakeDigit D0
+upperSnakeCharQ :: QuasiQuoter
+upperSnakeCharQ = QuasiQuoter
+  { quoteExp  = expQ
+  , quotePat  = error "not supported"
+  , quoteType = error "not supported"
+  , quoteDec  = error "not supported"
+  }
+  where
+    expQ :: String -> Q Exp
+    expQ [] = fail "upperSnakeCharQ required a Char, but nothign is specified."
+
+    expQ (x : []) = case charToUpperSnake x of
+      Nothing ->
+        fail [i|'${x}' is not a UpperSnakeChar.|]
+      Just UpperSnakeUnderscore ->
+        conE $ mkName "UpperSnakeUnderscore"
+      Just (UpperSnakeUpper _) ->
+        (ConE (mkName "UpperSnakeUpper") `AppE`) <$> (quoteExp upperCharQ) [x]
+      Just (UpperSnakeDigit _) ->
+        (ConE (mkName "UpperSnakeDigit") `AppE`) <$> (quoteExp digitCharQ) [x]
+
+    expQ xs@(_ : _) = fail [i|upperSnakeCharQ required a Char, but a String is specified: ${xs}|]
diff --git a/src/Data/String/Cases.hs b/src/Data/String/Cases.hs
--- a/src/Data/String/Cases.hs
+++ b/src/Data/String/Cases.hs
@@ -101,13 +101,7 @@
 
 -- | Non empty camelCase names "[a-zA-Z][a-zA-Z0-9]*"
 data Camel = Camel AlphaChar [AlphaNumChar]
-  deriving (Eq)
-
--- To easy to debug.
---
--- To strictly check, remove this instance and use `deriving (Show)`.
-instance Show Camel where
-  show (Camel x xs) = '"' : alphaToChar x : map alphaNumToChar xs <> "\""
+  deriving (Show, Eq)
 
 instance Pretty Camel where
   pretty = String.fromString . unCamel
@@ -153,7 +147,7 @@
 
 unSnake :: Snake -> String
 unSnake (Snake x xs) =
-  unSnakeHeadChar x : map unSnakeChar xs
+  snakeHeadToChar x : map snakeToChar xs
 
 parseSnake :: CodeParsing m => m Snake
 parseSnake =
@@ -187,6 +181,51 @@
       z <- (quoteExp snakeHeadCharQ) [x]
       zs <- mapM (quoteExp snakeCharQ) $ map (: []) xs
       pure $ ConE (mkName "Snake") `AppE` z `AppE` ListE zs
+
+
+-- | A kind of Snake. "[A-Z_][A-Z0-9_]*"
+data UpperSnake = UpperSnake UpperSnakeHeadChar [UpperSnakeChar]
+  deriving (Show, Eq)
+
+instance Pretty UpperSnake where
+  pretty = String.fromString . unUpperSnake
+
+unUpperSnake :: UpperSnake -> String
+unUpperSnake (UpperSnake x xs) =
+  upperSnakeHeadToChar x : map upperSnakeToChar xs
+
+parseUpperSnake :: CodeParsing m => m UpperSnake
+parseUpperSnake =
+  UpperSnake <$>
+  upperSnakeHeadChar <*>
+  P.many upperSnakeChar
+
+-- |
+-- >>> [upperSnakeQ|FOO_BAR|]
+-- UpperSnake (UpperSnakeHeadUpper F) [UpperSnakeUpper O,UpperSnakeUpper O,UpperSnakeUnderscore,UpperSnakeUpper B,UpperSnakeUpper A,UpperSnakeUpper R]
+--
+-- >>> [upperSnakeQ|__CONSTRUCTOR|]
+-- UpperSnake UpperSnakeHeadUnderscore [UpperSnakeUnderscore,UpperSnakeUpper C,UpperSnakeUpper O,UpperSnakeUpper N,UpperSnakeUpper S,UpperSnakeUpper T,UpperSnakeUpper R,UpperSnakeUpper U,UpperSnakeUpper C,UpperSnakeUpper T,UpperSnakeUpper O,UpperSnakeUpper R]
+--
+-- >>> [upperSnakeQ|__FOO_MEE_9|]
+-- UpperSnake UpperSnakeHeadUnderscore [UpperSnakeUnderscore,UpperSnakeUpper F,UpperSnakeUpper O,UpperSnakeUpper O,UpperSnakeUnderscore,UpperSnakeUpper M,UpperSnakeUpper E,UpperSnakeUpper E,UpperSnakeUnderscore,UpperSnakeDigit D9]
+--
+-- >>> [upperSnakeQ|FOO_MEE_9|]
+-- UpperSnake (UpperSnakeHeadUpper F) [UpperSnakeUpper O,UpperSnakeUpper O,UpperSnakeUnderscore,UpperSnakeUpper M,UpperSnakeUpper E,UpperSnakeUpper E,UpperSnakeUnderscore,UpperSnakeDigit D9]
+upperSnakeQ :: QuasiQuoter
+upperSnakeQ = QuasiQuoter
+  { quoteExp  = expQ
+  , quotePat  = error "not supported"
+  , quoteType = error "not supported"
+  , quoteDec  = error "not supported"
+  }
+  where
+    expQ :: String -> Q Exp
+    expQ [] = fail "upperSnakeQ required a non empty string, but the empty string is specified."
+    expQ (x : xs) = do
+      z <- (quoteExp upperSnakeHeadCharQ) [x]
+      zs <- mapM (quoteExp upperSnakeCharQ) $ map (: []) xs
+      pure $ ConE (mkName "UpperSnake") `AppE` z `AppE` ListE zs
 
 
 -- | Non empty "veryflatten" names [a-z]+
