-- | 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 _ m :: ModuleName a
m _) = ModuleName a -> Maybe (ModuleName a)
forall a. a -> Maybe a
Just ModuleName a
m
qModName _          = 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 _ _ n :: Name a
n) = Name a
n
unQual (UnQual _ n :: Name a
n) = Name a
n
unQual Special{} = [Char] -> Name a
forall a. HasCallStack => [Char] -> a
error "unQual Special{}"

unQualify :: QName a -> QName a
unQualify :: QName a -> QName a
unQualify (Qual a :: a
a _ n :: 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 "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 m :: ModuleName a
m (Qual a :: a
a _ n :: 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 m :: ModuleName a
m (UnQual a :: a
a n :: 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 _ Special{}  = [Char] -> QName a
forall a. HasCallStack => [Char] -> a
error "changeModule Special{}"

changeModule' :: (String -> String) -> QName a -> QName a
changeModule' :: ([Char] -> [Char]) -> QName a -> QName a
changeModule' f :: [Char] -> [Char]
f (Qual l :: a
l (ModuleName ml :: a
ml mn :: [Char]
mn) n :: 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' _ x :: QName a
x = QName a
x

withIdent :: (String -> String) -> QName a -> QName a
withIdent :: ([Char] -> [Char]) -> QName a -> QName a
withIdent f :: [Char] -> [Char]
f q :: QName a
q = case QName a
q of
  Qual l :: a
l m :: ModuleName a
m n :: 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 l :: a
l n :: 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' f' :: [Char] -> [Char]
f' n' :: Name a
n' = case Name a
n' of
      Symbol{} -> Name a
n'
      Ident l :: a
l s :: [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 _ s :: [Char]
s) = [Char]
s
unname (Symbol _ s :: [Char]
s) = [Char]
s