{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}

-- | Exposes naming cases.
module Data.String.Cases where

import Cases.Megaparsec
import Data.Char.Cases
import qualified Data.String as String
import Data.Text.Prettyprint.Doc (Pretty(..))
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import qualified Text.Megaparsec as P

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

-- | Non empty PascalCase names "[A-Z][a-zA-Z0-9]*"
data Pascal = Pascal UpperChar [AlphaNumChar]
  deriving (Int -> Pascal -> ShowS
[Pascal] -> ShowS
Pascal -> String
(Int -> Pascal -> ShowS)
-> (Pascal -> String) -> ([Pascal] -> ShowS) -> Show Pascal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pascal] -> ShowS
$cshowList :: [Pascal] -> ShowS
show :: Pascal -> String
$cshow :: Pascal -> String
showsPrec :: Int -> Pascal -> ShowS
$cshowsPrec :: Int -> Pascal -> ShowS
Show, Pascal -> Pascal -> Bool
(Pascal -> Pascal -> Bool)
-> (Pascal -> Pascal -> Bool) -> Eq Pascal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pascal -> Pascal -> Bool
$c/= :: Pascal -> Pascal -> Bool
== :: Pascal -> Pascal -> Bool
$c== :: Pascal -> Pascal -> Bool
Eq)

instance Pretty Pascal where
  pretty :: Pascal -> Doc ann
pretty = String -> Doc ann
forall a. IsString a => String -> a
String.fromString (String -> Doc ann) -> (Pascal -> String) -> Pascal -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pascal -> String
unPascal

unPascal :: Pascal -> String
unPascal :: Pascal -> String
unPascal (Pascal x :: UpperChar
x xs :: [AlphaNumChar]
xs) =
  UpperChar -> Char
upperToChar UpperChar
x Char -> ShowS
forall a. a -> [a] -> [a]
: (AlphaNumChar -> Char) -> [AlphaNumChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map AlphaNumChar -> Char
alphaNumToChar [AlphaNumChar]
xs

parsePascal :: CodeParsing m => m Pascal
parsePascal :: m Pascal
parsePascal =
  UpperChar -> [AlphaNumChar] -> Pascal
Pascal (UpperChar -> [AlphaNumChar] -> Pascal)
-> m UpperChar -> m ([AlphaNumChar] -> Pascal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UpperChar
forall (m :: * -> *). CodeParsing m => m UpperChar
upperChar m ([AlphaNumChar] -> Pascal) -> m [AlphaNumChar] -> m Pascal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m AlphaNumChar -> m [AlphaNumChar]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many m AlphaNumChar
forall (m :: * -> *). CodeParsing m => m AlphaNumChar
alphaNumChar

-- |
-- Simular to 'nonEmptyQ',
-- but naming outsides of 'Pascal' will be rejected.
--
-- >>> [pascalQ|Pascal|]
-- Pascal P [AlphaNumAlpha (AlphaLower A_),AlphaNumAlpha (AlphaLower S_),AlphaNumAlpha (AlphaLower C_),AlphaNumAlpha (AlphaLower A_),AlphaNumAlpha (AlphaLower L_)]
pascalQ :: QuasiQuoter
pascalQ :: QuasiQuoter
pascalQ = 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 "pascalQ required a non empty string, but the empty string is specified."
    expQ (x :: Char
x : xs :: String
xs) = do
      Exp
z <- (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
upperCharQ) [Char
x]
      [Exp]
zs <- (String -> Q Exp) -> [String] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
alphaNumCharQ) ([String] -> Q [Exp]) -> [String] -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
forall a. a -> [a] -> [a]
: []) String
xs
      Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE (String -> Name
mkName "Pascal") Exp -> Exp -> Exp
`AppE` Exp
z Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
zs


-- | Non empty names ".+"
data NonEmpty = NonEmpty Char String
  deriving (Int -> NonEmpty -> ShowS
[NonEmpty] -> ShowS
NonEmpty -> String
(Int -> NonEmpty -> ShowS)
-> (NonEmpty -> String) -> ([NonEmpty] -> ShowS) -> Show NonEmpty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonEmpty] -> ShowS
$cshowList :: [NonEmpty] -> ShowS
show :: NonEmpty -> String
$cshow :: NonEmpty -> String
showsPrec :: Int -> NonEmpty -> ShowS
$cshowsPrec :: Int -> NonEmpty -> ShowS
Show, NonEmpty -> NonEmpty -> Bool
(NonEmpty -> NonEmpty -> Bool)
-> (NonEmpty -> NonEmpty -> Bool) -> Eq NonEmpty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonEmpty -> NonEmpty -> Bool
$c/= :: NonEmpty -> NonEmpty -> Bool
== :: NonEmpty -> NonEmpty -> Bool
$c== :: NonEmpty -> NonEmpty -> Bool
Eq)

instance Pretty NonEmpty where
  pretty :: NonEmpty -> Doc ann
pretty = String -> Doc ann
forall a. IsString a => String -> a
String.fromString (String -> Doc ann) -> (NonEmpty -> String) -> NonEmpty -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty -> String
unNonEmpty

unNonEmpty :: NonEmpty -> String
unNonEmpty :: NonEmpty -> String
unNonEmpty (NonEmpty x :: Char
x xs :: String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

parseNonEmpty :: CodeParsing m => m NonEmpty
parseNonEmpty :: m NonEmpty
parseNonEmpty =
  Char -> String -> NonEmpty
NonEmpty (Char -> String -> NonEmpty) -> m Char -> m (String -> NonEmpty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle m (String -> NonEmpty) -> m String -> m NonEmpty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle

fromString :: String -> Maybe NonEmpty
fromString :: String -> Maybe NonEmpty
fromString "" = Maybe NonEmpty
forall a. Maybe a
Nothing
fromString (x :: Char
x : xs :: String
xs) = NonEmpty -> Maybe NonEmpty
forall a. a -> Maybe a
Just (NonEmpty -> Maybe NonEmpty) -> NonEmpty -> Maybe NonEmpty
forall a b. (a -> b) -> a -> b
$ Char -> String -> NonEmpty
NonEmpty Char
x String
xs

-- |
-- Makes a non empty string from String on the compile time.
-- Also throws compile error if the empty string is passed.
--
-- >>> [nonEmptyQ|x|]
-- NonEmpty 'x' ""
--
-- >>> [nonEmptyQ|foo|]
-- NonEmpty 'f' "oo"
--
-- >>> [nonEmptyQ|Bar|]
-- NonEmpty 'B' "ar"
nonEmptyQ :: QuasiQuoter
nonEmptyQ :: QuasiQuoter
nonEmptyQ = 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 "nonEmptyQ required a non empty string, but the empty string is specified."
    expQ (x :: Char
x : xs :: String
xs) =
      Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE (String -> Name
mkName "NonEmpty")
        Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (Char -> Lit
CharL Char
x)
        Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE ((Char -> Exp) -> String -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Lit -> Exp
LitE (Lit -> Exp) -> (Char -> Lit) -> Char -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Lit
CharL) String
xs)


-- | Non empty camelCase names "[a-zA-Z][a-zA-Z0-9]*"
data Camel = Camel AlphaChar [AlphaNumChar]
  deriving (Int -> Camel -> ShowS
[Camel] -> ShowS
Camel -> String
(Int -> Camel -> ShowS)
-> (Camel -> String) -> ([Camel] -> ShowS) -> Show Camel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Camel] -> ShowS
$cshowList :: [Camel] -> ShowS
show :: Camel -> String
$cshow :: Camel -> String
showsPrec :: Int -> Camel -> ShowS
$cshowsPrec :: Int -> Camel -> ShowS
Show, Camel -> Camel -> Bool
(Camel -> Camel -> Bool) -> (Camel -> Camel -> Bool) -> Eq Camel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Camel -> Camel -> Bool
$c/= :: Camel -> Camel -> Bool
== :: Camel -> Camel -> Bool
$c== :: Camel -> Camel -> Bool
Eq)

instance Pretty Camel where
  pretty :: Camel -> Doc ann
pretty = String -> Doc ann
forall a. IsString a => String -> a
String.fromString (String -> Doc ann) -> (Camel -> String) -> Camel -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Camel -> String
unCamel

unCamel :: Camel -> String
unCamel :: Camel -> String
unCamel (Camel x :: AlphaChar
x xs :: [AlphaNumChar]
xs) = AlphaChar -> Char
alphaToChar AlphaChar
x Char -> ShowS
forall a. a -> [a] -> [a]
: (AlphaNumChar -> Char) -> [AlphaNumChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map AlphaNumChar -> Char
alphaNumToChar [AlphaNumChar]
xs

parseCamel :: CodeParsing m => m Camel
parseCamel :: m Camel
parseCamel =
  AlphaChar -> [AlphaNumChar] -> Camel
Camel (AlphaChar -> [AlphaNumChar] -> Camel)
-> m AlphaChar -> m ([AlphaNumChar] -> Camel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m AlphaChar
forall (m :: * -> *). CodeParsing m => m AlphaChar
alphaChar m ([AlphaNumChar] -> Camel) -> m [AlphaNumChar] -> m Camel
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m AlphaNumChar -> m [AlphaNumChar]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many m AlphaNumChar
forall (m :: * -> *). CodeParsing m => m AlphaNumChar
alphaNumChar

-- |
-- Simular to 'nonEmptyQ',
-- but naming outsides of 'Camel' will be rejected.
--
-- >>> [camelQ|camel|]
-- "camel"
--
-- >>> [camelQ|Pascal|]
-- "Pascal"
camelQ :: QuasiQuoter
camelQ :: QuasiQuoter
camelQ = 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 "camelQ required a non empty string, but the empty string is specified."
    expQ (x :: Char
x : xs :: String
xs) = do
      Exp
z <- (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
alphaCharQ) [Char
x]
      [Exp]
zs <- (String -> Q Exp) -> [String] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
alphaNumCharQ) ([String] -> Q [Exp]) -> [String] -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
forall a. a -> [a] -> [a]
: []) String
xs
      Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE (String -> Name
mkName "Camel") Exp -> Exp -> Exp
`AppE` Exp
z Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
zs


-- | Non empty snake_case names "[a-zA-Z_][a-zA-Z0-9_]*"
data Snake = Snake SnakeHeadChar [SnakeChar]
  deriving (Int -> Snake -> ShowS
[Snake] -> ShowS
Snake -> String
(Int -> Snake -> ShowS)
-> (Snake -> String) -> ([Snake] -> ShowS) -> Show Snake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Snake] -> ShowS
$cshowList :: [Snake] -> ShowS
show :: Snake -> String
$cshow :: Snake -> String
showsPrec :: Int -> Snake -> ShowS
$cshowsPrec :: Int -> Snake -> ShowS
Show, Snake -> Snake -> Bool
(Snake -> Snake -> Bool) -> (Snake -> Snake -> Bool) -> Eq Snake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Snake -> Snake -> Bool
$c/= :: Snake -> Snake -> Bool
== :: Snake -> Snake -> Bool
$c== :: Snake -> Snake -> Bool
Eq)

instance Pretty Snake where
  pretty :: Snake -> Doc ann
pretty = String -> Doc ann
forall a. IsString a => String -> a
String.fromString (String -> Doc ann) -> (Snake -> String) -> Snake -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snake -> String
unSnake

unSnake :: Snake -> String
unSnake :: Snake -> String
unSnake (Snake x :: SnakeHeadChar
x xs :: [SnakeChar]
xs) =
  SnakeHeadChar -> Char
snakeHeadToChar SnakeHeadChar
x Char -> ShowS
forall a. a -> [a] -> [a]
: (SnakeChar -> Char) -> [SnakeChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map SnakeChar -> Char
snakeToChar [SnakeChar]
xs

parseSnake :: CodeParsing m => m Snake
parseSnake :: m Snake
parseSnake =
  SnakeHeadChar -> [SnakeChar] -> Snake
Snake (SnakeHeadChar -> [SnakeChar] -> Snake)
-> m SnakeHeadChar -> m ([SnakeChar] -> Snake)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  m SnakeHeadChar
forall (m :: * -> *). CodeParsing m => m SnakeHeadChar
snakeHeadChar m ([SnakeChar] -> Snake) -> m [SnakeChar] -> m Snake
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  m SnakeChar -> m [SnakeChar]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many m SnakeChar
forall (m :: * -> *). CodeParsing m => m SnakeChar
snakeChar

-- |
-- Simular to 'nonEmptyQ',
-- but naming outsides of 'Data.String.Cases.Snake' will be rejected.
--
-- >>> [snakeQ|foo_bar|]
-- Snake (SnakeHeadAlpha (AlphaLower F_)) [SnakeAlphaNum (AlphaNumAlpha (AlphaLower O_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower O_)),SnakeUnderscore,SnakeAlphaNum (AlphaNumAlpha (AlphaLower B_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower A_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower R_))]
--
-- >>> [snakeQ|__constructor|]
-- Snake SnakeHeadUnderscore [SnakeUnderscore,SnakeAlphaNum (AlphaNumAlpha (AlphaLower C_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower O_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower N_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower S_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower T_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower R_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower U_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower C_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower T_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower O_)),SnakeAlphaNum (AlphaNumAlpha (AlphaLower R_))]
--
-- >>> [snakeQ|FOO_MEE_9|]
-- Snake (SnakeHeadAlpha (AlphaUpper F)) [SnakeAlphaNum (AlphaNumAlpha (AlphaUpper O)),SnakeAlphaNum (AlphaNumAlpha (AlphaUpper O)),SnakeUnderscore,SnakeAlphaNum (AlphaNumAlpha (AlphaUpper M)),SnakeAlphaNum (AlphaNumAlpha (AlphaUpper E)),SnakeAlphaNum (AlphaNumAlpha (AlphaUpper E)),SnakeUnderscore,SnakeAlphaNum (AlphaNumDigit D9)]
snakeQ :: QuasiQuoter
snakeQ :: QuasiQuoter
snakeQ = 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 "snakeQ required a non empty string, but the empty string is specified."
    expQ (x :: Char
x : xs :: String
xs) = do
      Exp
z <- (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
snakeHeadCharQ) [Char
x]
      [Exp]
zs <- (String -> Q Exp) -> [String] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
snakeCharQ) ([String] -> Q [Exp]) -> [String] -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
forall a. a -> [a] -> [a]
: []) String
xs
      Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE (String -> Name
mkName "Snake") Exp -> Exp -> Exp
`AppE` Exp
z Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
zs


-- | A kind of 'Data.String.Cases'. @[A-Z_][A-Z0-9_]*@
data UpperSnake = UpperSnake UpperSnakeHeadChar [UpperSnakeChar]
  deriving (Int -> UpperSnake -> ShowS
[UpperSnake] -> ShowS
UpperSnake -> String
(Int -> UpperSnake -> ShowS)
-> (UpperSnake -> String)
-> ([UpperSnake] -> ShowS)
-> Show UpperSnake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpperSnake] -> ShowS
$cshowList :: [UpperSnake] -> ShowS
show :: UpperSnake -> String
$cshow :: UpperSnake -> String
showsPrec :: Int -> UpperSnake -> ShowS
$cshowsPrec :: Int -> UpperSnake -> ShowS
Show, UpperSnake -> UpperSnake -> Bool
(UpperSnake -> UpperSnake -> Bool)
-> (UpperSnake -> UpperSnake -> Bool) -> Eq UpperSnake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpperSnake -> UpperSnake -> Bool
$c/= :: UpperSnake -> UpperSnake -> Bool
== :: UpperSnake -> UpperSnake -> Bool
$c== :: UpperSnake -> UpperSnake -> Bool
Eq)

instance Pretty UpperSnake where
  pretty :: UpperSnake -> Doc ann
pretty = String -> Doc ann
forall a. IsString a => String -> a
String.fromString (String -> Doc ann)
-> (UpperSnake -> String) -> UpperSnake -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpperSnake -> String
unUpperSnake

unUpperSnake :: UpperSnake -> String
unUpperSnake :: UpperSnake -> String
unUpperSnake (UpperSnake x :: UpperSnakeHeadChar
x xs :: [UpperSnakeChar]
xs) =
  UpperSnakeHeadChar -> Char
upperSnakeHeadToChar UpperSnakeHeadChar
x Char -> ShowS
forall a. a -> [a] -> [a]
: (UpperSnakeChar -> Char) -> [UpperSnakeChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map UpperSnakeChar -> Char
upperSnakeToChar [UpperSnakeChar]
xs

parseUpperSnake :: CodeParsing m => m UpperSnake
parseUpperSnake :: m UpperSnake
parseUpperSnake =
  UpperSnakeHeadChar -> [UpperSnakeChar] -> UpperSnake
UpperSnake (UpperSnakeHeadChar -> [UpperSnakeChar] -> UpperSnake)
-> m UpperSnakeHeadChar -> m ([UpperSnakeChar] -> UpperSnake)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  m UpperSnakeHeadChar
forall (m :: * -> *). CodeParsing m => m UpperSnakeHeadChar
upperSnakeHeadChar m ([UpperSnakeChar] -> UpperSnake)
-> m [UpperSnakeChar] -> m UpperSnake
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  m UpperSnakeChar -> m [UpperSnakeChar]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many m UpperSnakeChar
forall (m :: * -> *). CodeParsing m => m UpperSnakeChar
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
upperSnakeQ = 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 "upperSnakeQ required a non empty string, but the empty string is specified."
    expQ (x :: Char
x : xs :: String
xs) = do
      Exp
z <- (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
upperSnakeHeadCharQ) [Char
x]
      [Exp]
zs <- (String -> Q Exp) -> [String] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
upperSnakeCharQ) ([String] -> Q [Exp]) -> [String] -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
forall a. a -> [a] -> [a]
: []) String
xs
      Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE (String -> Name
mkName "UpperSnake") Exp -> Exp -> Exp
`AppE` Exp
z Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
zs


-- | Non empty "veryflatten" names [a-z]+
data LowerString = LowerString LowerChar [LowerChar]
  deriving (Int -> LowerString -> ShowS
[LowerString] -> ShowS
LowerString -> String
(Int -> LowerString -> ShowS)
-> (LowerString -> String)
-> ([LowerString] -> ShowS)
-> Show LowerString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LowerString] -> ShowS
$cshowList :: [LowerString] -> ShowS
show :: LowerString -> String
$cshow :: LowerString -> String
showsPrec :: Int -> LowerString -> ShowS
$cshowsPrec :: Int -> LowerString -> ShowS
Show, LowerString -> LowerString -> Bool
(LowerString -> LowerString -> Bool)
-> (LowerString -> LowerString -> Bool) -> Eq LowerString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LowerString -> LowerString -> Bool
$c/= :: LowerString -> LowerString -> Bool
== :: LowerString -> LowerString -> Bool
$c== :: LowerString -> LowerString -> Bool
Eq)

instance Pretty LowerString where
  pretty :: LowerString -> Doc ann
pretty (LowerString x :: LowerChar
x xs :: [LowerChar]
xs) = String -> Doc ann
forall a. IsString a => String -> a
String.fromString (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ (LowerChar -> Char) -> [LowerChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map LowerChar -> Char
lowerToChar (LowerChar
x LowerChar -> [LowerChar] -> [LowerChar]
forall a. a -> [a] -> [a]
: [LowerChar]
xs)

unLowerString :: LowerString -> String
unLowerString :: LowerString -> String
unLowerString (LowerString x :: LowerChar
x xs :: [LowerChar]
xs) = LowerChar -> Char
lowerToChar LowerChar
x Char -> ShowS
forall a. a -> [a] -> [a]
: (LowerChar -> Char) -> [LowerChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map LowerChar -> Char
lowerToChar [LowerChar]
xs

parseLowerString :: CodeParsing m => m LowerString
parseLowerString :: m LowerString
parseLowerString = LowerChar -> [LowerChar] -> LowerString
LowerString (LowerChar -> [LowerChar] -> LowerString)
-> m LowerChar -> m ([LowerChar] -> LowerString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LowerChar
forall (m :: * -> *). CodeParsing m => m LowerChar
lowerChar m ([LowerChar] -> LowerString) -> m [LowerChar] -> m LowerString
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m LowerChar -> m [LowerChar]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many m LowerChar
forall (m :: * -> *). CodeParsing m => m LowerChar
lowerChar

-- |
-- Simular to 'nonEmptyQ',
-- but naming outsides of 'LowerString' will be rejected.
--
-- >>> [lowerStringQ|imavimmer|]
-- LowerString I_ [M_,A_,V_,I_,M_,M_,E_,R_]
lowerStringQ :: QuasiQuoter
lowerStringQ :: QuasiQuoter
lowerStringQ = 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 "lowerStringQ required a non empty string, but the empty string is specified."
    expQ (x :: Char
x : xs :: String
xs) = do
      Exp
z <- (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
lowerCharQ) [Char
x]
      [Exp]
zs <- (String -> Q Exp) -> [String] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
lowerCharQ) ([String] -> Q [Exp]) -> [String] -> Q [Exp]
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
forall a. a -> [a] -> [a]
: []) String
xs
      Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE (String -> Name
mkName "LowerString") Exp -> Exp -> Exp
`AppE` Exp
z Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
zs