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