{-# LANGUAGE ScopedTypeVariables, ViewPatterns #-}
module Language.Haskell.Names.ModuleSymbols
  ( moduleSymbols
  , moduleTable
  , getTopDeclSymbols
  )
  where

import Data.Maybe
import Data.Data
import qualified Data.Map as Map

import Language.Haskell.Exts hiding (DataOrNew(NewType))
import qualified Language.Haskell.Exts as Syntax (DataOrNew(NewType))
import Language.Haskell.Names.Types
import qualified Language.Haskell.Names.GlobalSymbolTable as Global
import Language.Haskell.Names.SyntaxUtils
import Language.Haskell.Names.ScopeUtils
import Language.Haskell.Names.GetBound

-- | Compute module's global table. It contains both the imported entities
-- and the global entities defined in this module.
moduleTable
  :: (Eq l, Data l)
  => Global.Table -- ^ the import table for this module
  -> Module l
  -> Global.Table
moduleTable :: forall l. (Eq l, Data l) => Table -> Module l -> Table
moduleTable Table
impTbl Module l
m = Table -> Table -> Table
Global.mergeTables Table
impTbl (Bool -> ModuleName () -> [Symbol] -> Table
computeSymbolTable
  Bool
False (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (Module l -> ModuleName l
forall l. Module l -> ModuleName l
getModuleName Module l
m)) (Table -> Module l -> [Symbol]
forall l. (Eq l, Data l) => Table -> Module l -> [Symbol]
moduleSymbols Table
impTbl Module l
m))

-- | Compute the symbols that are defined in the given module.
--
-- The import table is needed to resolve possible top-level record
-- wildcard bindings, such as
--
-- >A {..} = foo
moduleSymbols
  :: (Eq l, Data l)
  => Global.Table -- ^ the import table for this module
  -> Module l
  -> [Symbol]
moduleSymbols :: forall l. (Eq l, Data l) => Table -> Module l -> [Symbol]
moduleSymbols Table
impTbl Module l
m =
  (Decl l -> [Symbol]) -> [Decl l] -> [Symbol]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Table -> ModuleName l -> Decl l -> [Symbol]
forall l.
(Eq l, Data l) =>
Table -> ModuleName l -> Decl l -> [Symbol]
getTopDeclSymbols Table
impTbl (ModuleName l -> Decl l -> [Symbol])
-> ModuleName l -> Decl l -> [Symbol]
forall a b. (a -> b) -> a -> b
$ Module l -> ModuleName l
forall l. Module l -> ModuleName l
getModuleName Module l
m) (Module l -> [Decl l]
forall l. Module l -> [Decl l]
getModuleDecls Module l
m)

getTopDeclSymbols
  :: forall l . (Eq l, Data l)
  => Global.Table -- ^ the import table for this module
  -> ModuleName l
  -> Decl l
  -> [Symbol]
getTopDeclSymbols :: forall l.
(Eq l, Data l) =>
Table -> ModuleName l -> Decl l -> [Symbol]
getTopDeclSymbols Table
impTbl ModuleName l
modulename Decl l
d = (case Decl l
d of
    TypeDecl l
_ DeclHead l
dh Type l
_ -> [(ModuleName () -> Name () -> Symbol) -> DeclHead l -> Symbol
forall {t} {l}. (ModuleName () -> Name () -> t) -> DeclHead l -> t
declHeadSymbol ModuleName () -> Name () -> Symbol
Type DeclHead l
dh]

    TypeFamDecl l
_ DeclHead l
dh Maybe (ResultSig l)
_ Maybe (InjectivityInfo l)
_ -> [ModuleName () -> Name () -> Maybe (Name ()) -> Symbol
TypeFam (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
dh)) Maybe (Name ())
forall a. Maybe a
Nothing]

    DataDecl l
_ DataOrNew l
dataOrNew Maybe (Context l)
_ DeclHead l
dh [QualConDecl l]
qualConDecls [Deriving l]
_ -> (ModuleName () -> Name () -> Symbol) -> DeclHead l -> Symbol
forall {t} {l}. (ModuleName () -> Name () -> t) -> DeclHead l -> t
declHeadSymbol (DataOrNew l -> ModuleName () -> Name () -> Symbol
forall l. DataOrNew l -> ModuleName () -> Name () -> Symbol
dataOrNewCon DataOrNew l
dataOrNew) DeclHead l
dh Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: [Symbol]
infos where

        dq :: Name l
dq = DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
dh

        infos :: [Symbol]
infos = ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
forall l.
ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
constructorsToInfos ModuleName l
modulename Name l
dq ([QualConDecl l] -> [(Name l, [Name l])]
forall l. [QualConDecl l] -> [(Name l, [Name l])]
qualConDeclNames [QualConDecl l]
qualConDecls)

    GDataDecl l
_ DataOrNew l
dataOrNew Maybe (Context l)
_ DeclHead l
dh Maybe (Type l)
_ [GadtDecl l]
gadtDecls [Deriving l]
_ -> (ModuleName () -> Name () -> Symbol) -> DeclHead l -> Symbol
forall {t} {l}. (ModuleName () -> Name () -> t) -> DeclHead l -> t
declHeadSymbol (DataOrNew l -> ModuleName () -> Name () -> Symbol
forall l. DataOrNew l -> ModuleName () -> Name () -> Symbol
dataOrNewCon DataOrNew l
dataOrNew) DeclHead l
dh Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: [Symbol]
infos where
      -- FIXME: We shouldn't create selectors for fields with existential type variables!
        dq :: Name l
dq = DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
dh

        cons :: [(Name l,[Name l])]
        cons :: [(Name l, [Name l])]
cons = do -- list monad
          GadtDecl l
_ Name l
cn Maybe [TyVarBind l]
_ Maybe (Context l)
_ ([FieldDecl l] -> Maybe [FieldDecl l] -> [FieldDecl l]
forall a. a -> Maybe a -> a
fromMaybe [] -> [FieldDecl l]
fields) Type l
_ty <- [GadtDecl l]
gadtDecls
          (Name l, [Name l]) -> [(Name l, [Name l])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name l
cn , [Name l
f | FieldDecl l
_ [Name l]
fNames Type l
_ <- [FieldDecl l]
fields, Name l
f <- [Name l]
fNames])

        infos :: [Symbol]
infos = ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
forall l.
ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
constructorsToInfos ModuleName l
modulename Name l
dq [(Name l, [Name l])]
cons          

    DataFamDecl l
_ Maybe (Context l)
_ DeclHead l
dh Maybe (ResultSig l)
_ -> [ModuleName () -> Name () -> Maybe (Name ()) -> Symbol
DataFam (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
dh)) Maybe (Name ())
forall a. Maybe a
Nothing]

    ClassDecl l
_ Maybe (Context l)
_ DeclHead l
declHead [FunDep l]
_ Maybe [ClassDecl l]
mds -> Symbol
classSymbol Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: [Symbol]
typeFamilySymbols [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ [Symbol]
dataFamilySymbols [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ [Symbol]
methodSymbols where
        cdecls :: [ClassDecl l]
cdecls = [ClassDecl l] -> Maybe [ClassDecl l] -> [ClassDecl l]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ClassDecl l]
mds
        classSymbol :: Symbol
classSymbol = (ModuleName () -> Name () -> Symbol) -> DeclHead l -> Symbol
forall {t} {l}. (ModuleName () -> Name () -> t) -> DeclHead l -> t
declHeadSymbol ModuleName () -> Name () -> Symbol
Class DeclHead l
declHead
        typeFamilySymbols :: [Symbol]
typeFamilySymbols = do
            ClsTyFam   l
_   DeclHead l
familyHead Maybe (ResultSig l)
_ Maybe (InjectivityInfo l)
_ <- [ClassDecl l]
cdecls
            Symbol -> [Symbol]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName () -> Name () -> Maybe (Name ()) -> Symbol
TypeFam (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
familyHead)) (Name () -> Maybe (Name ())
forall a. a -> Maybe a
Just (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
declHead))))
        dataFamilySymbols :: [Symbol]
dataFamilySymbols = do
            ClsDataFam l
_ Maybe (Context l)
_ DeclHead l
familyHead Maybe (ResultSig l)
_ <- [ClassDecl l]
cdecls
            Symbol -> [Symbol]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName () -> Name () -> Maybe (Name ()) -> Symbol
DataFam (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
familyHead)) (Name () -> Maybe (Name ())
forall a. a -> Maybe a
Just (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
declHead))))
        methodSymbols :: [Symbol]
methodSymbols = do
            Name l
methodName <- Table -> Decl l -> [Name l]
forall a l. GetBound a l => Table -> a -> [Name l]
getBound Table
impTbl Decl l
d
            Symbol -> [Symbol]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName () -> Name () -> Name () -> Symbol
Method (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
methodName) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
declHead)))

    FunBind l
_ [Match l]
ms -> [ ModuleName () -> Name () -> Symbol
Value (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
vn) ] where
      Name l
vn : [Name l]
_ = Table -> [Match l] -> [Name l]
forall a l. GetBound a l => Table -> a -> [Name l]
getBound Table
impTbl [Match l]
ms

    PatBind l
_ Pat l
p Rhs l
_ Maybe (Binds l)
_ -> [ ModuleName () -> Name () -> Symbol
Value (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
vn) | Name l
vn <- Table -> Pat l -> [Name l]
forall a l. GetBound a l => Table -> a -> [Name l]
getBound Table
impTbl Pat l
p ]

    PatSyn l
_ Pat l
p Pat l
_ PatternSynDirection l
_ -> case Pat l -> Maybe (Name l)
forall l. Pat l -> Maybe (Name l)
patternHead Pat l
p of
      Just Name l
patternName -> Symbol
patternConstructor Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: [Symbol]
patternSelectors where
        patternConstructor :: Symbol
patternConstructor = ModuleName () -> Name () -> Maybe (Name ()) -> Symbol
PatternConstructor (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
patternName) Maybe (Name ())
forall a. Maybe a
Nothing
        patternSelectors :: [Symbol]
patternSelectors = [ModuleName () -> Name () -> Maybe (Name ()) -> Name () -> Symbol
PatternSelector (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
fn) Maybe (Name ())
forall a. Maybe a
Nothing (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
patternName) | Name l
fn <- Pat l -> [Name l]
forall l. Pat l -> [Name l]
patternFields Pat l
p ]
      Maybe (Name l)
Nothing -> []

    ForImp l
_ CallConv l
_ Maybe (Safety l)
_ Maybe String
_ Name l
fn Type l
_ -> [ ModuleName () -> Name () -> Symbol
Value (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
fn)]

    DataInsDecl l
_ DataOrNew l
_ Type l
typ [QualConDecl l]
qualConDecls [Deriving l]
_ -> ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
forall l.
ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
constructorsToInfos ModuleName l
modulename (Type l -> Name l
forall l. Type l -> Name l
typeOuterName Type l
typ) ([QualConDecl l] -> [(Name l, [Name l])]
forall l. [QualConDecl l] -> [(Name l, [Name l])]
qualConDeclNames [QualConDecl l]
qualConDecls)

    GDataInsDecl l
_ DataOrNew l
_ Type l
typ Maybe (Type l)
_ [GadtDecl l]
gadtDecls [Deriving l]
_ -> ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
forall l.
ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
constructorsToInfos ModuleName l
modulename (Type l -> Name l
forall l. Type l -> Name l
typeOuterName Type l
typ) [(Name l, [Name l])]
cons where
      -- FIXME: We shouldn't create selectors for fields with existential type variables!
        cons :: [(Name l,[Name l])]
        cons :: [(Name l, [Name l])]
cons = do -- list monad
          GadtDecl l
_ Name l
cn Maybe [TyVarBind l]
_ Maybe (Context l)
_ ([FieldDecl l] -> Maybe [FieldDecl l] -> [FieldDecl l]
forall a. a -> Maybe a -> a
fromMaybe [] -> [FieldDecl l]
fields) Type l
_ty <- [GadtDecl l]
gadtDecls
          (Name l, [Name l]) -> [(Name l, [Name l])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name l
cn , [Name l
f | FieldDecl l
_ [Name l]
fNames Type l
_ <- [FieldDecl l]
fields, Name l
f <- [Name l]
fNames])

    Decl l
_ -> [])
        where
            declHeadSymbol :: (ModuleName () -> Name () -> t) -> DeclHead l -> t
declHeadSymbol ModuleName () -> Name () -> t
c DeclHead l
dh = ModuleName () -> Name () -> t
c (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (DeclHead l -> Name l
forall l. DeclHead l -> Name l
getDeclHeadName DeclHead l
dh))

-- | Takes a type name and a list of constructor names paired with selector names. Returns
--   all symbols i.e. constructors and selectors.
constructorsToInfos :: ModuleName l -> Name l -> [(Name l,[Name l])] -> [Symbol]
constructorsToInfos :: forall l.
ModuleName l -> Name l -> [(Name l, [Name l])] -> [Symbol]
constructorsToInfos ModuleName l
modulename Name l
typename [(Name l, [Name l])]
constructors = [Symbol]
conInfos [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ [Symbol]
selInfos where
        conInfos :: [Symbol]
conInfos = do
            (Name l
constructorname,[Name l]
_) <- [(Name l, [Name l])]
constructors
            Symbol -> [Symbol]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName () -> Name () -> Name () -> Symbol
Constructor (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
constructorname) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
typename))

        selectorsMap :: Map String [Name l]
selectorsMap = ([Name l] -> [Name l] -> [Name l])
-> [(String, [Name l])] -> Map String [Name l]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Name l] -> [Name l] -> [Name l]
forall a. [a] -> [a] -> [a]
(++) (do
            (Name l
constructorname,[Name l]
selectornames) <- [(Name l, [Name l])]
constructors
            Name l
selectorname <- [Name l]
selectornames
            (String, [Name l]) -> [(String, [Name l])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name l -> String
forall l. Name l -> String
nameToString Name l
selectorname,[Name l
constructorname]))

        selInfos :: [Symbol]
selInfos = do
            (Name l
_,[Name l]
selectornames) <- [(Name l, [Name l])]
constructors
            Name l
selectorname <- [Name l]
selectornames
            [Name l]
constructornames <- Maybe [Name l] -> [[Name l]]
forall a. Maybe a -> [a]
maybeToList (String -> Map String [Name l] -> Maybe [Name l]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name l -> String
forall l. Name l -> String
nameToString Name l
selectorname) Map String [Name l]
selectorsMap)
            Symbol -> [Symbol]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName () -> Name () -> Name () -> [Name ()] -> Symbol
Selector (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
modulename) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
selectorname) (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
typename) ((Name l -> Name ()) -> [Name l] -> [Name ()]
forall a b. (a -> b) -> [a] -> [b]
map Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn [Name l]
constructornames))

typeOuterName :: Type l -> Name l
typeOuterName :: forall l. Type l -> Name l
typeOuterName Type l
t = case Type l
t of
    TyForall l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ Type l
typ -> Type l -> Name l
forall l. Type l -> Name l
typeOuterName Type l
typ
    TyApp l
_ Type l
typ Type l
_ -> Type l -> Name l
forall l. Type l -> Name l
typeOuterName Type l
typ
    TyCon l
_ QName l
qname -> QName l -> Name l
forall l. QName l -> Name l
qNameToName QName l
qname
    TyParen l
_ Type l
typ -> Type l -> Name l
forall l. Type l -> Name l
typeOuterName Type l
typ
    TyInfix l
_ Type l
_ (PromotedName l
_ QName l
qname) Type l
_ -> QName l -> Name l
forall l. QName l -> Name l
qNameToName QName l
qname
    TyInfix l
_ Type l
_ (UnpromotedName l
_ QName l
qname) Type l
_ -> QName l -> Name l
forall l. QName l -> Name l
qNameToName QName l
qname
    TyKind l
_ Type l
typ Type l
_ -> Type l -> Name l
forall l. Type l -> Name l
typeOuterName Type l
typ
    TyBang l
_ BangType l
_ Unpackedness l
_ Type l
typ -> Type l -> Name l
forall l. Type l -> Name l
typeOuterName Type l
typ
    Type l
_ -> String -> Name l
forall a. HasCallStack => String -> a
error String
"illegal data family in data instance"

qualConDeclNames :: [QualConDecl l] -> [(Name l,[Name l])]
qualConDeclNames :: forall l. [QualConDecl l] -> [(Name l, [Name l])]
qualConDeclNames [QualConDecl l]
qualConDecls = do
    QualConDecl l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ ConDecl l
conDecl <- [QualConDecl l]
qualConDecls
    case ConDecl l
conDecl of
        ConDecl l
_ Name l
n [Type l]
_ -> (Name l, [Name l]) -> [(Name l, [Name l])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name l
n, [])
        InfixConDecl l
_ Type l
_ Name l
n Type l
_ -> (Name l, [Name l]) -> [(Name l, [Name l])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name l
n, [])
        RecDecl l
_ Name l
n [FieldDecl l]
fields ->
            (Name l, [Name l]) -> [(Name l, [Name l])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name l
n , [Name l
f | FieldDecl l
_ [Name l]
fNames Type l
_ <- [FieldDecl l]
fields, Name l
f <- [Name l]
fNames])


dataOrNewCon :: Syntax.DataOrNew l -> ModuleName () -> Name () -> Symbol
dataOrNewCon :: forall l. DataOrNew l -> ModuleName () -> Name () -> Symbol
dataOrNewCon DataOrNew l
dataOrNew = case DataOrNew l
dataOrNew of DataType {} -> ModuleName () -> Name () -> Symbol
Data; Syntax.NewType {} -> ModuleName () -> Name () -> Symbol
NewType


patternHead :: Pat l -> Maybe (Name l)
patternHead :: forall l. Pat l -> Maybe (Name l)
patternHead (PApp l
_ (UnQual l
_ Name l
n) [Pat l]
_) = Name l -> Maybe (Name l)
forall a. a -> Maybe a
Just Name l
n
patternHead (PInfixApp l
_ Pat l
_ (UnQual l
_ Name l
n) Pat l
_) = Name l -> Maybe (Name l)
forall a. a -> Maybe a
Just Name l
n
patternHead (PRec l
_ (UnQual l
_ Name l
n) [PatField l]
_) = Name l -> Maybe (Name l)
forall a. a -> Maybe a
Just Name l
n
patternHead Pat l
_ = Maybe (Name l)
forall a. Maybe a
Nothing


patternFields :: Pat l -> [Name l]
patternFields :: forall l. Pat l -> [Name l]
patternFields (PRec l
_ QName l
_ [PatField l]
fs) = (PatField l -> [Name l]) -> [PatField l] -> [Name l]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatField l -> [Name l]
forall {l}. PatField l -> [Name l]
get' [PatField l]
fs where
  get' :: PatField l -> [Name l]
get' (PFieldPat l
_ (UnQual l
_ Name l
n) Pat l
_) = [Name l
n]
  get' (PFieldPun l
_ (UnQual l
_ Name l
n)) = [Name l
n]
  get' PatField l
_ = []
patternFields Pat l
_ = []