module Language.Haskell.TH.Name.CamelCase (
ConName (ConName, conName), toConName,
VarName (VarName, varName), toVarName,
conCamelcaseName, varCamelcaseName,
varNameWithPrefix,
toTypeCon, toDataCon,
toVarExp, toVarPat
) where
import Data.Char (toUpper, toLower)
import Data.Set (Set, fromList, member)
import Language.Haskell.TH
(Name, mkName, TypeQ, conT, ExpQ, conE, varE, PatQ, varP)
capitalize :: String -> String
capitalize (c:cs) = toUpper c : cs
capitalize "" = ""
unCapitalize :: String -> String
unCapitalize (c:cs) = toLower c : cs
unCapitalize "" = ""
rename :: String -> String
rename cs | cs `member` reservedIds = cs ++ "_"
| otherwise = cs
reservedIds :: Set String
reservedIds = fromList [ "case", "class", "data", "default", "deriving"
, "do", "else", "foreign", "if", "import", "in"
, "infix", "infixl", "infixr", "instance", "let"
, "module", "newtype", "of", "then", "type", "where"
, "_" ]
newtype ConName = ConName { conName :: Name }
toConName :: String -> ConName
toConName = ConName . mkName . rename . capitalize
newtype VarName = VarName { varName :: Name }
toVarName :: String -> VarName
toVarName = VarName . mkName . rename . unCapitalize
nameChars :: String
nameChars = '\'' : ['0' .. '9'] ++ ['A' .. 'Z'] ++ ['a' .. 'z']
splitForName :: String -> [String]
splitForName str
| rest /= [] = tk : splitForName (tail rest)
| otherwise = [tk]
where
(tk, rest) = span (`elem` nameChars) str
camelcaseUpper :: String -> String
camelcaseUpper = concatMap capitalize . splitForName
conCamelcaseName :: String -> ConName
conCamelcaseName = toConName . camelcaseUpper
varCamelcaseName :: String -> VarName
varCamelcaseName = toVarName . camelcaseUpper
varNameWithPrefix :: String -> String -> VarName
varNameWithPrefix n p = toVarName $ p ++ camelcaseUpper n
toTypeCon :: ConName -> TypeQ
toTypeCon = conT . conName
toDataCon :: ConName -> ExpQ
toDataCon = conE . conName
toVarExp :: VarName -> ExpQ
toVarExp = varE . varName
toVarPat :: VarName -> PatQ
toVarPat = varP . varName