module Language.Haskell.TH.Name.CamelCase (
ConName (ConName, conName), toConName,
VarName (VarName, varName), toVarName,
conCamelcaseName, varCamelcaseName,
toTypeCon, toDataCon,
toVarExp, toVarPat,
) where
import Data.Char (toUpper, toLower, isLetter, isDigit)
import Data.Set (Set, fromList, member)
import Language.Haskell.TH
(Name, mkName, TypeQ, conT, ExpQ, conE, varE, PatQ, varP)
capitalize :: String -> String
capitalize :: [Char] -> [Char]
capitalize (Char
c:[Char]
cs) = Char -> Char
toUpper Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs
capitalize [Char]
"" = [Char]
""
unCapitalize :: String -> String
unCapitalize :: [Char] -> [Char]
unCapitalize (Char
c:[Char]
cs) = Char -> Char
toLower Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs
unCapitalize [Char]
"" = [Char]
""
letterStart :: String -> String
letterStart :: [Char] -> [Char]
letterStart (Char
c:[Char]
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
||
Char -> Bool
isLetter Char
c = Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs
| Bool
otherwise = Char
'_'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs
letterStart [Char]
"" = [Char]
""
allowedChars :: String -> String
allowedChars :: [Char] -> [Char]
allowedChars [Char]
cs = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replaceUnallowed [Char]
cs
where
replaceUnallowed :: Char -> Char
replaceUnallowed Char
c | Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
||
Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
||
Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"_'" = Char
c
| Bool
otherwise = Char
'_'
rename :: String -> String
rename :: [Char] -> [Char]
rename [Char]
cs | [Char]
cs [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set [Char]
reservedIds = [Char]
cs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"
| Bool
otherwise = [Char]
cs
{-# INLINE rename #-}
reservedIds :: Set String
reservedIds :: Set [Char]
reservedIds = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
fromList [ [Char]
"case", [Char]
"class", [Char]
"data", [Char]
"default", [Char]
"deriving"
, [Char]
"do", [Char]
"else", [Char]
"foreign", [Char]
"if", [Char]
"import", [Char]
"in"
, [Char]
"infix", [Char]
"infixl", [Char]
"infixr", [Char]
"instance", [Char]
"let"
, [Char]
"module", [Char]
"newtype", [Char]
"of", [Char]
"then", [Char]
"type", [Char]
"where"
, [Char]
"_" ]
{-# INLINE reservedIds #-}
newtype ConName = ConName { ConName -> Name
conName :: Name }
toConName :: String -> ConName
toConName :: [Char] -> ConName
toConName = Name -> ConName
ConName (Name -> ConName) -> ([Char] -> Name) -> [Char] -> ConName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
mkName ([Char] -> Name) -> ([Char] -> [Char]) -> [Char] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
rename ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
capitalize ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> [Char]
allowedChars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
letterStart
newtype VarName = VarName { VarName -> Name
varName :: Name }
toVarName :: String -> VarName
toVarName :: [Char] -> VarName
toVarName = Name -> VarName
VarName (Name -> VarName) -> ([Char] -> Name) -> [Char] -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
mkName ([Char] -> Name) -> ([Char] -> [Char]) -> [Char] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
rename ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
unCapitalize ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> [Char]
allowedChars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
letterStart
nameChars :: String
nameChars :: [Char]
nameChars = Char
'\'' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char
'0' .. Char
'9'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z']
splitForName :: String -> [String]
splitForName :: [Char] -> [[Char]]
splitForName [Char]
str
| [Char]
rest [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = [Char]
tk [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
splitForName ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
rest)
| Bool
otherwise = [[Char]
tk]
where
([Char]
tk, [Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
nameChars) [Char]
str
camelcaseUpper :: String -> String
camelcaseUpper :: [Char] -> [Char]
camelcaseUpper = ([Char] -> [Char]) -> [[Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Char] -> [Char]
capitalize ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitForName
conCamelcaseName :: String -> ConName
conCamelcaseName :: [Char] -> ConName
conCamelcaseName = [Char] -> ConName
toConName ([Char] -> ConName) -> ([Char] -> [Char]) -> [Char] -> ConName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
camelcaseUpper
varCamelcaseName :: String -> VarName
varCamelcaseName :: [Char] -> VarName
varCamelcaseName = [Char] -> VarName
toVarName ([Char] -> VarName) -> ([Char] -> [Char]) -> [Char] -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
camelcaseUpper
toTypeCon :: ConName -> TypeQ
toTypeCon :: ConName -> TypeQ
toTypeCon = Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> TypeQ) -> (ConName -> Name) -> ConName -> TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConName -> Name
conName
toDataCon :: ConName -> ExpQ
toDataCon :: ConName -> ExpQ
toDataCon = Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
conE (Name -> ExpQ) -> (ConName -> Name) -> ConName -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConName -> Name
conName
toVarExp :: VarName -> ExpQ
toVarExp :: VarName -> ExpQ
toVarExp = Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> ExpQ) -> (VarName -> Name) -> VarName -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> Name
varName
toVarPat :: VarName -> PatQ
toVarPat :: VarName -> PatQ
toVarPat = Name -> PatQ
forall (m :: * -> *). Quote m => Name -> m Pat
varP (Name -> PatQ) -> (VarName -> Name) -> VarName -> PatQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> Name
varName