module Language.Haskell.Tools.Refactor.Utils.Name where
import Data.Char
import Data.List.Split (splitOn)
import GHC hiding (mkModuleName, moduleNameString)
import Name as GHC (NamedThing(..), Name, isSymOcc)
import Language.Haskell.Tools.Refactor.Monad (RefactorMonad(..))
data NameClass = Variable
| Ctor
| ValueOperator
| DataCtorOperator
| SynonymOperator
classifyName :: RefactorMonad m => GHC.Name -> m NameClass
classifyName n = liftGhc (lookupName n) >>= return . \case
Just (AnId {}) | isop -> ValueOperator
Just (AnId {}) -> Variable
Just (AConLike {}) | isop -> DataCtorOperator
Just (AConLike {}) -> Ctor
Just (ATyCon {}) | isop -> SynonymOperator
Just (ATyCon {}) -> Ctor
Just (ACoAxiom {}) -> error "classifyName: ACoAxiom"
Nothing | isop -> ValueOperator
Nothing -> Variable
where isop = GHC.isSymOcc (GHC.getOccName n)
validModuleName :: String -> Maybe String
validModuleName s = foldl mappend mempty $ map (nameValid Ctor) (splitOn "." s)
nameValid :: NameClass -> String -> Maybe String
nameValid _ "" = Just "An empty name is not valid"
nameValid _ str | str `elem` reservedNames = Just $ "'" ++ str ++ "' is a reserved name"
where
reservedNames = [ "case", "class", "data", "default", "deriving", "do", "else", "if", "import", "in", "infix"
, "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_"
, "..", ":", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>", "[]"
]
nameValid DataCtorOperator (':' : nameRest) | all isOperatorChar nameRest = Nothing
nameValid DataCtorOperator _ = Just "A constructor operator must start with ':' and only contain operator characters."
nameValid SynonymOperator name | all isOperatorChar name = Nothing
nameValid SynonymOperator _ = Just "An operator must only contain operator characters."
nameValid ValueOperator (c : nameRest) | isOperatorChar c && c /= ':' && all isOperatorChar nameRest = Nothing
nameValid ValueOperator _ = Just "An operator that is a value must only contain operator characters and cannot start with ':'"
nameValid Ctor (c : nameRest) | isUpper c && isLetter c && all isIdChar nameRest = Nothing
nameValid Ctor _ = Just "A constructor or module name must start with an uppercase letter, and only contain letters, digits, apostrhophe or underscore"
nameValid Variable (c : nameRest) | ((isLower c && isLetter c) || c == '\'' || c == '_') && all isIdChar nameRest = Nothing
nameValid Variable _ = Just "The name of a value must start with lowercase, and only contain letters, digits, apostrhophe or underscore"
isIdChar :: Char -> Bool
isIdChar c = isLetter c || isDigit c || c == '\'' || c == '_'
isOperatorChar :: Char -> Bool
isOperatorChar c = isPunctuation c || isSymbol c