-- | Extras for haskell-src-exts names.

module Fay.Compiler.QName where

import           Language.Haskell.Exts

-- | Extract the module name from a qualified name.
qModName :: QName a -> Maybe (ModuleName a)
qModName :: QName a -> Maybe (ModuleName a)
qModName (Qual a
_ ModuleName a
m Name a
_) = ModuleName a -> Maybe (ModuleName a)
forall a. a -> Maybe a
Just ModuleName a
m
qModName QName a
_          = Maybe (ModuleName a)
forall a. Maybe a
Nothing

-- | Extract the name from a QName.
unQual :: QName a -> Name a
unQual :: QName a -> Name a
unQual (Qual a
_ ModuleName a
_ Name a
n) = Name a
n
unQual (UnQual a
_ Name a
n) = Name a
n
unQual Special{} = [Char] -> Name a
forall a. HasCallStack => [Char] -> a
error [Char]
"unQual Special{}"

unQualify :: QName a -> QName a
unQualify :: QName a -> QName a
unQualify (Qual a
a ModuleName a
_ Name a
n) = a -> Name a -> QName a
forall l. l -> Name l -> QName l
UnQual a
a Name a
n
unQualify u :: QName a
u@UnQual{} = QName a
u
unQualify Special{}  = [Char] -> QName a
forall a. HasCallStack => [Char] -> a
error [Char]
"unQualify: Special{}"

-- | Change or add the ModuleName of a QName.
changeModule :: ModuleName a -> QName a -> QName a
changeModule :: ModuleName a -> QName a -> QName a
changeModule ModuleName a
m (Qual a
a ModuleName a
_ Name a
n) = a -> ModuleName a -> Name a -> QName a
forall l. l -> ModuleName l -> Name l -> QName l
Qual a
a ModuleName a
m Name a
n
changeModule ModuleName a
m (UnQual a
a Name a
n) = a -> ModuleName a -> Name a -> QName a
forall l. l -> ModuleName l -> Name l -> QName l
Qual a
a ModuleName a
m Name a
n
changeModule ModuleName a
_ Special{}  = [Char] -> QName a
forall a. HasCallStack => [Char] -> a
error [Char]
"changeModule Special{}"

changeModule' :: (String -> String) -> QName a -> QName a
changeModule' :: ([Char] -> [Char]) -> QName a -> QName a
changeModule' [Char] -> [Char]
f (Qual a
l (ModuleName a
ml [Char]
mn) Name a
n) = a -> ModuleName a -> Name a -> QName a
forall l. l -> ModuleName l -> Name l -> QName l
Qual a
l (a -> [Char] -> ModuleName a
forall l. l -> [Char] -> ModuleName l
ModuleName a
ml ([Char] -> ModuleName a) -> [Char] -> ModuleName a
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
f [Char]
mn) Name a
n
changeModule' [Char] -> [Char]
_ QName a
x = QName a
x

withIdent :: (String -> String) -> QName a -> QName a
withIdent :: ([Char] -> [Char]) -> QName a -> QName a
withIdent [Char] -> [Char]
f QName a
q = case QName a
q of
  Qual a
l ModuleName a
m Name a
n -> a -> ModuleName a -> Name a -> QName a
forall l. l -> ModuleName l -> Name l -> QName l
Qual a
l ModuleName a
m (Name a -> QName a) -> Name a -> QName a
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> Name a -> Name a
forall a. ([Char] -> [Char]) -> Name a -> Name a
withIdent' [Char] -> [Char]
f Name a
n
  UnQual a
l Name a
n -> a -> Name a -> QName a
forall l. l -> Name l -> QName l
UnQual a
l (Name a -> QName a) -> Name a -> QName a
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> Name a -> Name a
forall a. ([Char] -> [Char]) -> Name a -> Name a
withIdent' [Char] -> [Char]
f Name a
n
  Special{} -> QName a
q
  where
    withIdent' :: (String -> String) -> Name a -> Name a
    withIdent' :: ([Char] -> [Char]) -> Name a -> Name a
withIdent' [Char] -> [Char]
f' Name a
n' = case Name a
n' of
      Symbol{} -> Name a
n'
      Ident a
l [Char]
s -> a -> [Char] -> Name a
forall l. l -> [Char] -> Name l
Ident a
l ([Char] -> [Char]
f' [Char]
s)

-- | Extract the string from a Name.
unname :: Name a -> String
unname :: Name a -> [Char]
unname (Ident a
_ [Char]
s) = [Char]
s
unname (Symbol a
_ [Char]
s) = [Char]
s