packages feed

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 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"