{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Demangler.Accessors
  (
    functionName
  )
where

import           Data.List.NonEmpty ( NonEmpty( (:|) ) )
import qualified Data.List.NonEmpty as NEL
import           Data.Text ( Text )
import qualified Data.Text as T

import           Demangler.Context
import           Demangler.Engine
import           Demangler.Structure


-- | Returns the base function name.  This is the core text name for the function
-- (C-style) followed by the parent class/namespace (innermost-to-outermost) but
-- without any argument and template information and therefore it is not
-- necessarily unique.  The parent names have any template information removed as
-- well. For example:
--
-- @std::map<int, char>::insert(...)@ returns @"insert" :| [ "map", "std" ]@
--
-- The reason for the reversed form is that the base name is usually the most
-- relevant, and the parent information can be optionally consumed (and lazily
-- generated) as needed.
--
-- If the name could not be demangled, the non-demangled form is returned
-- (perhaps it is a plain function name already?).
--
-- If the demangled name is not a function (e.g. a data or special name) then
-- Nothing is returned.

functionName :: Result -> Maybe (NEL.NonEmpty Text)
functionName :: Result -> Maybe (NonEmpty Text)
functionName (Demangled
d,Context
c) =
  case Demangled
d of
    Original Coord
i -> NonEmpty Text -> Maybe (NonEmpty Text)
forall a. a -> Maybe a
Just (NonEmpty Text -> Maybe (NonEmpty Text))
-> NonEmpty Text -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ WithContext () -> Coord -> Text
forall a. WithContext a -> Coord -> Text
contextStr (() -> Context -> WithContext ()
forall a. a -> Context -> WithContext a
addContext () Context
c) Coord
i Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| []
    Encoded Encoding
e -> NonEmpty Text -> NonEmpty Text
resolveCtorDtor (NonEmpty Text -> NonEmpty Text)
-> Maybe (NonEmpty Text) -> Maybe (NonEmpty Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Encoding -> Maybe (NonEmpty Text)
getEnc Encoding
e
    VendorExtended Encoding
e Coord
_ -> Encoding -> Maybe (NonEmpty Text)
getEnc Encoding
e
  where
    resolveCtorDtor :: NonEmpty Text -> NonEmpty Text
resolveCtorDtor = \case
      (Text
"{{CTOR}" :| r :: [Text]
r@(Text
nm : Text
nm2 : [Text]
_)) | Text
"unnamed_type_num" Text -> Text -> Bool
`T.isPrefixOf` Text
nm -> Text
nm2 Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
r
      (Text
"{{DTOR}" :| r :: [Text]
r@(Text
nm : Text
nm2 : [Text]
_)) | Text
"unnamed_type_num" Text -> Text -> Bool
`T.isPrefixOf` Text
nm -> Text
"~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm2 Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
r
      (Text
"{{CTOR}" :| r :: [Text]
r@(Text
nm : [Text]
_)) -> Text
nm Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
r
      (Text
"{{DTOR}" :| r :: [Text]
r@(Text
nm : [Text]
_)) -> Text
"~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
r
      NonEmpty Text
o -> NonEmpty Text
o
    getEnc :: Encoding -> Maybe (NonEmpty Text)
getEnc = \case
      EncFunc (FunctionName Name
fn) Maybe Type_
_rty NonEmpty Type_
_argtys -> Name -> Maybe (NonEmpty Text)
getName Name
fn
      EncStaticFunc (FunctionName Name
fn) Maybe Type_
_rty NonEmpty Type_
_argtys -> Name -> Maybe (NonEmpty Text)
getName Name
fn
      EncData (LocalName Encoding
enc Name
_ Maybe Discriminator
_) -> Encoding -> Maybe (NonEmpty Text)
getEnc Encoding
enc
      Encoding
_ -> Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
    getName :: Name -> Maybe (NonEmpty Text)
getName = \case
      UnscopedName UnscopedName
usn -> UnscopedName -> Maybe (NonEmpty Text)
getUSN UnscopedName
usn
      UnscopedTemplateName Name
nm TemplateArgs
_tmplArgs -> Name -> Maybe (NonEmpty Text)
getName Name
nm
      NameNested NestedName
nnm -> NestedName -> Maybe (NonEmpty Text)
getNestedNm NestedName
nnm
      Name
nm -> NonEmpty Text -> Maybe (NonEmpty Text)
forall a. a -> Maybe a
Just (NonEmpty Text -> Maybe (NonEmpty Text))
-> NonEmpty Text -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack ( Name -> String
forall a. Show a => a -> String
show Name
nm ) Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| []
    getUSN :: UnscopedName -> Maybe (NonEmpty Text)
getUSN = \case
      UnScName Bool
False UnqualifiedName
uqn -> NonEmpty Text -> Maybe (NonEmpty Text)
forall a. a -> Maybe a
Just (NonEmpty Text -> Maybe (NonEmpty Text))
-> NonEmpty Text -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ [Text] -> NonEmpty Text
forall a. HasCallStack => [a] -> NonEmpty a
NEL.fromList ([Text] -> NonEmpty Text) -> [Text] -> NonEmpty Text
forall a b. (a -> b) -> a -> b
$ UnqualifiedName -> [Text]
getUQN UnqualifiedName
uqn
      UnScName Bool
True UnqualifiedName
uqn -> NonEmpty Text -> Maybe (NonEmpty Text)
forall a. a -> Maybe a
Just (NonEmpty Text -> Maybe (NonEmpty Text))
-> NonEmpty Text -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ [Text] -> NonEmpty Text
forall a. HasCallStack => [a] -> NonEmpty a
NEL.fromList ([Text] -> NonEmpty Text) -> [Text] -> NonEmpty Text
forall a b. (a -> b) -> a -> b
$ UnqualifiedName -> [Text]
getUQN UnqualifiedName
uqn [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"std"]
      UnScSubst Substitution
subs -> NonEmpty Text -> Maybe (NonEmpty Text)
forall a. a -> Maybe a
Just (NonEmpty Text -> Maybe (NonEmpty Text))
-> NonEmpty Text -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ [Text] -> NonEmpty Text
forall a. HasCallStack => [a] -> NonEmpty a
NEL.fromList ([Text] -> NonEmpty Text) -> [Text] -> NonEmpty Text
forall a b. (a -> b) -> a -> b
$ Substitution -> [Text]
getStdSubst Substitution
subs
    getUQN :: UnqualifiedName -> [Text]
getUQN = \case
      SourceName (SrcName Coord
i) [ABI_Tag]
_ -> [WithContext () -> Coord -> Text
forall a. WithContext a -> Coord -> Text
contextStr (() -> Context -> WithContext ()
forall a. a -> Context -> WithContext a
addContext () Context
c) Coord
i]
      OperatorName Operator
op [ABI_Tag]
_ ->
        [Text
-> ((Arity, (Text, Text)) -> Text)
-> Maybe (Arity, (Text, Text))
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Operator -> String
forall a. Show a => a -> String
show Operator
op) ((Text
"operator" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> ((Arity, (Text, Text)) -> Text) -> (Arity, (Text, Text)) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text)
-> ((Arity, (Text, Text)) -> (Text, Text))
-> (Arity, (Text, Text))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arity, (Text, Text)) -> (Text, Text)
forall a b. (a, b) -> b
snd)
         (Maybe (Arity, (Text, Text)) -> Text)
-> Maybe (Arity, (Text, Text)) -> Text
forall a b. (a -> b) -> a -> b
$ Operator
-> [(Operator, (Arity, (Text, Text)))]
-> Maybe (Arity, (Text, Text))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Operator
op [(Operator, (Arity, (Text, Text)))]
opTable]
      CtorDtorName CtorDtor
ctd -> case CtorDtor
ctd of
                            CtorDtor
CompleteCtor -> [Text
"{{CTOR}"]
                            CtorDtor
BaseCtor -> [Text
"{{CTOR}"]
                            CtorDtor
CompleteAllocatingCtor -> [Text
"{{CTOR}"]
                            CompleteInheritingCtor Type_
_ -> [Text
"{{CTOR}"]
                            BaseInheritingCtor Type_
_ -> [Text
"{{CTOR}"]
                            CtorDtor
DeletingDtor -> [Text
"{{DTOR}"]
                            CtorDtor
CompleteDtor -> [Text
"{{DTOR}"]
                            CtorDtor
BaseDtor -> [Text
"{{DTOR}"]
      StdSubst Substitution
sbst -> Substitution -> [Text]
getStdSubst Substitution
sbst
      ModuleNamed [ModuleName]
_ UnqualifiedName
uqn -> UnqualifiedName -> [Text]
getUQN UnqualifiedName
uqn
      UnnamedTypeName Maybe Natural
mbnum ->
        -- Highly unusual, and probably not ultimately useful.  This happens when
        -- an unnamed structure/union/class has a function.  For example,
        -- "_ZN3FooUt3_C2Ev" translates to "Foo::{unnamed type#5}::Foo()".
        let n :: Natural
n = Natural -> (Natural -> Natural) -> Maybe Natural -> Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Natural
1 (Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+Natural
2) Maybe Natural
mbnum in [ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"unnamed_type_num" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall a. Show a => a -> String
show Natural
n ]
    getStdSubst :: Substitution -> [Text]
getStdSubst = \case
      Substitution
SubStd -> [Text
"std"]
      Substitution
SubAlloc -> [ Text
"allocator", Text
"std" ]
      Substitution
SubBasicString -> [ Text
"basic_string", Text
"std" ]
      SubStdType StdType
BasicStringChar -> [ Text
"string", Text
"std" ]
      SubStdType StdType
BasicIStream -> [ Text
"istream", Text
"std" ]
      SubStdType StdType
BasicOStream -> [ Text
"ostream", Text
"std" ]
      SubStdType StdType
BasicIOStream -> [ Text
"iostream", Text
"std" ]
    getNestedNm :: NestedName -> Maybe (NonEmpty Text)
getNestedNm = \case
      NestedName Prefix
pfx UnqualifiedName
uqn [CVQualifier]
_ Maybe RefQualifier
_ -> [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([Text] -> Maybe (NonEmpty Text))
-> [Text] -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ UnqualifiedName -> [Text]
getUQN UnqualifiedName
uqn [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Prefix -> [Text]
getPfx Prefix
pfx
      NestedTemplateName TemplatePrefix
tmplpfx TemplateArgs
_tmplArgs [CVQualifier]
_ Maybe RefQualifier
_ -> [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([Text] -> Maybe (NonEmpty Text))
-> [Text] -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ TemplatePrefix -> [Text]
getTmplPfx TemplatePrefix
tmplpfx
    getPfx :: Prefix -> [Text]
getPfx = \case
      PrefixTemplateParam TemplateParam
_tmplParam PrefixR
r -> PrefixR -> [Text]
getPfxR PrefixR
r
      PrefixDeclType DeclType
_dclTy PrefixR
r -> PrefixR -> [Text]
getPfxR PrefixR
r
      PrefixClosure ()
_ -> []
      Prefix PrefixR
r -> PrefixR -> [Text]
getPfxR PrefixR
r
    getPfxR :: PrefixR -> [Text]
getPfxR = \case
      PrefixUQName UnqualifiedName
uqn PrefixR
r -> PrefixR -> [Text]
getPfxR PrefixR
r [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> UnqualifiedName -> [Text]
getUQN UnqualifiedName
uqn
      PrefixTemplateArgs TemplateArgs
_ PrefixR
r -> PrefixR -> [Text]
getPfxR PrefixR
r
      PrefixR
PrefixEnd -> []
    getTmplPfx :: TemplatePrefix -> [Text]
getTmplPfx = \case
      GlobalTemplate NonEmpty UnqualifiedName
uqns -> (UnqualifiedName -> [Text] -> [Text])
-> [Text] -> NonEmpty UnqualifiedName -> [Text]
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>) ([Text] -> [Text] -> [Text])
-> (UnqualifiedName -> [Text])
-> UnqualifiedName
-> [Text]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualifiedName -> [Text]
getUQN) [] NonEmpty UnqualifiedName
uqns
      NestedTemplate Prefix
pfx NonEmpty UnqualifiedName
uqns -> (UnqualifiedName -> [Text] -> [Text])
-> [Text] -> NonEmpty UnqualifiedName -> [Text]
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>) ([Text] -> [Text] -> [Text])
-> (UnqualifiedName -> [Text])
-> UnqualifiedName
-> [Text]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualifiedName -> [Text]
getUQN) (Prefix -> [Text]
getPfx Prefix
pfx) NonEmpty UnqualifiedName
uqns
      TemplateTemplateParam TemplateParam
_ -> []