haskell-names 0.8.0 → 0.9.0
raw patch · 35 files changed
+747/−250 lines, 35 filesdep ~aesondep ~basedep ~haskell-namesPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, base, haskell-names, haskell-src-exts, traverse-with-class
API changes (from Hackage documentation)
- Language.Haskell.Names.Open: [wcFieldModuleName] :: WcField -> ModuleName ()
+ Language.Haskell.Names: PatternConstructor :: ModuleName () -> Name () -> Maybe (Name ()) -> Symbol
+ Language.Haskell.Names: PatternSelector :: ModuleName () -> Name () -> Maybe (Name ()) -> Name () -> Symbol
+ Language.Haskell.Names: [patternConstructorName] :: Symbol -> Name ()
+ Language.Haskell.Names: [patternTypeName] :: Symbol -> Maybe (Name ())
+ Language.Haskell.Names.GlobalSymbolTable: isSelector :: Symbol -> Bool
+ Language.Haskell.Names.GlobalSymbolTable: lookupSelector :: QName l -> Table -> [Symbol]
+ Language.Haskell.Names.Open: ReferenceRS :: NameContext
+ Language.Haskell.Names.Open: [wcFieldSymbol] :: WcField -> Symbol
- Language.Haskell.Names: RecExpWildcard :: [(Name (), NameInfo l)] -> NameInfo l
+ Language.Haskell.Names: RecExpWildcard :: [(Symbol, NameInfo l)] -> NameInfo l
- Language.Haskell.Names.Annotated: RecExpWildcard :: [(Name (), NameInfo l)] -> NameInfo l
+ Language.Haskell.Names.Annotated: RecExpWildcard :: [(Symbol, NameInfo l)] -> NameInfo l
- Language.Haskell.Names.Open: WcField :: Name () -> ModuleName () -> Bool -> WcField
+ Language.Haskell.Names.Open: WcField :: Name () -> Symbol -> Bool -> WcField
Files
- CHANGELOG.md +11/−0
- README.md +26/−80
- haskell-names.cabal +8/−8
- src/Language/Haskell/Names/Annotated.hs +96/−43
- src/Language/Haskell/Names/Environment.hs +14/−0
- src/Language/Haskell/Names/Exports.hs +22/−6
- src/Language/Haskell/Names/GetBound.hs +8/−0
- src/Language/Haskell/Names/GlobalSymbolTable.hs +12/−1
- src/Language/Haskell/Names/ModuleSymbols.hs +22/−0
- src/Language/Haskell/Names/Open/Base.hs +23/−8
- src/Language/Haskell/Names/Open/Instances.hs +35/−8
- src/Language/Haskell/Names/RecordWildcards.hs +3/−3
- src/Language/Haskell/Names/Recursive.hs +2/−1
- src/Language/Haskell/Names/ScopeUtils.hs +2/−0
- src/Language/Haskell/Names/Types.hs +14/−1
- tests/annotations/ClassInstances.hs +4/−2
- tests/annotations/ClassInstances.hs.golden +65/−56
- tests/annotations/PatternSynonyms.hs +42/−0
- tests/annotations/PatternSynonyms.hs.golden +159/−0
- tests/annotations/RecordFieldUpdate.hs +10/−0
- tests/annotations/RecordFieldUpdate.hs.golden +35/−0
- tests/annotations/RecordPattern.hs +10/−0
- tests/annotations/RecordPattern.hs.golden +37/−0
- tests/annotations/Records.hs +3/−3
- tests/annotations/Records.hs.golden +13/−19
- tests/annotations/WildcardsQualified.hs +8/−0
- tests/annotations/WildcardsQualified.hs.golden +16/−0
- tests/exports/DataFamilies.hs.golden +0/−5
- tests/exports/DuplicateExports.hs +4/−0
- tests/exports/DuplicateExports.hs.golden +10/−0
- tests/exports/ExportAmbiguous.hs +6/−0
- tests/exports/ExportAmbiguous.hs.golden +15/−0
- tests/exports/ExportListMembers.hs +2/−0
- tests/exports/Prelude.hs +2/−0
- tests/run.hs +8/−6
CHANGELOG.md view
@@ -1,6 +1,17 @@ Changes ======= +Version 0.9.0+-------------++* Preliminary support for pattern synonyms+* Relax bounds on aeson and haskell-src-exts+* Fix bug with instance declarations where class is qualified+* Fix bugs with record wildcards and record puns+* Fix bug where we'd produce duplicate symbols in environment+* Use traverse-with-class-1.0.0.0+* haskell-names now requires GHC 8.0 or later+ Version 0.8.0 ------------
README.md view
@@ -60,94 +60,40 @@ [openrec]: http://ro-che.info/articles/2013-03-04-open-name-resolution.html -### Example--Let's say you have a module and you want to find out whether it uses-`Prelude.head`.--``` haskell-module Main where--import Language.Haskell.Exts.Annotated (- fromParseResult, parseModuleWithMode, defaultParseMode,- parseFilename, prettyPrint, srcInfoSpan)-import Language.Haskell.Exts (- Name(Ident), ModuleName(ModuleName))-import Language.Haskell.Names (- loadBase, annotate, symbolName,- Scoped(Scoped), NameInfo(GlobalSymbol))--import qualified Data.Map as Map (- lookup)--import Data.Maybe (- fromMaybe, listToMaybe)-import Data.List (- nub)-import qualified Data.Foldable as Foldable (- toList)-import Control.Monad (- forM_, guard)--main :: IO ()-main = do-- -- read the program's source from stdin- source <- getContents-- -- parse the program (using haskell-src-exts)- let ast = fromParseResult (- parseModuleWithMode defaultParseMode {parseFilename="stdin"} source)-- -- get base environment- baseEnvironment <- loadBase-- -- get symbols defined in prelude- let preludeSymbols = fromMaybe (error "Prelude not found") (- Map.lookup (ModuleName "Prelude") baseEnvironment)-- -- find a Prelude symbol with name 'head' using the List monad- let headSymbol = fromMaybe (error "Prelude.head not found") (- listToMaybe (do- preludeSymbol <- preludeSymbols- guard (symbolName preludeSymbol == Ident "head")- return preludeSymbol))-- -- annotate the AST- let annotatedAST = annotate baseEnvironment ast-- -- get all annotations- let annotations = Foldable.toList annotatedAST-- -- filter head Usages in List monad and remove duplicates- let headUsages = nub (do- Scoped (GlobalSymbol globalSymbol _) location <- annotations- guard (globalSymbol == headSymbol)- return location)+### Examples - case headUsages of- [] ->- putStrLn "Congratulations! Your code doesn't use Prelude.head"- _ -> forM_ headUsages (\location ->- putStrLn ("Prelude.head is used at " ++ (prettyPrint (srcInfoSpan location))))+The example in `examples/HeadUsage.hs` shows how you would find out if a+Haskell modules given on stdin uses `Prelude.head`. ```+% cabal exec -- runghc examples/HeadUsages.hs+one = head [1]+^D+Prelude.head is used at stdin: (1:7) - (1:11) -#### Example invocation+% cabal exec -- runghc examples/HeadUsages.hs+import Prelude hiding (head)+import Data.Text +f = head (pack "foo")+^D+Congratulations! Your code doesn't use Prelude.head+``` - % ./find-heads - one = head [1]- ^D- Prelude.head is used at stdin: (1:7) - (1:11)+The example in `examples/ModuleExports.hs` shows how the `resolve` function+behaves. It expects to find `examples/moduleexports.Example.hs` and+`examples/moduleexports/Example/Internal.hs`. - % ./find-heads- import Prelude hiding (head)- import Data.Text+```+% cabal exec -- runghc examples/ModuleExports.hs+Only example: fromList [(ModuleName () "Example",[])]+Only internal: fromList [(ModuleName () "Example.Internal",[Value {symbolModule = ModuleName () "Example.Internal", symbolName = Ident () "details"}])]+Example & Internal: fromList [(ModuleName () "Example",[Value {symbolModule = ModuleName () "Example.Internal", symbolName = Ident () "details"}]),(ModuleName () "Example.Internal",[Value {symbolModule = ModuleName () "Example.Internal", symbolName = Ident () "details"}])]+Internal & Example: fromList [(ModuleName () "Example",[Value {symbolModule = ModuleName () "Example.Internal", symbolName = Ident () "details"}]),(ModuleName () "Example.Internal",[Value {symbolModule = ModuleName () "Example.Internal", symbolName = Ident () "details"}])]+Example after Internal: fromList [(ModuleName () "Example",[Value {symbolModule = ModuleName () "Example.Internal", symbolName = Ident () "details"}]),(ModuleName () "Example.Internal",[Value {symbolModule = ModuleName () "Example.Internal", symbolName = Ident () "details"}])]+Internal after Example: fromList [(ModuleName () "Example",[]),(ModuleName () "Example.Internal",[Value {symbolModule = ModuleName () "Example.Internal", symbolName = Ident () "details"}])]+``` - f = head (pack "foo")- ^D- Congratulations! Your code doesn't use Prelude.head ### API documentation
haskell-names.cabal view
@@ -1,5 +1,5 @@ Name: haskell-names-Version: 0.8.0+Version: 0.9.0 License: BSD3 Author: Philipp Schuster, Roman Cheplyaka, Lennart Augustsson Maintainer: Philipp Schuster@@ -11,7 +11,7 @@ Stability: Experimental Build-Type: Simple Cabal-Version: >= 1.10-Tested-With: GHC == 7.8.4, GHC == 7.10.1, GHC == 8.0.1+Tested-With: GHC == 8.0.1, GHC == 8.2.1 extra-source-files: README.md@@ -236,16 +236,16 @@ Default-Language: Haskell2010 Build-depends: base >= 4 && < 5- , haskell-src-exts >= 1.18 && < 1.19+ , haskell-src-exts >= 1.18 && < 1.20 , mtl >= 2.2.1 && < 2.3 , transformers >=0.4.2.0 && < 0.6 , filepath >= 1.1 && < 1.5 , containers >= 0.2 && < 0.6 , uniplate >= 1.5.1 && < 1.7- , aeson >= 0.8.0.2 && < 1.1+ , aeson >= 0.8.0.2 && < 1.3 , bytestring >= 0.10.4.0 && < 0.11 , data-lens-light >= 0.1.2.1 && < 0.2- , traverse-with-class >= 0.2.0.3 && < 0.3+ , traverse-with-class >= 1.0.0.0 && < 1.1 if impl(ghc <= 7.8) Build-depends: tagged >= 0.8.4 && < 0.9 Hs-source-dirs: src@@ -282,8 +282,8 @@ run.hs Build-depends: base >= 4 && < 5- , haskell-names >= 0.8.0 && < 0.9- , haskell-src-exts >= 1.18 && < 1.19+ , haskell-names+ , haskell-src-exts >= 1.18 && < 1.20 , mtl >= 2.2.1 && < 2.3 , filepath >= 1.1 && <1.5 , containers >= 0.2 && < 0.6@@ -291,5 +291,5 @@ , tasty-golden >= 2.2.1 && < 2.4 , filemanip >= 0.3.6.3 && < 0.4 , pretty-show >= 1.6.1 && < 1.7- , traverse-with-class >= 0.2.0.3 && < 0.3+ , traverse-with-class >= 1.0.0.0 && < 1.1
src/Language/Haskell/Names/Annotated.hs view
@@ -17,7 +17,8 @@ import Language.Haskell.Names.Open.Instances () import qualified Language.Haskell.Names.GlobalSymbolTable as Global import qualified Language.Haskell.Names.LocalSymbolTable as Local-import Language.Haskell.Names.SyntaxUtils (dropAnn, annName,setAnn)+import Language.Haskell.Names.SyntaxUtils (+ dropAnn, setAnn, nameQualification, qNameToName) import Language.Haskell.Exts import Data.Proxy import Data.Lens.Light@@ -46,25 +47,24 @@ = lookupName (fmap sLoc a) sc <$ a | Just (Refl :: FieldUpdate (Scoped l) :~: a) <- eqT = case a of- FieldPun l qname -> FieldPun l (lookupQName (sLoc <$> qname) sc <$ qname)- FieldWildcard l -> FieldWildcard (Scoped (RecExpWildcard namesRes) (sLoc l)) where- namesRes = do+ FieldWildcard l ->+ FieldWildcard (Scoped (RecExpWildcard namesRes) (sLoc l)) where+ namesRes = do f <- sc ^. wcNames- let qname = setAnn (sLoc l) (UnQual () (annName (wcFieldName f)))- case lookupQName qname sc of- Scoped info@(GlobalSymbol _ _) _ -> return (wcFieldName f,info)- Scoped info@(LocalValue _) _ -> return (wcFieldName f,info)- _ -> []+ let localQName = qualifyName Nothing (setAnn (sLoc l) (wcFieldName f))+ symbol = wcFieldSymbol f+ Scoped info _ <- return (lookupQName localQName sc)+ return (symbol, info) _ -> rmap go sc a | Just (Refl :: PatField (Scoped l) :~: a) <- eqT- , PFieldWildcard l <- a- = let- namesRes = do+ = case a of+ PFieldWildcard l ->+ PFieldWildcard (Scoped (RecPatWildcard namesRes) (sLoc l)) where+ namesRes = do f <- sc ^. wcNames- let qname = UnQual () (annName (wcFieldName f))- Scoped (GlobalSymbol symbol _) _ <- return (lookupQName qname (exprV sc))- return (symbol {symbolModule = wcFieldModuleName f})- in PFieldWildcard (Scoped (RecPatWildcard namesRes) (sLoc l))+ let symbol = wcFieldSymbol f+ return symbol+ _ -> rmap go sc a | otherwise = rmap go sc a @@ -73,24 +73,49 @@ lookupQName (Special l _) _ = Scoped None l lookupQName qname scope = Scoped nameInfo (ann qname) where - nameInfo = case getL nameCtx scope of+ nameInfo = case getL patSynMode scope of - ReferenceV -> case Local.lookupValue qname (getL lTable scope) of- Right srcloc -> LocalValue srcloc- _ ->- checkUniqueness (Global.lookupValue qname globalTable)+ Nothing -> case getL nameCtx scope of - ReferenceT ->- checkUniqueness (Global.lookupType qname globalTable)+ ReferenceV -> case Local.lookupValue qname (getL lTable scope) of+ Right srcloc -> LocalValue srcloc+ _ ->+ checkUniqueness (Global.lookupValue qname globalTable) - ReferenceUT ->- checkUniqueness (Global.lookupMethodOrAssociate qname' globalTable) where- qname' = case qname of- UnQual _ name -> qualifyName (getL instQual scope) name- _ -> qname+ ReferenceT ->+ checkUniqueness (Global.lookupType qname globalTable) - _ -> None+ ReferenceUT ->+ checkUniqueness (Global.lookupMethodOrAssociate qname' globalTable) where+ qname' = case qname of+ UnQual _ name -> qualifyName maybeQualification name where+ maybeQualification = maybe Nothing nameQualification (getL instClassName scope)+ _ -> qname + ReferenceRS ->+ checkUniqueness (Global.lookupSelector qname globalTable)++ _ -> None++ Just PatSynLeftHandSide -> case getL nameCtx scope of++ ReferenceV -> ValueBinder++ ReferenceRS -> ValueBinder++ _ -> None++ Just PatSynRightHandSide -> case getL nameCtx scope of++ ReferenceV -> case Local.lookupValue qname (getL lTable scope) of+ Right srcloc -> LocalValue srcloc+ _ -> checkUniqueness (Global.lookupValue qname globalTable)+ ReferenceRS ->+ checkUniqueness (Global.lookupSelector qname globalTable)++ _ -> None++ globalTable = getL gTable scope checkUniqueness symbols = case symbols of@@ -102,29 +127,57 @@ lookupName :: Name l -> Scope -> Scoped l lookupName name scope = Scoped nameInfo (ann name) where - nameInfo = case getL nameCtx scope of+ nameInfo = case getL patSynMode scope of - ReferenceUV ->- checkUniqueness qname (Global.lookupMethodOrAssociate qname globalTable) where- qname = qualifyName (getL instQual scope) name+ Nothing -> case getL nameCtx scope of - SignatureV ->- checkUniqueness qname (Global.lookupValue qname globalTable) where- qname = qualifyName (Just (getL moduName scope)) name+ ReferenceUV ->+ disambiguateMethod maybeClassName qname (Global.lookupMethodOrAssociate qname globalTable) where+ qname = qualifyName maybeQualification name+ maybeQualification = maybe Nothing nameQualification maybeClassName+ maybeClassName = getL instClassName scope - BindingV -> ValueBinder+ SignatureV ->+ checkUniqueness qname (Global.lookupValue qname globalTable) where+ qname = qualifyName (Just (getL moduName scope)) name - BindingT -> TypeBinder+ BindingV -> ValueBinder - _ -> None+ BindingT -> TypeBinder + _ -> None++ Just PatSynLeftHandSide -> case getL nameCtx scope of++ BindingV -> ValueBinder++ _ -> None++ Just PatSynRightHandSide -> case getL nameCtx scope of++ BindingV ->+ case Local.lookupValue (qualifyName Nothing name) (getL lTable scope) of+ Right srcloc -> LocalValue srcloc+ _ -> None++ _ -> None++ globalTable = getL gTable scope - checkUniqueness qname symbols = case symbols of- [] -> ScopeError (ENotInScope qname)- [symbol] -> GlobalSymbol symbol (dropAnn qname)- _ -> ScopeError (EAmbiguous qname symbols) +checkUniqueness :: QName l -> [Symbol] -> NameInfo l+checkUniqueness qname symbols = case symbols of+ [] -> ScopeError (ENotInScope qname)+ [symbol] -> GlobalSymbol symbol (dropAnn qname)+ _ -> ScopeError (EAmbiguous qname symbols)+++disambiguateMethod :: Maybe (QName ()) -> QName l -> [Symbol] -> NameInfo l+disambiguateMethod Nothing _ _ = ScopeError (EInternal "method in instance of unknown class")+disambiguateMethod (Just instanceClassName) qname symbols = checkUniqueness qname disambiguatedSymbols where+ disambiguatedSymbols =+ filter (\symbol -> className symbol == qNameToName instanceClassName) symbols qualifyName :: Maybe (ModuleName ()) -> Name l -> QName l qualifyName Nothing n = UnQual (ann n) n
src/Language/Haskell/Names/Environment.hs view
@@ -70,6 +70,11 @@ ["associate" .= fmap prettyName as] DataFam { associate = as } -> ["associate" .= fmap prettyName as]+ PatternConstructor { patternTypeName = mty } ->+ ["patternTypeName" .= fmap prettyName mty]+ PatternSelector { patternTypeName = mty, patternConstructorName = pn } ->+ ["patternTypeName" .= fmap prettyName mty+ ,"patternConstructorName" .= prettyName pn] _ -> [] symbolEntity :: Symbol -> String@@ -84,6 +89,8 @@ TypeFam {} -> "typeFamily" DataFam {} -> "dataFamily" Class {} -> "class"+ PatternConstructor {} -> "patternConstructor"+ PatternSelector {} -> "patternSelector" parseName :: String -> Name () parseName = dropAnn . stringToName@@ -116,6 +123,13 @@ associate <- fmap parseName <$> v .: "associate" return $ DataFam symbolmodule symbolname associate "class" -> return $ Class symbolmodule symbolname+ "patternConstructor" -> do+ typ <- fmap parseName <$> v .: "patternTypeName"+ return (PatternConstructor symbolmodule symbolname typ)+ "patternSelector" -> do+ typ <- fmap parseName <$> v .: "patternTypeName"+ patternname <- parseName <$> v .: "patternConstructorName"+ return (PatternSelector symbolmodule symbolname typ patternname) _ -> mzero parseJSON _ = mzero
src/Language/Haskell/Names/Exports.hs view
@@ -16,16 +16,16 @@ import Language.Haskell.Names.SyntaxUtils import Language.Haskell.Names.ModuleSymbols import Language.Haskell.Names.GlobalSymbolTable as Global-import Data.List (nub)+import qualified Data.Set as Set (fromList, toList) -- | Compute the list of symbols the given module exports using the given -- table of symbols that are in scope in that module. exportedSymbols :: (Data l, Eq l) => Global.Table -> Module l -> [Symbol]-exportedSymbols globalTable modul = case getExportSpecList modul of+exportedSymbols globalTable modul = nubSymbols (case getExportSpecList modul of Nothing -> moduleSymbols globalTable modul Just (ExportSpecList _ exportSpecs) ->- concatMap (exportSpecSymbols globalTable) exportSpecs+ concatMap (exportSpecSymbols globalTable) exportSpecs) exportSpecSymbols :: Global.Table -> ExportSpec l -> [Symbol] exportSpecSymbols globalTable exportSpec =@@ -51,6 +51,13 @@ [symbol] -> EVar (Scoped (Export [symbol]) l) (Scoped (GlobalSymbol symbol (dropAnn qn)) <$> qn) symbols -> scopeError (EAmbiguous qn symbols) exportSpec+ EAbs l ns@(PatternNamespace _) qn ->+ case Global.lookupValue qn globalTable of+ [] -> scopeError (ENotInScope qn) exportSpec+ [symbol] -> EAbs (Scoped (Export [symbol]) l)+ (noScope ns)+ (Scoped (GlobalSymbol symbol (dropAnn qn)) <$> qn)+ symbols -> scopeError (EAmbiguous qn symbols) exportSpec EAbs l ns qn -> case Global.lookupType qn globalTable of [] -> scopeError (ENotInScope qn) exportSpec@@ -63,10 +70,11 @@ [] -> scopeError (ENotInScope qn) exportSpec [symbol] -> let- subSymbols = nub (do+ subSymbols = nubSymbols (do subSymbol <- concat (Map.elems globalTable)- Just n' <- return $ symbolParent subSymbol- guard (n' == symbolName symbol)+ Just subSymbolParentName <- return $ symbolParent subSymbol+ guard (subSymbolParentName == symbolName symbol)+ guard (symbolModule subSymbol == symbolModule symbol) return subSymbol) s = [symbol] <> subSymbols in@@ -100,4 +108,12 @@ inScopeUnqualified = Set.fromList (do (UnQual _ _, symbols) <- Map.toList globalTable symbols)+++nubSymbols :: [Symbol] -> [Symbol]+nubSymbols = loop Set.empty where+ loop _ [] = []+ loop a (b : c) = if Set.member b a+ then loop a c+ else b : loop (Set.insert b a) c
src/Language/Haskell/Names/GetBound.hs view
@@ -56,6 +56,14 @@ FunBind _ (Match _ n _ _ _ : _) -> [n] FunBind _ (InfixMatch _ _ n _ _ _ : _) -> [n] PatBind _ p _ _ -> getBound ctx p+ PatSyn _ p _ _ -> case p of+ PInfixApp _ _ qn _ -> [qNameToName qn]+ PApp _ qn _ -> [qNameToName qn]+ PRec _ qn fs -> qNameToName qn : concatMap getFieldBound fs where+ getFieldBound (PFieldPat _ qn' _) = [qNameToName qn']+ getFieldBound (PFieldPun _ qn') = [qNameToName qn']+ _ = []+ _ -> [] ForImp _ _ _ _ n _ -> [n] ForExp _ _ _ n _ -> [n] RulePragmaDecl{} -> []
src/Language/Haskell/Names/GlobalSymbolTable.hs view
@@ -2,7 +2,7 @@ -- | This module is designed to be imported qualified. module Language.Haskell.Names.GlobalSymbolTable where -import Language.Haskell.Exts hiding (NewType)+import Language.Haskell.Exts hiding (NewType, PatSyn) import Data.Map ( Map)@@ -36,6 +36,9 @@ lookupMethodOrAssociate :: QName l -> Table -> [Symbol] lookupMethodOrAssociate qn = filter isMethodOrAssociated . lookupName qn +lookupSelector :: QName l -> Table -> [Symbol]+lookupSelector qn = filter isSelector . lookupName qn+ lookupName :: QName l -> Table -> [Symbol] lookupName qn table = fromMaybe [] (Map.lookup (dropAnn qn) table) @@ -45,6 +48,8 @@ Method {} -> True Selector {} -> True Constructor {} -> True+ PatternConstructor {} -> True+ PatternSelector {} -> True _ -> False isType :: Symbol -> Bool@@ -62,6 +67,12 @@ Method {} -> True TypeFam {} -> True DataFam {} -> True+ _ -> False++isSelector :: Symbol -> Bool+isSelector symbol = case symbol of+ Selector {} -> True+ PatternSelector {} -> True _ -> False fromList :: [(QName (),Symbol)] -> Table
src/Language/Haskell/Names/ModuleSymbols.hs view
@@ -90,6 +90,12 @@ PatBind _ p _ _ -> [ Value (dropAnn modulename) (dropAnn vn) | vn <- getBound impTbl p ] + PatSyn _ p _ _ -> case patternHead p of+ Just patternName -> patternConstructor : patternSelectors where+ patternConstructor = PatternConstructor (dropAnn modulename) (dropAnn patternName) Nothing+ patternSelectors = [PatternSelector (dropAnn modulename) (dropAnn fn) Nothing (dropAnn patternName) | fn <- patternFields p ]+ Nothing -> []+ ForImp _ _ _ _ fn _ -> [ Value (dropAnn modulename) (dropAnn fn)] DataInsDecl _ _ typ qualConDecls _ -> constructorsToInfos modulename (typeOuterName typ) (qualConDeclNames qualConDecls)@@ -147,3 +153,19 @@ dataOrNewCon :: Syntax.DataOrNew l -> ModuleName () -> Name () -> Symbol dataOrNewCon dataOrNew = case dataOrNew of DataType {} -> Data; Syntax.NewType {} -> NewType+++patternHead :: Pat l -> Maybe (Name l)+patternHead (PApp _ (UnQual _ n) _) = Just n+patternHead (PInfixApp _ _ (UnQual _ n) _) = Just n+patternHead (PRec _ (UnQual _ n) _) = Just n+patternHead _ = Nothing+++patternFields :: Pat l -> [Name l]+patternFields (PRec _ _ fs) = concatMap get' fs where+ get' (PFieldPat _ (UnQual _ n) _) = [n]+ get' (PFieldPun _ (UnQual _ n)) = [n]+ get' _ = []+patternFields _ = []+
src/Language/Haskell/Names/Open/Base.hs view
@@ -4,7 +4,7 @@ -- You can look at "Language.Haskell.Exts.Annotated" source as an example -- of how to use this module. {-# LANGUAGE RankNTypes, FlexibleInstances, FlexibleContexts, UndecidableInstances, DefaultSignatures, TemplateHaskell, ScopedTypeVariables #-}-{-# LANGUAGE ImplicitParams, KindSignatures #-}+{-# LANGUAGE ImplicitParams, KindSignatures, TypeApplications #-} module Language.Haskell.Names.Open.Base where import qualified Language.Haskell.Names.GlobalSymbolTable as Global@@ -36,11 +36,21 @@ -- ^ Reference an associated type in an instance declaration -- Unqualified names also match qualified names in scope -- https://www.haskell.org/pipermail/haskell-prime/2008-April/002569.html+ | ReferenceRS+ -- ^ Reference a record field selector | SignatureV -- ^ A type signature contains an always unqualified 'Name' that always -- refers to a value bound in the same module. | Other +-- | Pattern synonyms can work in different modes depending on if we are on the+-- left hand side or right hand side+data PatSynMode+ = PatSynLeftHandSide+ -- ^ Bind QName's too+ | PatSynRightHandSide+ -- ^ Supress bindings, force references instead (even for Name)+ -- | Contains information about the node's enclosing scope. Can be -- accessed through the lenses: 'gTable', 'lTable', 'nameCtx', -- 'instanceQualification', 'wcNames'.@@ -51,15 +61,16 @@ , _gTable :: Global.Table , _lTable :: Local.Table , _nameCtx :: NameContext- , _instQual :: Maybe (ModuleName ())+ , _instClassName :: Maybe (QName ()) , _wcNames :: WcNames+ , _patSynMode :: Maybe PatSynMode } makeLens ''Scope -- | Create an initial scope initialScope :: ModuleName () -> Global.Table -> Scope-initialScope moduleName tbl = Scope moduleName tbl Local.empty Other Nothing []+initialScope moduleName tbl = Scope moduleName tbl Local.empty Other Nothing [] Nothing -- | Merge local tables of two scopes. The other fields of the scopes are -- assumed to be the same.@@ -80,9 +91,7 @@ defaultRtraverse :: (GTraversable Resolvable a, Applicative f, ?alg :: Alg f) => a -> Scope -> f a-defaultRtraverse a sc =- let ?c = ConstraintProxy :: ConstraintProxy Resolvable- in gtraverse (\a -> alg a sc) a+defaultRtraverse a sc = gtraverse @Resolvable (\d -> alg d sc) a -- | A type that implements 'Resolvable' provides a way to perform -- a shallow scope-aware traversal.@@ -157,5 +166,11 @@ exprUT :: Scope -> Scope exprUT = setNameCtx ReferenceUT -instQ :: Maybe (ModuleName ()) -> Scope -> Scope-instQ m = setL instQual m+exprRS :: Scope -> Scope+exprRS = setNameCtx ReferenceRS++setInstClassName :: Maybe (QName ()) -> Scope -> Scope+setInstClassName m = setL instClassName m++setPatSynMode :: PatSynMode -> Scope -> Scope+setPatSynMode = setL patSynMode . Just
src/Language/Haskell/Names/Open/Instances.hs view
@@ -20,10 +20,12 @@ import qualified Data.Data as D import Control.Applicative import Data.Typeable+import Data.Type.Equality import Data.Lens.Light import Data.List import qualified Data.Traversable as T + c :: Applicative w => c -> w c c = pure @@ -57,7 +59,16 @@ <| sc -: pat <| exprV scWithWhere -: rhs <| sc -: mbWhere- -- FunBind consists of Matches, which we handle below anyway.+ p@(PatSyn l pat rpat dir) ->+ let+ scWithPatSyn = intro p sc+ scWithPat = intro pat scWithPatSyn+ in+ c PatSyn+ <| sc -: l+ <| (setPatSynMode PatSynLeftHandSide sc) -: pat+ <| (setPatSynMode PatSynRightHandSide scWithPat) -: rpat+ <| sc -: dir TypeSig l names ty -> c TypeSig <| sc -: l@@ -70,7 +81,7 @@ <| sc -: mp <| exprV sc -: ops InstDecl l mOverlap rule mInstDecls ->- let sc' = instQ (nameQualification (instanceRuleClass rule)) sc+ let sc' = setInstClassName (Just (dropAnn (instanceRuleClass rule))) sc in c InstDecl <| sc' -: l <| sc' -: mOverlap@@ -78,6 +89,7 @@ <| sc' -: mInstDecls _ -> defaultRtraverse e sc + instanceRuleClass :: InstRule l -> QName l instanceRuleClass (IParen _ instRule) = instanceRuleClass instRule instanceRuleClass (IRule _ _ _ instHead) = instanceHeadClass instHead@@ -135,6 +147,7 @@ <| binderV sc -: name <| sc -: tys + instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Pat l) where rtraverse e sc = case e of@@ -185,14 +198,12 @@ PFieldPat l qn pat -> c PFieldPat <| sc -: l- <| exprV sc -: qn+ <| exprRS sc -: qn <| sc -: pat PFieldPun l qn -> c PFieldPun <| sc -: l- <| exprV sc -: qn- -- In future we might want to annotate PFieldWildcard with the names- -- it introduces.+ <| exprRS sc -: qn PFieldWildcard {} -> defaultRtraverse e sc -- | Chain a sequence of nodes where every node may introduce some@@ -311,11 +322,27 @@ sc in c RecConstr- <| sc -: l- <| sc -: qn+ <| sc -: l+ <| sc -: qn <| scWc -: fields _ -> defaultRtraverse e sc+++instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (FieldUpdate l) where+ rtraverse e sc =+ case e of+ FieldUpdate l qn exp ->+ c FieldUpdate+ <| sc -: l+ <| exprRS sc -: qn+ <| sc -: exp+ FieldPun l qn ->+ c FieldPun+ <| sc -: l+ <| exprRS sc -: qn+ FieldWildcard {} -> defaultRtraverse e sc+ instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Alt l) where rtraverse e sc =
src/Language/Haskell/Names/RecordWildcards.hs view
@@ -26,8 +26,8 @@ data WcField = WcField { wcFieldName :: Name () -- ^ the field's simple name- , wcFieldModuleName :: ModuleName ()- -- ^ the field's original name+ , wcFieldSymbol :: Symbol+ -- ^ the field's selector symbol , wcExistsGlobalValue :: Bool -- ^ whether there is a global value in scope with the same name as -- the field but different from the field selector@@ -76,7 +76,7 @@ let name = symbolName symbol wcfield = WcField { wcFieldName = name- , wcFieldModuleName = symbolModule symbol+ , wcFieldSymbol = symbol , wcExistsGlobalValue = existsGlobalValue name } return (name,wcfield))
src/Language/Haskell/Names/Recursive.hs view
@@ -24,7 +24,8 @@ -- | Takes a list of modules and an environment and updates the environment--- with each of the given modules' exported symbols.+-- with each of the given modules' exported symbols. The modules can appear+-- in any order and can be mutually recursive. resolve :: (Data l, Eq l) => [Module l] -> Environment -> Environment resolve modules environment = updatedEnvironment where moduleSCCs = groupModules modules
src/Language/Haskell/Names/ScopeUtils.hs view
@@ -25,6 +25,8 @@ symbolParent (Method { className = n }) = Just n symbolParent (TypeFam { associate = as }) = as symbolParent (DataFam { associate = as }) = as+symbolParent (PatternConstructor { patternTypeName = mn}) = mn+symbolParent (PatternSelector { patternTypeName = mn}) = mn symbolParent _ = Nothing computeSymbolTable
src/Language/Haskell/Names/Types.hs view
@@ -70,6 +70,19 @@ , symbolName :: Name () } -- ^ type class+ | PatternConstructor+ { symbolModule :: ModuleName ()+ , symbolName :: Name ()+ , patternTypeName :: Maybe (Name ())+ }+ -- ^ pattern synonym constructor+ | PatternSelector+ { symbolModule :: ModuleName ()+ , symbolName :: Name ()+ , patternTypeName :: Maybe (Name ())+ , patternConstructorName :: Name ()+ }+ -- ^ pattern synonym selector deriving (Eq, Ord, Show, Data, Typeable) -- | A map from module name to list of symbols it exports.@@ -102,7 +115,7 @@ | RecPatWildcard [Symbol] -- ^ wildcard in a record pattern. The list contains resolved names -- of the fields that are brought in scope by this pattern.- | RecExpWildcard [(Name (), NameInfo l)]+ | RecExpWildcard [(Symbol, NameInfo l)] -- ^ wildcard in a record construction expression. The list contains -- resolved names of the fields and information about values -- assigned to those fields.
tests/annotations/ClassInstances.hs view
@@ -1,15 +1,17 @@ module ClassInstances where -data D a = D Bool a+data D a = D DataType a class C a where wiggle :: a -> a woe :: a+ method1 :: a ($$$) :: a -> a -> a instance (C a) => C (D a) where wiggle (D b a) = D b (f a)- woe = D False woe+ woe = D Constructor1 woe+ method1 = D Constructor1 woe f $$$ x = ($$$) f x f :: (C a) => a -> a
tests/annotations/ClassInstances.hs.golden view
@@ -1,9 +1,9 @@ D at 3:6 is a type or class defined here a at 3:8 is none D at 3:12 is a value bound here-Bool at 3:14 is not in scope-Bool at 3:14 is not in scope-a at 3:19 is none+DataType at 3:14 is a global data type, Prelude.DataType+DataType at 3:14 is a global data type, Prelude.DataType+a at 3:23 is none C at 5:7 is a type or class defined here a at 5:9 is none wiggle at 6:5 is a value bound here@@ -11,56 +11,65 @@ a at 6:20 is none woe at 7:5 is a value bound here a at 7:12 is none-$$$ at 8:5 is a value bound here-a at 8:14 is none-a at 8:19 is none-a at 8:24 is none-C at 10:11 is a global type class, ClassInstances.C-C at 10:11 is a global type class, ClassInstances.C-a at 10:13 is none-C at 10:19 is a global type class, ClassInstances.C-C at 10:19 is a global type class, ClassInstances.C-D at 10:22 is a global data type, ClassInstances.D-D at 10:22 is a global data type, ClassInstances.D-a at 10:24 is none-wiggle at 11:5 is a global method, ClassInstances.wiggle-D at 11:13 is a global constructor, ClassInstances.D-D at 11:13 is a global constructor, ClassInstances.D-b at 11:15 is a value bound here-a at 11:17 is a value bound here-D at 11:22 is a global constructor, ClassInstances.D-D at 11:22 is a global constructor, ClassInstances.D-b at 11:24 is a local value defined at 11:15-b at 11:24 is a local value defined at 11:15-f at 11:27 is a global value, ClassInstances.f-f at 11:27 is a global value, ClassInstances.f-a at 11:29 is a local value defined at 11:17-a at 11:29 is a local value defined at 11:17-woe at 12:5 is a global method, ClassInstances.woe-D at 12:11 is a global constructor, ClassInstances.D-D at 12:11 is a global constructor, ClassInstances.D-False at 12:13 is not in scope-False at 12:13 is not in scope-woe at 12:19 is a global method, ClassInstances.woe-woe at 12:19 is a global method, ClassInstances.woe-f at 13:5 is a value bound here-$$$ at 13:7 is a global method, ClassInstances.($$$)-x at 13:11 is a value bound here-$$$ at 13:15 is a global method, ClassInstances.($$$)-$$$ at 13:15 is a global method, ClassInstances.($$$)-f at 13:21 is a local value defined at 13:5-f at 13:21 is a local value defined at 13:5-x at 13:23 is a local value defined at 13:11-x at 13:23 is a local value defined at 13:11-f at 15:1 is a global value, ClassInstances.f-C at 15:7 is a global type class, ClassInstances.C-C at 15:7 is a global type class, ClassInstances.C-a at 15:9 is none-a at 15:15 is none-a at 15:20 is none-f at 16:1 is a value bound here-x at 16:3 is a value bound here-wiggle at 16:7 is a global method, ClassInstances.wiggle-wiggle at 16:7 is a global method, ClassInstances.wiggle-x at 16:14 is a local value defined at 16:3-x at 16:14 is a local value defined at 16:3+method1 at 8:5 is a value bound here+a at 8:16 is none+$$$ at 9:5 is a value bound here+a at 9:14 is none+a at 9:19 is none+a at 9:24 is none+C at 11:11 is a global type class, ClassInstances.C+C at 11:11 is a global type class, ClassInstances.C+a at 11:13 is none+C at 11:19 is a global type class, ClassInstances.C+C at 11:19 is a global type class, ClassInstances.C+D at 11:22 is a global data type, ClassInstances.D+D at 11:22 is a global data type, ClassInstances.D+a at 11:24 is none+wiggle at 12:5 is a global method, ClassInstances.wiggle+D at 12:13 is a global constructor, ClassInstances.D+D at 12:13 is a global constructor, ClassInstances.D+b at 12:15 is a value bound here+a at 12:17 is a value bound here+D at 12:22 is a global constructor, ClassInstances.D+D at 12:22 is a global constructor, ClassInstances.D+b at 12:24 is a local value defined at 12:15+b at 12:24 is a local value defined at 12:15+f at 12:27 is a global value, ClassInstances.f+f at 12:27 is a global value, ClassInstances.f+a at 12:29 is a local value defined at 12:17+a at 12:29 is a local value defined at 12:17+woe at 13:5 is a global method, ClassInstances.woe+D at 13:11 is a global constructor, ClassInstances.D+D at 13:11 is a global constructor, ClassInstances.D+Constructor1 at 13:13 is a global constructor, Prelude.Constructor1+Constructor1 at 13:13 is a global constructor, Prelude.Constructor1+woe at 13:26 is a global method, ClassInstances.woe+woe at 13:26 is a global method, ClassInstances.woe+method1 at 14:5 is a global method, ClassInstances.method1+D at 14:15 is a global constructor, ClassInstances.D+D at 14:15 is a global constructor, ClassInstances.D+Constructor1 at 14:17 is a global constructor, Prelude.Constructor1+Constructor1 at 14:17 is a global constructor, Prelude.Constructor1+woe at 14:30 is a global method, ClassInstances.woe+woe at 14:30 is a global method, ClassInstances.woe+f at 15:5 is a value bound here+$$$ at 15:7 is a global method, ClassInstances.($$$)+x at 15:11 is a value bound here+$$$ at 15:15 is a global method, ClassInstances.($$$)+$$$ at 15:15 is a global method, ClassInstances.($$$)+f at 15:21 is a local value defined at 15:5+f at 15:21 is a local value defined at 15:5+x at 15:23 is a local value defined at 15:11+x at 15:23 is a local value defined at 15:11+f at 17:1 is a global value, ClassInstances.f+C at 17:7 is a global type class, ClassInstances.C+C at 17:7 is a global type class, ClassInstances.C+a at 17:9 is none+a at 17:15 is none+a at 17:20 is none+f at 18:1 is a value bound here+x at 18:3 is a value bound here+wiggle at 18:7 is a global method, ClassInstances.wiggle+wiggle at 18:7 is a global method, ClassInstances.wiggle+x at 18:14 is a local value defined at 18:3+x at 18:14 is a local value defined at 18:3
+ tests/annotations/PatternSynonyms.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE PatternSynonyms, NamedFieldPuns #-}++module PatternSynonyms where+++data Type = App String [Type]++pattern Arrow t1 t2 = App "->" [t1, t2]+pattern Int = App "Int" []+pattern Maybe t = App "Maybe" [t]++collectArgs :: Type -> [Type]+collectArgs (Arrow t1 t2) = t1 : collectArgs t2+collectArgs _ = []++isInt :: Type -> Bool+isInt Int = True+isInt _ = False++isIntEndo :: Type -> Bool+isIntEndo (Arrow Int Int) = True+isIntEndo _ = False++intEndo :: Type+intEndo = Arrow Int Int++pattern Head x <- x:xs++pattern HeadC x <- x:xs where+ HeadC x = [x]++pattern Point :: Int -> Int -> (Int, Int)+pattern Point{x, y} = (x, y)++zero = Point 0 0+zero' = Point { x = 0, y = 0}+isZero (Point 0 0) = True+isZero' (Point { x = 0, y = 0 }) = True+getX (Point {x}) = x+setX = (0, 0) { x = 1 } == (1,0)+getX' = x (0,0) == 0+
+ tests/annotations/PatternSynonyms.hs.golden view
@@ -0,0 +1,159 @@+PatternSynonyms at 1:14 is none+NamedFieldPuns at 1:31 is none+Type at 6:6 is a type or class defined here+App at 6:13 is a value bound here+String at 6:17 is not in scope+String at 6:17 is not in scope+Type at 6:25 is a global data type, PatternSynonyms.Type+Type at 6:25 is a global data type, PatternSynonyms.Type+Arrow at 8:9 is a value bound here+Arrow at 8:9 is a value bound here+t1 at 8:15 is a value bound here+t2 at 8:18 is a value bound here+App at 8:23 is a global constructor, PatternSynonyms.App+App at 8:23 is a global constructor, PatternSynonyms.App+t1 at 8:33 is a local value defined at 8:15+t2 at 8:37 is a local value defined at 8:18+Int at 9:9 is a value bound here+Int at 9:9 is a value bound here+App at 9:15 is a global constructor, PatternSynonyms.App+App at 9:15 is a global constructor, PatternSynonyms.App+Maybe at 10:9 is a value bound here+Maybe at 10:9 is a value bound here+t at 10:15 is a value bound here+App at 10:19 is a global constructor, PatternSynonyms.App+App at 10:19 is a global constructor, PatternSynonyms.App+t at 10:32 is a local value defined at 10:15+collectArgs at 12:1 is a global value, PatternSynonyms.collectArgs+Type at 12:16 is a global data type, PatternSynonyms.Type+Type at 12:16 is a global data type, PatternSynonyms.Type+Type at 12:25 is a global data type, PatternSynonyms.Type+Type at 12:25 is a global data type, PatternSynonyms.Type+collectArgs at 13:1 is a value bound here+Arrow at 13:14 is a global pattern constructor, PatternSynonyms.Arrow+Arrow at 13:14 is a global pattern constructor, PatternSynonyms.Arrow+t1 at 13:20 is a value bound here+t2 at 13:23 is a value bound here+t1 at 13:29 is a local value defined at 13:20+t1 at 13:29 is a local value defined at 13:20+: at 13:32 is none+collectArgs at 13:34 is a global value, PatternSynonyms.collectArgs+collectArgs at 13:34 is a global value, PatternSynonyms.collectArgs+t2 at 13:46 is a local value defined at 13:23+t2 at 13:46 is a local value defined at 13:23+collectArgs at 14:1 is a value bound here+isInt at 16:1 is a global value, PatternSynonyms.isInt+Type at 16:10 is a global data type, PatternSynonyms.Type+Type at 16:10 is a global data type, PatternSynonyms.Type+Bool at 16:18 is not in scope+Bool at 16:18 is not in scope+isInt at 17:1 is a value bound here+Int at 17:7 is a global pattern constructor, PatternSynonyms.Int+Int at 17:7 is a global pattern constructor, PatternSynonyms.Int+True at 17:13 is not in scope+True at 17:13 is not in scope+isInt at 18:1 is a value bound here+False at 18:13 is not in scope+False at 18:13 is not in scope+isIntEndo at 20:1 is a global value, PatternSynonyms.isIntEndo+Type at 20:14 is a global data type, PatternSynonyms.Type+Type at 20:14 is a global data type, PatternSynonyms.Type+Bool at 20:22 is not in scope+Bool at 20:22 is not in scope+isIntEndo at 21:1 is a value bound here+Arrow at 21:12 is a global pattern constructor, PatternSynonyms.Arrow+Arrow at 21:12 is a global pattern constructor, PatternSynonyms.Arrow+Int at 21:18 is a global pattern constructor, PatternSynonyms.Int+Int at 21:18 is a global pattern constructor, PatternSynonyms.Int+Int at 21:22 is a global pattern constructor, PatternSynonyms.Int+Int at 21:22 is a global pattern constructor, PatternSynonyms.Int+True at 21:29 is not in scope+True at 21:29 is not in scope+isIntEndo at 22:1 is a value bound here+False at 22:29 is not in scope+False at 22:29 is not in scope+intEndo at 24:1 is a global value, PatternSynonyms.intEndo+Type at 24:12 is a global data type, PatternSynonyms.Type+Type at 24:12 is a global data type, PatternSynonyms.Type+intEndo at 25:1 is a value bound here+Arrow at 25:11 is a global pattern constructor, PatternSynonyms.Arrow+Arrow at 25:11 is a global pattern constructor, PatternSynonyms.Arrow+Int at 25:17 is a global pattern constructor, PatternSynonyms.Int+Int at 25:17 is a global pattern constructor, PatternSynonyms.Int+Int at 25:21 is a global pattern constructor, PatternSynonyms.Int+Int at 25:21 is a global pattern constructor, PatternSynonyms.Int+Head at 27:9 is a value bound here+Head at 27:9 is a value bound here+x at 27:14 is a value bound here+x at 27:19 is a local value defined at 27:14+: at 27:20 is none+xs at 27:21 is none+HeadC at 29:9 is a value bound here+HeadC at 29:9 is a value bound here+x at 29:15 is a value bound here+x at 29:20 is a local value defined at 29:15+: at 29:21 is none+xs at 29:22 is none+HeadC at 30:3 is a global pattern constructor, PatternSynonyms.HeadC+HeadC at 30:3 is a global pattern constructor, PatternSynonyms.HeadC+x at 30:9 is a value bound here+x at 30:14 is a global pattern selector, PatternSynonyms.x+x at 30:14 is a global pattern selector, PatternSynonyms.x+Point at 32:9 is none+Int at 32:18 is not in scope+Int at 32:18 is not in scope+Int at 32:25 is not in scope+Int at 32:25 is not in scope+Int at 32:33 is not in scope+Int at 32:33 is not in scope+Int at 32:38 is not in scope+Int at 32:38 is not in scope+Point at 33:9 is a value bound here+Point at 33:9 is a value bound here+x at 33:15 is a value bound here+x at 33:15 is a value bound here+y at 33:18 is a value bound here+y at 33:18 is a value bound here+x at 33:24 is a local value defined at 33:15+y at 33:27 is a local value defined at 33:18+zero at 35:1 is a value bound here+Point at 35:8 is a global pattern constructor, PatternSynonyms.Point+Point at 35:8 is a global pattern constructor, PatternSynonyms.Point+zero' at 36:1 is a value bound here+Point at 36:9 is a global pattern constructor, PatternSynonyms.Point+Point at 36:9 is a global pattern constructor, PatternSynonyms.Point+x at 36:17 is a global pattern selector, PatternSynonyms.x+x at 36:17 is a global pattern selector, PatternSynonyms.x+y at 36:24 is a global pattern selector, PatternSynonyms.y+y at 36:24 is a global pattern selector, PatternSynonyms.y+isZero at 37:1 is a value bound here+Point at 37:9 is a global pattern constructor, PatternSynonyms.Point+Point at 37:9 is a global pattern constructor, PatternSynonyms.Point+True at 37:22 is not in scope+True at 37:22 is not in scope+isZero' at 38:1 is a value bound here+Point at 38:10 is a global pattern constructor, PatternSynonyms.Point+Point at 38:10 is a global pattern constructor, PatternSynonyms.Point+x at 38:18 is a global pattern selector, PatternSynonyms.x+x at 38:18 is a global pattern selector, PatternSynonyms.x+y at 38:25 is a global pattern selector, PatternSynonyms.y+y at 38:25 is a global pattern selector, PatternSynonyms.y+True at 38:36 is not in scope+True at 38:36 is not in scope+getX at 39:1 is a value bound here+Point at 39:7 is a global pattern constructor, PatternSynonyms.Point+Point at 39:7 is a global pattern constructor, PatternSynonyms.Point+x at 39:14 is a global pattern selector, PatternSynonyms.x+x at 39:14 is a global pattern selector, PatternSynonyms.x+x at 39:20 is a local value defined at 39:14+x at 39:20 is a local value defined at 39:14+setX at 40:1 is a value bound here+x at 40:17 is a global pattern selector, PatternSynonyms.x+x at 40:17 is a global pattern selector, PatternSynonyms.x+== at 40:25 is not in scope+== at 40:25 is not in scope+getX' at 41:1 is a value bound here+x at 41:9 is a global pattern selector, PatternSynonyms.x+x at 41:9 is a global pattern selector, PatternSynonyms.x+== at 41:17 is not in scope+== at 41:17 is not in scope
+ tests/annotations/RecordFieldUpdate.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-}+module RecordFieldUpdate where+data Record a = Record { field :: a }+record1 field = r+ where r = Record { field = field }+record2 field = r+ where r = Record { field }+record3 field = r+ where r = Record { .. }
+ tests/annotations/RecordFieldUpdate.hs.golden view
@@ -0,0 +1,35 @@+RecordWildCards at 1:14 is none+NamedFieldPuns at 2:14 is none+Record at 4:6 is a type or class defined here+a at 4:13 is none+Record at 4:17 is a value bound here+field at 4:26 is a value bound here+a at 4:35 is none+record1 at 5:1 is a value bound here+field at 5:9 is a value bound here+r at 5:17 is a local value defined at 6:9+r at 5:17 is a local value defined at 6:9+r at 6:9 is a value bound here+Record at 6:13 is a global constructor, RecordFieldUpdate.Record+Record at 6:13 is a global constructor, RecordFieldUpdate.Record+field at 6:22 is a global selector, RecordFieldUpdate.field+field at 6:22 is a global selector, RecordFieldUpdate.field+field at 6:30 is a local value defined at 5:9+field at 6:30 is a local value defined at 5:9+record2 at 7:1 is a value bound here+field at 7:9 is a value bound here+r at 7:17 is a local value defined at 8:9+r at 7:17 is a local value defined at 8:9+r at 8:9 is a value bound here+Record at 8:13 is a global constructor, RecordFieldUpdate.Record+Record at 8:13 is a global constructor, RecordFieldUpdate.Record+field at 8:22 is a global selector, RecordFieldUpdate.field+field at 8:22 is a global selector, RecordFieldUpdate.field+record3 at 9:1 is a value bound here+field at 9:9 is a value bound here+r at 9:17 is a local value defined at 10:9+r at 9:17 is a local value defined at 10:9+r at 10:9 is a value bound here+Record at 10:13 is a global constructor, RecordFieldUpdate.Record+Record at 10:13 is a global constructor, RecordFieldUpdate.Record+.. at 10:22 is a record construction wildcard which assigns the following fields: RecordFieldUpdate.field = (a local value defined at 9:9)
+ tests/annotations/RecordPattern.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-}+module RecordPattern where+data Record a = Record { field :: a }+unRecord1 r = field+ where Record { field = field } = r+unRecord2 r = field+ where Record { field } = r+unRecord3 r = field+ where Record { .. } = r
+ tests/annotations/RecordPattern.hs.golden view
@@ -0,0 +1,37 @@+RecordWildCards at 1:14 is none+NamedFieldPuns at 2:14 is none+Record at 4:6 is a type or class defined here+a at 4:13 is none+Record at 4:17 is a value bound here+field at 4:26 is a value bound here+a at 4:35 is none+unRecord1 at 5:1 is a value bound here+r at 5:11 is a value bound here+field at 5:15 is a local value defined at 6:26+field at 5:15 is a local value defined at 6:26+Record at 6:9 is a global constructor, RecordPattern.Record+Record at 6:9 is a global constructor, RecordPattern.Record+field at 6:18 is a global selector, RecordPattern.field+field at 6:18 is a global selector, RecordPattern.field+field at 6:26 is a value bound here+r at 6:36 is a local value defined at 5:11+r at 6:36 is a local value defined at 5:11+unRecord2 at 7:1 is a value bound here+r at 7:11 is a value bound here+field at 7:15 is a local value defined at 8:18+field at 7:15 is a local value defined at 8:18+Record at 8:9 is a global constructor, RecordPattern.Record+Record at 8:9 is a global constructor, RecordPattern.Record+field at 8:18 is a global selector, RecordPattern.field+field at 8:18 is a global selector, RecordPattern.field+r at 8:28 is a local value defined at 7:11+r at 8:28 is a local value defined at 7:11+unRecord3 at 9:1 is a value bound here+r at 9:11 is a value bound here+field at 9:15 is a local value defined at 10:18+field at 9:15 is a local value defined at 10:18+Record at 10:9 is a global constructor, RecordPattern.Record+Record at 10:9 is a global constructor, RecordPattern.Record+.. at 10:18 is a record pattern wildcard which brings the following fields: RecordPattern.field+r at 10:25 is a local value defined at 9:11+r at 10:25 is a local value defined at 9:11
tests/annotations/Records.hs view
@@ -17,9 +17,9 @@ -- pattern pun g A {b} = b --- top-level pattern pun-A { tx } = undefined-ty = tx+-- top-level pattern pun clashes with selector+-- A { c } = undefined+ty = c -- expression pun tz = let b = 1 in A { b }
tests/annotations/Records.hs.golden view
@@ -43,21 +43,15 @@ b at 18:6 is a global selector, Records.b b at 18:11 is a local value defined at 18:6 b at 18:11 is a local value defined at 18:6-A at 21:1 is a global constructor, Records.A-A at 21:1 is a global constructor, Records.A-tx at 21:5 is a global value, Records.tx-tx at 21:5 is a global value, Records.tx-undefined at 21:12 is a global value, Records.undefined-undefined at 21:12 is a global value, Records.undefined ty at 22:1 is a value bound here-tx at 22:6 is a global value, Records.tx-tx at 22:6 is a global value, Records.tx+c at 22:6 is a global selector, Records.c+c at 22:6 is a global selector, Records.c tz at 25:1 is a value bound here b at 25:10 is a value bound here A at 25:19 is a global constructor, Records.A A at 25:19 is a global constructor, Records.A-b at 25:23 is a local value defined at 25:10-b at 25:23 is a local value defined at 25:10+b at 25:23 is a global selector, Records.b+b at 25:23 is a global selector, Records.b h at 28:1 is a value bound here A at 28:4 is a global constructor, Records.A A at 28:4 is a global constructor, Records.A@@ -75,8 +69,8 @@ v at 31:17 is a value bound here A at 31:26 is a global constructor, Records.A A at 31:26 is a global constructor, Records.A-b at 31:30 is a local value defined at 31:10-b at 31:30 is a local value defined at 31:10+b at 31:30 is a global selector, Records.b+b at 31:30 is a global selector, Records.b c at 31:33 is a global selector, Records.c c at 31:33 is a global selector, Records.c v at 31:37 is a local value defined at 31:17@@ -124,14 +118,14 @@ b at 51:10 is a value bound here A at 51:19 is a global constructor, Records.A A at 51:19 is a global constructor, Records.A-.. at 51:23 is a record construction wildcard which assigns the following fields: b = (a local value defined at 51:10)+.. at 51:23 is a record construction wildcard which assigns the following fields: Records.b = (a local value defined at 51:10) r2 at 55:1 is a value bound here selector2 at 55:10 is a value bound here undefined at 55:22 is a global value, Records.undefined undefined at 55:22 is a global value, Records.undefined DataTypeWithSelectors at 55:35 is a global constructor, Prelude.DataTypeWithSelectors DataTypeWithSelectors at 55:35 is a global constructor, Prelude.DataTypeWithSelectors-.. at 55:67 is a record construction wildcard which assigns the following fields: selector1 = (a global value, Records.selector1), selector2 = (a local value defined at 55:10)+.. at 55:67 is a record construction wildcard which assigns the following fields: Prelude.selector1 = (a global value, Records.selector1), Prelude.selector2 = (a local value defined at 55:10) r3 at 58:1 is a value bound here b at 58:10 is a value bound here undefined at 58:14 is a global value, Records.undefined@@ -142,7 +136,7 @@ c at 58:31 is a global selector, Records.c undefined at 58:35 is a global value, Records.undefined undefined at 58:35 is a global value, Records.undefined-.. at 58:46 is a record construction wildcard which assigns the following fields: b = (a local value defined at 58:10)+.. at 58:46 is a record construction wildcard which assigns the following fields: Records.b = (a local value defined at 58:10) r4 at 61:1 is a value bound here b at 61:11 is a value bound here c at 61:13 is a value bound here@@ -150,9 +144,9 @@ undefined at 61:18 is a global value, Records.undefined A at 61:31 is a global constructor, Records.A A at 61:31 is a global constructor, Records.A-c at 61:35 is a local value defined at 61:13-c at 61:35 is a local value defined at 61:13-.. at 61:38 is a record construction wildcard which assigns the following fields: b = (a local value defined at 61:11)+c at 61:35 is a global selector, Records.c+c at 61:35 is a global selector, Records.c+.. at 61:38 is a record construction wildcard which assigns the following fields: Records.b = (a local value defined at 61:11) r5 at 64:1 is a value bound here b at 64:11 is a value bound here xxx at 64:14 is a value bound here@@ -160,4 +154,4 @@ undefined at 64:21 is a global value, Records.undefined A at 64:34 is a global constructor, Records.A A at 64:34 is a global constructor, Records.A-.. at 64:38 is a record construction wildcard which assigns the following fields: b = (a local value defined at 64:11)+.. at 64:38 is a record construction wildcard which assigns the following fields: Records.b = (a local value defined at 64:11)
+ tests/annotations/WildcardsQualified.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE RecordWildCards #-}+module WildcardsQualified where++import qualified Prelude as P (DataTypeWithSelectors(DataTypeWithSelectors,selector1))++u :: DataTypeWithSelectors -> ()+u P.DataTypeWithSelectors{..} = let x = selector1 in ()+
+ tests/annotations/WildcardsQualified.hs.golden view
@@ -0,0 +1,16 @@+RecordWildCards at 1:14 is none+DataTypeWithSelectors at 4:32 is import part for a global data type, Prelude.DataTypeWithSelectors+DataTypeWithSelectors at 4:54 is a global constructor, Prelude.DataTypeWithSelectors+selector1 at 4:76 is a global selector, Prelude.selector1+u at 6:1 is a global value, WildcardsQualified.u+DataTypeWithSelectors at 6:6 is not in scope+DataTypeWithSelectors at 6:6 is not in scope+() at 6:31 is none+u at 7:1 is a value bound here+DataTypeWithSelectors at 7:3 is a global constructor, Prelude.DataTypeWithSelectors+DataTypeWithSelectors at 7:3 is a global constructor, Prelude.DataTypeWithSelectors+.. at 7:27 is a record pattern wildcard which brings the following fields: Prelude.selector1+x at 7:37 is a value bound here+selector1 at 7:41 is a local value defined at 7:27+selector1 at 7:41 is a local value defined at 7:27+() at 7:54 is none
tests/exports/DataFamilies.hs.golden view
@@ -17,11 +17,6 @@ , symbolName = Ident () "method1" , className = Ident () "ListLike" }-, DataFam- { symbolModule = ModuleName () "DataFamilies"- , symbolName = Ident () "Vector"- , associate = Nothing- } , Constructor { symbolModule = ModuleName () "DataFamilies" , symbolName = Ident () "U_Vector"
+ tests/exports/DuplicateExports.hs view
@@ -0,0 +1,4 @@+module DuplicateExports (A(A), A) where++data A = A+
+ tests/exports/DuplicateExports.hs.golden view
@@ -0,0 +1,10 @@+[ Data+ { symbolModule = ModuleName () "DuplicateExports"+ , symbolName = Ident () "A"+ }+, Constructor+ { symbolModule = ModuleName () "DuplicateExports"+ , symbolName = Ident () "A"+ , typeName = Ident () "A"+ }+]
+ tests/exports/ExportAmbiguous.hs view
@@ -0,0 +1,6 @@+module ExportAmbiguous (DataType(..)) where++import qualified Prelude (DataType(..))+import Prelude hiding (DataType(..))++data DataType = Constructor1 | Constructor2
+ tests/exports/ExportAmbiguous.hs.golden view
@@ -0,0 +1,15 @@+[ Data+ { symbolModule = ModuleName () "ExportAmbiguous"+ , symbolName = Ident () "DataType"+ }+, Constructor+ { symbolModule = ModuleName () "ExportAmbiguous"+ , symbolName = Ident () "Constructor1"+ , typeName = Ident () "DataType"+ }+, Constructor+ { symbolModule = ModuleName () "ExportAmbiguous"+ , symbolName = Ident () "Constructor2"+ , typeName = Ident () "DataType"+ }+]
tests/exports/ExportListMembers.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE MultiParamTypeClasses #-}+ module ExportListMembers (Foo(Foo1, Foo3, c), Bar(x), N(N)) where data Foo = Foo1 | Foo2 { c :: Bool } | Foo3 { d :: Bool }
tests/exports/Prelude.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE MultiParamTypeClasses #-}+ module Prelude where data DataType = Constructor1 | Constructor2
tests/run.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances, OverlappingInstances, ImplicitParams,- MultiParamTypeClasses, FlexibleContexts, GADTs #-}+ MultiParamTypeClasses, FlexibleContexts, GADTs,+ TypeApplications #-} -- GHC 7.8 fails with the default context stack size of 20 {-# OPTIONS_GHC -fcontext-stack=50 #-} import Test.Tasty hiding (defaultMain)@@ -22,7 +23,7 @@ import Text.Printf import qualified Data.Foldable as F -import Language.Haskell.Exts hiding (DataOrNew(NewType))+import Language.Haskell.Exts hiding (DataOrNew(NewType), PatSyn) import qualified Language.Haskell.Exts.Syntax as Syntax (DataOrNew(NewType)) import qualified Language.Haskell.Exts as U (ModuleName(ModuleName)) import Language.Haskell.Names@@ -135,7 +136,6 @@ :: Rec TestAnn (a (Scoped SrcSpan)) => a (Scoped SrcSpan) -> String printAnns =- let ?c = Proxy :: Proxy (Rec TestAnn) in let -- format one annotation one :: TestAnn a => a -> String@@ -143,7 +143,7 @@ flip F.foldMap (getAnn a) $ uncurry formatAnn -- tie the knot go :: Rec TestAnn a => a -> String- go a = one a ++ gfoldMap go a+ go a = one a ++ gfoldMap @(Rec TestAnn) go a in go -----------------------@@ -167,6 +167,8 @@ formatSymbol TypeFam {} = "type family" formatSymbol DataFam {} = "data family" formatSymbol Class {} = "type class"+formatSymbol PatternConstructor {} = "pattern constructor"+formatSymbol PatternSelector {} = "pattern selector" formatInfo :: NameInfo SrcSpan -> String formatInfo (LocalValue loc) =@@ -185,8 +187,8 @@ printf "a record construction wildcard which assigns the following fields: %s" $ intercalate ", "- [ printf "%s = (%s)" (prettyPrint field) valueDesc- | (field, vinfo) <- symbols+ [ printf "%s = (%s)" (ppSymbol symbol) valueDesc+ | (symbol, vinfo) <- symbols , let valueDesc = formatInfo vinfo ] formatInfo (ScopeError (ENotInScope {})) = "not in scope"