<commit_before>module Name(
    NameType(..),
    Name,
    nameName,
    nameType,
    nameValue,
    getModule,
    toUnqualified,
    qualifyName,
    toPlainAtom,
    nameTuple,
    ToName(..),
    fromTypishHsName,
    fromValishHsName,
    parseName,
    isConstructorLike,
    unboxedNameTuple,
    fromUnboxedNameTuple,
    setModule
    ) where

import Data.Generics
import Atom
import HsSyn
import Char
import VConsts
import Binary
import GenUtil
import Doc.DocLike
import Doc.PPrint

data NameType =
    TypeConstructor
    | DataConstructor
    | ClassName
    | TypeVal
    | Val
    | SortName
    | FieldLabel
    | RawType
    deriving(Ord,Eq,Enum,Read,Show,Typeable,Data)


newtype Name = Name Atom
    deriving(Ord,Eq,Typeable,Data,Binary,ToAtom,FromAtom)

isTypeNamespace TypeConstructor = True
isTypeNamespace ClassName = True
isTypeNamespace TypeVal = True
isTypeNamespace _ = False

isValNamespace DataConstructor = True
isValNamespace Val = True
isValNamespace _ = False

isConstructorLike xs@(x:_) =  isUpper x || x `elem` ":("  || xs == "->"
isConstructorLike [] = error "isConstructorLike: empty"

instance ValName Name where
    hsValName (a,b) = toName Val (a,b)
    hsTypName (a,b) = toName TypeVal (a,b)
    hsUnqualTypName b = toName TypeVal b

instance ValName HsName where
    hsValName (a,b) = Qual (Module a) $ HsIdent b
    hsUnqualValName b = UnQual $ HsIdent b




fromTypishHsName, fromValishHsName :: HsName -> Name
fromTypishHsName name
    | isUpper x || x `elem` ":(" = toName TypeConstructor name
    | otherwise = toName TypeVal name
    where x = head (hsIdentString . hsNameIdent  $ name)
fromValishHsName name
    | isUpper x || x `elem` ":(" = toName DataConstructor name
    | otherwise = toName Val name
    where x = head (hsIdentString . hsNameIdent  $ name)

createName _ "" i = error $ "createName: empty module "  ++ i
createName _ m "" = error $ "createName: empty ident "   ++ m
createName t m i = Name $  toAtom $ (chr $ fromEnum t):m ++ "\NUL" ++ i
createUName _ "" = error $ "createUName: empty ident"
createUName t i =  Name $ toAtom $ (chr $ fromEnum t):"\NUL" ++ i

class ToName a where
    toName :: NameType -> a -> Name
    fromName :: Name -> (NameType, a)

instance ToName HsName where
    toName nt n = m where
        i = hsIdentString $ hsNameIdent n
        m | Qual (Module m) _ <- n = createName nt m i
          | otherwise = createUName nt i
    fromName n = (nameType n, nameName n)

instance ToName (String,String) where
    toName nt (m,i) = createName nt m i
    fromName n = (nameType n, mi ) where
        nn = nameName n
        mi  | Qual (Module m) (HsIdent i) <- nn = (m,i)
            | UnQual (HsIdent i) <- nn = ("",i)

instance ToName String where
    toName nt i = createUName nt i
    fromName n = (nameType n, m ++ i ) where
        nn = nameName n
        (m,i)  | Qual (Module m) (HsIdent i) <- nn = (m ++ ".",i)
               | UnQual (HsIdent i) <- nn = ("",i)


getModule :: Monad m => Name -> m Module
getModule n = case nameName n of
    Qual m _ -> return m
    UnQual {} -> fail "Name is unqualified."

toUnqualified :: Name -> Name
toUnqualified n = case fromName n of
    (_,UnQual {}) -> n
    (t,Qual m n) -> toName t (UnQual n)

qualifyName :: Module -> Name -> Name
qualifyName m n = case fromName n of
    (t,UnQual n) -> toName t (Qual m n)
    (_,Qual {}) -> n

setModule :: Module -> Name -> Name
setModule m n = qualifyName m  $ toUnqualified n


parseName :: NameType -> String -> Name
parseName t name = if not (null ms) then toName t (concatInter "." ms, concatInter "." (ns ++ [last sn])) else toName t (concatInter "." (ns ++ [last sn])) where
    sn = (split (== '.') name)
    (ms,ns) = span validMod (init sn)
    validMod (c:cs) = isUpper c && all (\c -> isAlphaNum c || c `elem` "_'") cs
    validMod _ = False




nameType :: Name -> NameType
nameType (Name a) = toEnum (ord (head (toString a)))<commit_msg>fix bug causing name matching to fail<commit_after>module Name(
    NameType(..),
    Name,
    nameName,
    nameType,
    nameValue,
    getModule,
    toUnqualified,
    qualifyName,
    toPlainAtom,
    nameTuple,
    ToName(..),
    fromTypishHsName,
    fromValishHsName,
    parseName,
    isConstructorLike,
    unboxedNameTuple,
    fromUnboxedNameTuple,
    setModule
    ) where

import Data.Generics
import Atom
import HsSyn
import Char
import VConsts
import Binary
import GenUtil
import Doc.DocLike
import Doc.PPrint

data NameType =
    TypeConstructor
    | DataConstructor
    | ClassName
    | TypeVal
    | Val
    | SortName
    | FieldLabel
    | RawType
    deriving(Ord,Eq,Enum,Read,Show,Typeable,Data)


newtype Name = Name Atom
    deriving(Ord,Eq,Typeable,Data,Binary,ToAtom,FromAtom)

isTypeNamespace TypeConstructor = True
isTypeNamespace ClassName = True
isTypeNamespace TypeVal = True
isTypeNamespace _ = False

isValNamespace DataConstructor = True
isValNamespace Val = True
isValNamespace _ = False

isConstructorLike xs@(x:_) =  isUpper x || x `elem` ":("  || xs == "->"
isConstructorLike [] = error "isConstructorLike: empty"

instance ValName Name where
    hsValName (a,b) = toName Val (a,b)
    hsTypName (a,b) = toName TypeVal (a,b)
    hsUnqualTypName b = toName TypeVal b

instance ValName HsName where
    hsValName (a,b) = Qual (Module a) $ HsIdent b
    hsUnqualValName b = UnQual $ HsIdent b




fromTypishHsName, fromValishHsName :: HsName -> Name
fromTypishHsName name
    | isUpper x || x `elem` ":(" = toName TypeConstructor name
    | otherwise = toName TypeVal name
    where x = head (hsIdentString . hsNameIdent  $ name)
fromValishHsName name
    | isUpper x || x `elem` ":(" = toName DataConstructor name
    | otherwise = toName Val name
    where x = head (hsIdentString . hsNameIdent  $ name)

createName _ "" i = error $ "createName: empty module "  ++ i
createName _ m "" = error $ "createName: empty ident "   ++ m
createName t m i = Name $  toAtom $ (chr $ fromEnum t):m ++ "\NUL" ++ i
createUName _ "" = error $ "createUName: empty ident"
createUName t i =  Name $ toAtom $ (chr $ fromEnum t):"\NUL" ++ i

class ToName a where
    toName :: NameType -> a -> Name
    fromName :: Name -> (NameType, a)

instance ToName HsName where
    toName nt n = m where
        i = hsIdentString $ hsNameIdent n
        m | Qual (Module m) _ <- n = createName nt m i
          | otherwise = createUName nt i
    fromName n = (nameType n, nameName n)

instance ToName (String,String) where
    toName nt (m,i) = createName nt m i
    fromName n = (nameType n, mi ) where
        nn = nameName n
        mi  | Qual (Module m) (HsIdent i) <- nn = (m,i)
            | UnQual (HsIdent i) <- nn = ("",i)

instance ToName String where
    toName nt i = createUName nt i
    fromName n = (nameType n, m ++ i ) where
        nn = nameName n
        (m,i)  | Qual (Module m) (HsIdent i) <- nn = (m ++ ".",i)
               | UnQual (HsIdent i) <- nn = ("",i)


getModule :: Monad m => Name -> m Module
getModule n = case nameName n of
    Qual m _ -> return m
    UnQual {} -> fail "Name is unqualified."

toUnqualified :: Name -> Name
toUnqualified n = case fromName n of
    (_,UnQual {}) -> n
    (t,Qual m n) -> toName t (UnQual n)

qualifyName :: Module -> Name -> Name
qualifyName m n = case fromName n of
    (t,UnQual n) -> toName t (Qual m n)
    (_,Qual {}) -> n

setModule :: Module -> Name -> Name
setModule m n = qualifyName m  $ toUnqualified n


parseName :: NameType -> String -> Name
--parseName t name = if not (null ms) then toName t (concatInter "." ms, concatInter "." (ns ++ [last sn])) else toName t (concatInter "." (ns ++ [last sn])) where
parseName t name = toName t (concatInter "." ms, concatInter "." (ns ++ [last sn])) where
    sn = (split (== '.') name)
    (ms,ns) = span validMod (init sn)
    validMod (c:cs) = isUpper c && all (\c -> isAlphaNum c || c `elem` "_'") cs
    validMod _ = False




nameType :: Name -> NameType
nameType (Name a) = toEnum (ord (head (toString a)))
{'fraction_non_alphanumeric': 0.115760461037334, 'fraction_numerical': 0.0, 'mean_word_length': 2.8998534440644845, 'pattern_counts': {'":': 6, '<': 13, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2023113', 'n_tokens_mistral': 2751, 'n_tokens_neox': 2654, 'n_words': 901}