packages feed

haskell-names 0.6.0 → 0.7.0

raw patch · 12 files changed

+153/−186 lines, 12 filesdep +taggeddep ~aesondep ~haskell-namesdep ~transformers

Dependencies added: tagged

Dependency ranges changed: aeson, haskell-names, transformers

Files

CHANGELOG.md view
@@ -1,6 +1,14 @@ Changes ======= +Version 0.7.0+-------------++* Improve annotation performance+* Relax bounds on aeson+* Relax bounds on transformers+* Bugfixes+ Version 0.6.0 -------------
README.md view
@@ -5,9 +5,9 @@  Namely, it can do the following: -* for a liat of modules, compute the lists of symbols they export.+* For a list of modules, compute the list of symbols each module exports.   This is called `resolve`.-* for each name in a module, figure out what it refers to — whether it's bound+* For each name in a module, figure out what it refers to — whether it's bound   locally (say, by a `where` clause) or globally (and then give its origin).   This is called `annotate`. @@ -23,8 +23,8 @@ Environments ----------------- -An environment is a map from module name to list of entities the module exports.-Entities are for example types, class, functions etc. We store these lists in+An environment is a map from module name to list of symbols the module exports.+Symbols are for example types, classes, functions etc. We persist these lists in a JSON format. For example, here are a couple of entries from `Prelude.names`: @@ -150,8 +150,6 @@     Congratulations! Your code doesn't use Prelude.head  ### API documentation--See [haskell-names haddock documentation][doc-index].  The core module you need is [Language.Haskell.Names][]
haskell-names.cabal view
@@ -1,16 +1,17 @@ Name:                   haskell-names-Version:                0.6.0+Version:                0.7.0 License:                BSD3 Author:                 Philipp Schuster, Roman Cheplyaka, Lennart Augustsson Maintainer:             Philipp Schuster Category:               Language Synopsis:               Name resolution library for Haskell Description:-  This package takes modules parsed with `haskell-src-exts`, resolves used names and annotates the parsed module with scoping information. +  This package takes modules parsed with `haskell-src-exts`, resolves used names and annotates the parsed module with scoping information. Homepage:               http://documentup.com/haskell-suite/haskell-names Stability:              Experimental Build-Type:             Simple Cabal-Version:          >= 1.10+Tested-With:            GHC == 7.8.4, GHC == 7.10.1, GHC == 8.0.1  extra-source-files:   README.md@@ -236,14 +237,16 @@       base >= 4 && < 5     , haskell-src-exts >= 1.17 && < 1.18     , mtl >= 2.2.1 && < 2.3-    , transformers >=0.4.2.0 && < 0.5+    , 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 && < 0.11+    , aeson >= 0.8.0.2 && < 0.12     , 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 >= 0.2.0.3 && < 0.3+  if impl(ghc <= 7.8)+    Build-depends: tagged >= 0.8.4 && < 0.9   Hs-source-dirs:       src   Ghc-options:          -Wall -fno-warn-name-shadowing @@ -287,5 +290,5 @@     , filemanip >= 0.3.6.3 && < 0.4     , pretty-show >= 1.6.1 && < 1.7     , traverse-with-class >= 0.2.0.3 && < 0.3-    , haskell-names >= 0.6.0 && < 0.7+    , haskell-names >= 0.7.0 && < 0.8
src/Language/Haskell/Names/Annotated.hs view
@@ -42,32 +42,18 @@ annotateRec _ sc a = go sc a where   go :: forall a . Resolvable a => Scope -> a -> a   go sc a-    | ReferenceV <- getL nameCtx sc-    , Just (Refl :: QName (Scoped l) :~: a) <- eqT-      = lookupValue (fmap sLoc a) sc <$ a-    | ReferenceT <- getL nameCtx sc-    , Just (Refl :: QName (Scoped l) :~: a) <- eqT-      = lookupType (fmap sLoc a) sc <$ a-    | ReferenceUV <- getL nameCtx sc-    , Just (Refl :: Name (Scoped l) :~: a) <- eqT-      = lookupMethod (fmap sLoc a) sc <$ a-    | ReferenceUT <- getL nameCtx sc-    , Just (Refl :: QName (Scoped l) :~: a) <- eqT-      = lookupAssociatedType (fmap sLoc a) sc <$ a-    | BindingV <- getL nameCtx sc-    , Just (Refl :: Name (Scoped l) :~: a) <- eqT-      = Scoped ValueBinder (sLoc . ann $ a) <$ a-    | BindingT <- getL nameCtx sc-    , Just (Refl :: Name (Scoped l) :~: a) <- eqT-      = Scoped TypeBinder (sLoc . ann $ a) <$ a+    | Just (Refl :: QName (Scoped l) :~: a) <- eqT+      = lookupQName (fmap sLoc a) sc <$ a+    | Just (Refl :: Name (Scoped l) :~: a) <- eqT+      = lookupName (fmap sLoc a) sc <$ a     | Just (Refl :: FieldUpdate (Scoped l) :~: a) <- eqT       = case a of-          FieldPun l n -> FieldPun l (lookupValue (sLoc <$> n) sc <$ n)+          FieldPun l qname -> FieldPun l (lookupQName (sLoc <$> qname) sc <$ qname)           FieldWildcard l -> FieldWildcard (Scoped (RecExpWildcard namesRes) (sLoc l)) where             namesRes = do                 f <- sc ^. wcNames-                let qn = setAnn (sLoc l) (UnQual () (annName (wcFieldName f)))-                case lookupValue qn sc of+                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)                     _ -> []@@ -77,60 +63,74 @@       = let             namesRes = do                 f <- sc ^. wcNames-                let qn = UnQual () (annName (wcFieldName f))-                Scoped (GlobalSymbol symbol _) _ <- return (lookupValue qn sc)+                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))            +        in PFieldWildcard (Scoped (RecPatWildcard namesRes) (sLoc l))     | otherwise       = rmap go sc a -lookupValue :: QName l -> Scope -> Scoped l-lookupValue (Special l _) _ = Scoped None l-lookupValue qn sc = Scoped nameInfo (ann qn)-  where-    nameInfo =-      case Local.lookupValue qn $ getL lTable sc of-        Right r -> LocalValue r-        _ ->-          case Global.lookupValue qn $ getL gTable sc of-            Global.SymbolFound r -> GlobalSymbol r (sQName qn)-            Global.Error e -> ScopeError e-            Global.Special -> None -lookupType :: QName l -> Scope -> Scoped l-lookupType (Special l _) _ = Scoped None l-lookupType qn sc = Scoped nameInfo (ann qn)-  where-    nameInfo =-      case Global.lookupType qn $ getL gTable sc of-        Global.SymbolFound r -> GlobalSymbol r (sQName qn)-        Global.Error e -> ScopeError e-        Global.Special -> None+lookupQName :: QName l -> Scope -> Scoped l+lookupQName (Special l _) _ = Scoped None l+lookupQName qname scope = Scoped nameInfo (ann qname) where -lookupMethod :: Name l -> Scope -> Scoped l-lookupMethod n sc = Scoped nameInfo (ann qn)-  where-    nameInfo =-      case Global.lookupMethodOrAssociate qn $ getL gTable sc of-        Global.SymbolFound r -> GlobalSymbol r (sQName qn)-        Global.Error e -> ScopeError e-        Global.Special -> None-    qn = qualifyName (getL instQual sc) n+  nameInfo = case getL nameCtx scope of -lookupAssociatedType :: QName l -> Scope -> Scoped l-lookupAssociatedType qn sc = Scoped nameInfo (ann qn)-  where-    nameInfo =-      case Global.lookupMethodOrAssociate qn' $ getL gTable sc of-        Global.SymbolFound r -> GlobalSymbol r (sQName qn)-        Global.Error e -> ScopeError e-        Global.Special -> None-    qn' = case qn of-        UnQual _ n -> qualifyName (getL instQual sc) n-        _ -> qn+    ReferenceV -> case Local.lookupValue qname (getL lTable scope) of+      Right srcloc -> LocalValue srcloc+      _ ->+        checkUniqueness (Global.lookupValue qname globalTable) +    ReferenceT ->+      checkUniqueness (Global.lookupType qname globalTable)++    ReferenceUT ->+      checkUniqueness (Global.lookupMethodOrAssociate qname' globalTable) where+        qname' = case qname of+          UnQual _ name -> qualifyName (getL instQual scope) name+          _ -> qname++    _ -> None++  globalTable = getL gTable scope++  checkUniqueness symbols = case symbols of+    [] -> ScopeError (ENotInScope qname)+    [symbol] -> GlobalSymbol symbol (sQName qname)+    _ -> ScopeError (EAmbiguous qname symbols)+++lookupName :: Name l -> Scope -> Scoped l+lookupName name scope = Scoped nameInfo (ann name) where++  nameInfo = case getL nameCtx scope of++    ReferenceUV ->+      checkUniqueness qname (Global.lookupMethodOrAssociate qname globalTable) where+        qname = qualifyName (getL instQual scope) name++    SignatureV ->+      checkUniqueness qname (Global.lookupValue qname globalTable) where+        qname = qualifyName (Just (getL moduName scope)) name++    BindingV -> ValueBinder++    BindingT -> TypeBinder++    _ -> None++  globalTable = getL gTable scope++  checkUniqueness qname symbols = case symbols of+    [] -> ScopeError (ENotInScope qname)+    [symbol] -> GlobalSymbol symbol (sQName qname)+    _ -> ScopeError (EAmbiguous qname symbols)++ qualifyName :: Maybe UnAnn.ModuleName -> Name l -> QName l qualifyName Nothing n = UnQual (ann n) n-qualifyName (Just (UnAnn.ModuleName moduleName)) n = Qual (ann n) annotatedModuleName n-  where+qualifyName (Just (UnAnn.ModuleName moduleName)) n =+  Qual (ann n) annotatedModuleName n where     annotatedModuleName = ModuleName (ann n) moduleName+
src/Language/Haskell/Names/Exports.hs view
@@ -31,52 +31,13 @@  exportSpecSymbols :: Global.Table -> ExportSpec l -> [Symbol] exportSpecSymbols globalTable exportSpec =-  case exportSpec of-    EVar _ qn ->-      case Global.lookupValue qn globalTable of-        Global.Error _ -> []-        Global.SymbolFound i -> [i]-        Global.Special {} -> error "Global.Special in export list?"-    EAbs _ _ qn ->-      case Global.lookupType qn globalTable of-        Global.Error _ -> []-        Global.SymbolFound i -> [i]-        Global.Special {} -> error "Global.Special in export list?"-    EThingAll _ qn ->-      case Global.lookupType qn globalTable of-        Global.Error _ -> []-        Global.SymbolFound i -> [i] ++ subs where-          subs = nub (do-            symbol <- concat (Map.elems globalTable)-            Just n' <- return $ symbolParent symbol-            guard (n' == symbolName i)-            return symbol)-        Global.Special {} -> error "Global.Special in export list?"-    EThingWith _ qn cns ->-      case Global.lookupType qn globalTable of-        Global.Error _ -> []-        Global.SymbolFound i -> [i] ++ subs where-            (_, subs) =-              resolveCNames-                (concat (Map.elems globalTable))-                (symbolName i)-                (\cn -> ENotInScope (UnQual (ann cn) (unCName cn))) -- FIXME better error-                cns-        Global.Special {} -> error "Global.Special in export list?"-    -- FIXME ambiguity check-    EModuleContents _ modulename -> exportedSymbols where--        exportedSymbols = Set.toList (-          Set.intersection inScopeQualified inScopeUnqualified)--        inScopeQualified = Set.fromList (do-            (UnAnn.Qual prefix _, symbols) <- Map.toList globalTable-            guard (prefix == sModuleName modulename)-            symbols)--        inScopeUnqualified = Set.fromList (do-            (UnAnn.UnQual _, symbols) <- Map.toList globalTable-            symbols)+  case annotateExportSpec globalTable exportSpec of+    EVar (Scoped (Export symbols) _) _ -> symbols+    EAbs (Scoped (Export symbols) _) _ _ -> symbols+    EThingAll (Scoped (Export symbols) _) _ -> symbols+    EThingWith (Scoped (Export symbols) _) _ _ -> symbols+    EModuleContents (Scoped (Export symbols) _) _ -> symbols+    _ -> []  -- | Annotate the given export list with scoping information using the given -- table of symbols that are in scope in that module.@@ -89,52 +50,46 @@  case exportSpec of   EVar l qn ->     case Global.lookupValue qn globalTable of-      Global.Error err ->-        scopeError err exportSpec-      Global.SymbolFound i ->-        EVar (Scoped (Export [i]) l)-            (Scoped (GlobalSymbol i (sQName qn)) <$> qn)-      Global.Special {} -> error "Global.Special in export list?"+      [] -> scopeError (ENotInScope qn) exportSpec+      [symbol] -> EVar (Scoped (Export [symbol]) l)+            (Scoped (GlobalSymbol symbol (sQName qn)) <$> qn)+      symbols -> scopeError (EAmbiguous qn symbols) exportSpec   EAbs l ns qn ->     case Global.lookupType qn globalTable of-      Global.Error err ->-        scopeError err exportSpec-      Global.SymbolFound i ->-        EAbs (Scoped (Export [i]) l)+      [] -> scopeError (ENotInScope qn) exportSpec+      [symbol] -> EAbs (Scoped (Export [symbol]) l)             (noScope ns)-            (Scoped (GlobalSymbol i (sQName qn)) <$> qn)-      Global.Special {} -> error "Global.Special in export list?"+            (Scoped (GlobalSymbol symbol (sQName qn)) <$> qn)+      symbols -> scopeError (EAmbiguous qn symbols) exportSpec   EThingAll l qn ->     case Global.lookupType qn globalTable of-      Global.Error err ->-        scopeError err exportSpec-      Global.SymbolFound i ->+      [] -> scopeError (ENotInScope qn) exportSpec+      [symbol] ->         let-          subs = nub (do-              symbol <- concat (Map.elems globalTable)-              Just n' <- return $ symbolParent symbol-              guard (n' == symbolName i)-              return symbol)-          s = [i] <> subs+          subSymbols = nub (do+              subSymbol <- concat (Map.elems globalTable)+              Just n' <- return $ symbolParent subSymbol+              guard (n' == symbolName symbol)+              return subSymbol)+          s = [symbol] <> subSymbols         in-          EThingAll (Scoped (Export s) l) (Scoped (GlobalSymbol i (sQName qn)) <$> qn)-      Global.Special {} -> error "Global.Special in export list?"+          EThingAll (Scoped (Export s) l) (Scoped (GlobalSymbol symbol (sQName qn)) <$> qn)+      symbols -> scopeError (EAmbiguous qn symbols) exportSpec   EThingWith l qn cns ->     case Global.lookupType qn globalTable of-      Global.Error err ->-        scopeError err exportSpec-      Global.SymbolFound i ->+      [] -> scopeError (ENotInScope qn) exportSpec+      [symbol] ->         let-          (cns', subs) =+          (cns', subSymbols) =             resolveCNames               (concat (Map.elems globalTable))-              (symbolName i)+              (symbolName symbol)               (\cn -> ENotInScope (UnQual (ann cn) (unCName cn))) -- FIXME better error               cns-          s = [i] <> subs+          s = [symbol] <> subSymbols         in-          EThingWith (Scoped (Export s) l) (Scoped (GlobalSymbol i (sQName qn)) <$> qn) cns'-      Global.Special {} -> error "Global.Special in export list?"+          EThingWith (Scoped (Export s) l) (Scoped (GlobalSymbol symbol (sQName qn)) <$> qn) cns'+      symbols -> scopeError (EAmbiguous qn symbols) exportSpec   -- FIXME ambiguity check   EModuleContents _ modulename -> Scoped (Export exportedSymbols) <$> exportSpec where
src/Language/Haskell/Names/GlobalSymbolTable.hs view
@@ -12,10 +12,11 @@ import Data.Map (     Map) import qualified Data.Map as Map (-    empty,unionWith,fromListWith,lookup,map)+    empty,unionWith,fromListWith,lookup)  import Control.Arrow import Data.List as List (union)+import Data.Maybe (fromMaybe)  import Language.Haskell.Names.Types @@ -30,29 +31,17 @@ mergeTables :: Table -> Table -> Table mergeTables = Map.unionWith List.union -data Result l-  = SymbolFound Symbol-  | Error (Error l)-  | Special--lookupValue :: Ann.QName l -> Table -> Result l-lookupValue qn = lookupName qn . filterTable isValue--lookupType :: Ann.QName l -> Table -> Result l-lookupType qn = lookupName qn . filterTable isType+lookupValue :: Ann.QName l -> Table -> [Symbol]+lookupValue qn = filter isValue . lookupName qn -lookupMethodOrAssociate :: Ann.QName l -> Table -> Result l-lookupMethodOrAssociate qn = lookupName qn . filterTable isMethodOrAssociated+lookupType :: Ann.QName l -> Table -> [Symbol]+lookupType qn = filter isType . lookupName qn -lookupName :: Ann.QName l -> Table -> Result l-lookupName qn table = case Map.lookup (sQName qn) table of-    Nothing -> Error $ ENotInScope qn-    Just [] -> Error $ ENotInScope qn-    Just [i] -> SymbolFound i-    Just is -> Error $ EAmbiguous qn is+lookupMethodOrAssociate :: Ann.QName l -> Table -> [Symbol]+lookupMethodOrAssociate qn = filter isMethodOrAssociated . lookupName qn -filterTable :: (Symbol -> Bool) -> Table -> Table-filterTable relevant = Map.map (filter relevant)+lookupName :: Ann.QName l -> Table -> [Symbol]+lookupName qn table = fromMaybe [] (Map.lookup (sQName qn) table)  isValue :: Symbol -> Bool isValue symbol = case symbol of
src/Language/Haskell/Names/Open/Base.hs view
@@ -34,9 +34,12 @@       -- Unqualified names also match qualified names in scope       -- https://www.haskell.org/pipermail/haskell-prime/2008-April/002569.html   | ReferenceUT-     -- ^ Reference an associated type in an instance declaration+      -- ^ 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+  | SignatureV+      -- ^ A type signature contains an always unqualified 'Name' that always+      -- refers to a value bound in the same module.   | Other  -- | Contains information about the node's enclosing scope. Can be@@ -45,7 +48,8 @@ -- If we enter an instance with a qualified class name we have to -- remember the qualification to resolve method names. data Scope = Scope-  { _gTable :: Global.Table+  { _moduName :: UnAnn.ModuleName+  , _gTable :: Global.Table   , _lTable :: Local.Table   , _nameCtx :: NameContext   , _instQual :: Maybe UnAnn.ModuleName@@ -55,8 +59,8 @@ makeLens ''Scope  -- | Create an initial scope-initialScope :: Global.Table -> Scope-initialScope tbl = Scope tbl Local.empty Other Nothing []+initialScope :: UnAnn.ModuleName -> Global.Table -> Scope+initialScope moduleName tbl = Scope moduleName tbl Local.empty Other Nothing []  -- | Merge local tables of two scopes. The other fields of the scopes are -- assumed to be the same.@@ -144,6 +148,9 @@  exprT :: Scope -> Scope exprT = setNameCtx ReferenceT++signatureV :: Scope -> Scope+signatureV = setNameCtx SignatureV  exprUV :: Scope -> Scope exprUV = setNameCtx ReferenceUV
src/Language/Haskell/Names/Open/Instances.hs view
@@ -60,9 +60,9 @@       -- FunBind consists of Matches, which we handle below anyway.       TypeSig l names ty ->         c TypeSig-          <|  sc       -: l-          <*> fmap (map qNameToName) (rtraverse (map nameToQName names) (exprV sc))-          <|  sc       -: ty+          <| sc            -: l+          <| signatureV sc -: names+          <| sc            -: ty       InfixDecl l assoc mp ops ->         c InfixDecl           <| sc       -: l
src/Language/Haskell/Names/RecordWildcards.hs view
@@ -50,7 +50,7 @@     -- resolved     (mbConOrigName, mbTypeOrigName) =       case Global.lookupValue con globalTable of-        Global.SymbolFound symbol@Constructor{} ->+        [symbol@Constructor{}] ->           (Just $ symbolName symbol, Just $ typeName symbol)         _ -> (Nothing, Nothing)
src/Language/Haskell/Names/Recursive.hs view
@@ -74,7 +74,7 @@           maybeExports' = fmap (annotateExportSpecList globalTable) maybeExports     modulePragmas' = fmap noScope modulePragmas     importDecls' = annotateImportDecls moduleName environment importDecls-    decls' = map (annotateDecl (initialScope globalTable)) decls+    decls' = map (annotateDecl (initialScope (sModuleName moduleName) globalTable)) decls     globalTable = moduleTable (importTable environment modul) modul     moduleName = getModuleName modul annotate _ _ = error "annotateModule: non-standard modules are not supported"
tests/annotations/TypeSignature.hs view
@@ -4,3 +4,6 @@ f x = 2 * x g x = x + x +function :: Char+function = 'a'+
tests/annotations/TypeSignature.hs.golden view
@@ -18,3 +18,7 @@ +        at  5:9 is not in scope x        at 5:11 is a local value defined at 5:3 x        at 5:11 is a local value defined at 5:3+function at  7:1 is a global value, TypeSignature.function+Char     at 7:13 is not in scope+Char     at 7:13 is not in scope+function at  8:1 is a value bound here