haskell-names 0.4 → 0.4.1

raw patch · 14 files changed

+97/−62 lines, 14 filesdep ~haskell-src-extsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: haskell-src-exts

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• haskell-names.cabal +2/−2
• src/Language/Haskell/Names/Annotated.hs +1/−4
• src/Language/Haskell/Names/Exports.hs +3/−1
• src/Language/Haskell/Names/GetBound.hs +12/−3
• src/Language/Haskell/Names/Imports.hs +4/−2
• src/Language/Haskell/Names/ModuleSymbols.hs +16/−12
• src/Language/Haskell/Names/Open/Derived.hs +10/−4
• src/Language/Haskell/Names/Open/Instances.hs +5/−19
• src/Language/Haskell/Names/RecordWildcards.hs +2/−2
• src/Language/Haskell/Names/SyntaxUtils.hs +9/−9
• tests/annotations/Records.hs.golden +11/−4
• tests/exports/DataFamilies.hs +4/−0
• tests/exports/DataFamilies.hs.golden +12/−0

@@ -1,6 +1,12 @@ Changes ======= +Version 0.4.1+-------------++* Export types defined by top level data family declarations+* Update to haskell-src-exts 1.16+ Version 0.4 ----------- 

@@ -1,5 +1,5 @@ Name:                   haskell-names-Version:                0.4+Version:                0.4.1 License:                BSD3 Author:                 Roman Cheplyaka, Lennart Augustsson Maintainer:             Roman Cheplyaka <roma@ro-che.info>@@ -257,7 +257,7 @@   Default-Language: Haskell2010   Build-depends:       base >= 4 && < 5-    , haskell-src-exts >= 1.15+    , haskell-src-exts >= 1.16     , mtl     , transformers     , filepath >= 1.1

@@ -53,7 +53,7 @@       = Scoped TypeBinder (sLoc . ann $ a) <$ a     | Just (Eq :: FieldUpdate (Scoped l) :~: a) <- dynamicEq       = case a of-          FieldPun l n -> FieldPun l (lookupUnqualValue n sc <$ n)+          FieldPun l n -> FieldPun l (lookupValue (sLoc <$> n) sc <$ n)           FieldWildcard l ->             let               namesUnres = sc ^. wcNames@@ -74,9 +74,6 @@             (sLoc l)     | otherwise       = rmap go sc a--lookupUnqualValue :: Name (Scoped l) -> Scope -> Scoped l-lookupUnqualValue n = lookupValue (UnQual (sLoc $ ann n) (sLoc <$> n))  lookupValue :: QName l -> Scope -> Scoped l lookupValue qn sc = Scoped nameInfo (ann qn)

@@ -45,7 +45,7 @@   -> m (ExportSpec (Scoped l), Symbols) resolveExportSpec tbl exp =   case exp of-    EVar l qn -> return $+    EVar l ns@(NoNamespace {}) qn -> return $       case Global.lookupValue qn tbl of         Global.Error err ->           (scopeError err exp, mempty)@@ -53,8 +53,10 @@           let s = mkVal i           in             (EVar (Scoped (Export s) l)+              (noScope ns)               (Scoped (GlobalValue i) <$> qn), s)         Global.Special {} -> error "Global.Special in export list?"+    EVar _ (TypeNamespace {}) _ -> error "'type' namespace is not supported yet" -- FIXME     EAbs l qn -> return $       case Global.lookupType qn tbl of         Global.Error err ->

@@ -11,6 +11,7 @@  import Language.Haskell.Exts.Annotated import Language.Haskell.Names.RecordWildcards+import Language.Haskell.Names.SyntaxUtils import qualified Language.Haskell.Names.GlobalSymbolTable as Global  -- | Get bound value identifiers.@@ -54,7 +55,7 @@       FunBind _ [] -> error "getBound: FunBind []"       FunBind _ (Match _ n _ _ _ : _) -> [n]       FunBind _ (InfixMatch _ _ n _ _ _ : _) -> [n]-      PatBind _ p _ _ _ -> getBound ctx p+      PatBind _ p _ _ -> getBound ctx p       ForImp _ _ _ _ n _ -> [n]       ForExp _ _ _ n _ -> [n]       RulePragmaDecl{} -> []@@ -71,7 +72,15 @@     getBound ctx (QualConDecl _ _ _ d) = getBound ctx d  instance (Data l) => GetBound (GadtDecl l) l where-    getBound _ctx (GadtDecl _ n _) = [n]+    getBound _ctx (GadtDecl _l conName mbFieldDecls _ty) =+      -- GADT constructor name+      [conName] +++      -- GADT selector names+      [ fieldName+      | Just fieldDecls <- return mbFieldDecls+      , FieldDecl _l' fieldNames _fieldTy <- fieldDecls+      , fieldName <- fieldNames+      ]  instance (Data l) => GetBound (ConDecl l) l where     getBound ctx e = case e of@@ -132,7 +141,7 @@        getRecVars :: [Name ()] -> PatField l -> [Name l]       getRecVars _ PFieldPat {} = [] -- this is already found by the generic algorithm-      getRecVars _ (PFieldPun _ n) = [n]+      getRecVars _ (PFieldPun _ qn) = [qNameToName qn]       getRecVars elidedFields (PFieldWildcard l) = map (l <$) elidedFields  getBoundSign :: Decl l -> [Name l]

@@ -78,7 +78,7 @@   :: Symbols   -> ImportDecl l   -> (ImportDecl (Scoped l), Global.Table)-resolveImportDecl syms (ImportDecl l mod qual src pkg mbAs mbSpecList) =+resolveImportDecl syms (ImportDecl l mod qual src impSafe pkg mbAs mbSpecList) =   let     (mbSpecList', impSyms) =       (fmap fst &&& maybe syms snd) $@@ -95,6 +95,7 @@       (Scoped (ImportPart syms) <$> mod)       qual       src+      impSafe       pkg       (fmap noScope mbAs)       mbSpecList'@@ -150,7 +151,7 @@ -- NB: this can be made more efficient resolveImportSpec mod isHiding syms spec =   case spec of-    IVar _ n ->+    IVar _ (NoNamespace {}) n ->       let         matches = mconcat $           -- Strictly speaking, the isConstructor check is unnecessary@@ -166,6 +167,7 @@           matches           spec     -- FIXME think about data families etc.+    IVar _ (TypeNamespace {}) _ -> error "'type' namespace is not supported yet" -- FIXME     IAbs _ n       | isHiding ->           -- This is a bit special. 'C' may match both types/classes and

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables, ViewPatterns #-} module Language.Haskell.Names.ModuleSymbols   ( moduleSymbols   , moduleTable@@ -96,19 +96,23 @@         Right (dataOrNewCon dataOrNew dq Nothing) : map Left infos      GDataDecl _ dataOrNew _ dh _ gadtDecls _ ->-      -- As of 1.14.0, HSE doesn't support GADT records.-      -- When it does, this code should be rewritten similarly to the-      -- DataDecl case.-      -- (Also keep in mind that GHC doesn't create selectors for fields-      -- with existential type variables.)+      -- FIXME: We shouldn't create selectors for fields with existential type variables!       let         dq = hname dh++        cons :: Constructors+        cons = do -- list monad+          GadtDecl _ cn (fromMaybe [] -> fields) _ty <- gadtDecls+          return (void cn , [void f | FieldDecl _ fNames _ <- fields, f <- fNames])++        infos = constructorsToInfos dq cons       in-          Right (dataOrNewCon dataOrNew dq Nothing) :-        [ Left (SymConstructor { sv_origName = qname cn, sv_fixity = Nothing, sv_typeName = dq })-        | GadtDecl _ cn _ <- gadtDecls-        ]+          Right (dataOrNewCon dataOrNew dq Nothing) : map Left infos +    DataFamDecl _ _ dh _ ->+      let tn = hname dh+      in [Right (SymDataFam { st_origName = tn, st_fixity = Nothing })]+     ClassDecl _ _ dh _ mds ->       let         ms = getBound impTbl d@@ -124,7 +128,7 @@       let vn : _ = getBound impTbl ms       in  [ Left  (SymValue { sv_origName = qname vn, sv_fixity = Nothing }) ] -    PatBind _ p _ _ _ ->+    PatBind _ p _ _ ->       [ Left  (SymValue { sv_origName = qname vn, sv_fixity = Nothing }) | vn <- getBound impTbl p ]      ForImp _ _ _ _ fn _ ->@@ -134,7 +138,7 @@   where     ModuleName _ smdl = mdl     qname = GName smdl . nameToString-    hname = qname . fst . splitDeclHead+    hname = qname . getDeclHeadName     toOrig = OrigName Nothing     dataOrNewCon dataOrNew = case dataOrNew of DataType {} -> SymData; NewType {} -> SymNewType 

@@ -49,6 +49,8 @@  deriveGTraversable ''InstHead +deriveGTraversable ''InstRule+ deriveGTraversable ''Deriving  deriveGTraversable ''Binds@@ -133,10 +135,14 @@  deriveGTraversable ''Alt -deriveGTraversable ''GuardedAlts+deriveGTraversable ''Promoted -deriveGTraversable ''GuardedAlt+deriveGTraversable ''BooleanFormula -deriveGTraversable ''Promoted+deriveGTraversable ''TypeEqn -deriveGTraversable ''IfAlt+deriveGTraversable ''Overlap++deriveGTraversable ''Sign++deriveGTraversable ''Namespace

@@ -46,14 +46,13 @@       --       -- If this is a local binding, then we have already introduced these       -- variables when processing the enclosing Binds.-      PatBind l pat mbType rhs mbWhere ->+      PatBind l pat rhs mbWhere ->         let           scWithWhere = intro mbWhere sc         in         c PatBind           <| sc                -: l           <| sc                -: pat-          <| sc                -: mbType           <| exprV scWithWhere -: rhs           <| sc                -: mbWhere       -- FunBind consists of Matches, which we handle below anyway.@@ -70,17 +69,15 @@ instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (DeclHead l) where   rtraverse e sc =     case e of-      DHead l name tyVars ->+      DHead l name ->         c DHead           <| sc -: l           <| binderT sc -: name-          <| sc -: tyVars-      DHInfix l v1 name v2 ->+      DHInfix l v1 name ->         c DHInfix           <| sc -: l           <| sc -: v1           <| binderT sc -: name-          <| sc -: v2       _ -> defaultRtraverse e sc  instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (ConDecl l) where@@ -165,10 +162,10 @@           <| sc       -: l           <| exprV sc -: qn           <| sc       -: pat-      PFieldPun l n ->+      PFieldPun l qn ->         c PFieldPun           <| sc -: l-          <| binderV sc -: n+          <| exprV sc -: qn       -- In future we might want to annotate PFieldWildcard with the names       -- it introduces.       PFieldWildcard {} -> defaultRtraverse e sc@@ -308,17 +305,6 @@           <| sc -: pat           <| scWithBinds -: guardedAlts           <| scWithBinds -: mbWhere--instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (GuardedAlt l) where-  rtraverse e sc =-    case e of-      GuardedAlt l stmts exp ->-        let (stmts', scWithStmts) = chain stmts sc-        in-        c GuardedAlt-          <|  sc -: l-          <*> stmts'-          <|  scWithStmts -: exp  instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (GuardedRhs l) where   rtraverse e sc =

@@ -99,14 +99,14 @@ nameOfPatField pf =   case pf of     PFieldPat _ qn _ -> Just $ qNameToName qn-    PFieldPun _ n -> Just n+    PFieldPun _ qn -> Just $ qNameToName qn     PFieldWildcard {} -> Nothing  nameOfUpdField :: FieldUpdate l -> Maybe (Name l) nameOfUpdField pf =   case pf of     FieldUpdate _ qn _ -> Just $ qNameToName qn-    FieldPun _ n -> Just n+    FieldPun _ qn -> Just $ qNameToName qn     FieldWildcard {} -> Nothing  patWcNames

@@ -4,7 +4,6 @@   , getModuleName   , getImports   , getExportSpecList-  , splitDeclHead   , getDeclHead   , getDeclHeadName   , getModuleDecls@@ -27,6 +26,7 @@ import Data.Either import Data.Foldable import qualified Data.Set as Set+import Data.Generics.Uniplate.Data import Language.Haskell.Exts.Annotated import Language.Haskell.Names.Types @@ -58,7 +58,7 @@ getModuleHead :: Module l -> ModuleHead l getModuleHead (Module _ (Just mh) _ _ _) = mh getModuleHead (XmlHybrid _ (Just mh) _ _ _ _ _ _ _) = mh-getModuleHead m = ModuleHead l (main_mod l) Nothing (Just (ExportSpecList l [EVar l (UnQual l (Ident l "main"))]))+getModuleHead m = ModuleHead l (main_mod l) Nothing (Just (ExportSpecList l [EVar l (NoNamespace l) (UnQual l (Ident l "main"))]))   where l = ann m  qNameToName :: QName l -> Name l@@ -82,13 +82,13 @@ getDeclHead (ClassDecl _ _ dhead _ _) = Just dhead getDeclHead _ = Nothing -splitDeclHead :: DeclHead l -> (Name l, [TyVarBind l])-splitDeclHead (DHead _ n vs) = (n, vs)-splitDeclHead (DHInfix _ v1 n v2) = (n, [v1, v2])-splitDeclHead (DHParen _ dhead) = splitDeclHead dhead--getDeclHeadName :: Decl l -> Name l-getDeclHeadName = fst . splitDeclHead . fromMaybe (error "getDeclHeadName") . getDeclHead+getDeclHeadName :: DeclHead l -> Name l+getDeclHeadName dh =+  case dh of+    DHead _ n -> n+    DHInfix _ _ n -> n+    DHParen _ dh' -> getDeclHeadName dh'+    DHApp _ dh' _ -> getDeclHeadName dh'  ---------------------------------------------------- 

@@ -39,12 +39,14 @@ g        at 18:1 is a value bound here A        at 18:3 is a global constructor, Records.A A        at 18:3 is a global constructor, Records.A-b        at 18:6 is a value bound here+b        at 18:6 is a global selector, Records.b+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 value bound here+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@@ -55,10 +57,12 @@ 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 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-b        at 28:7 is a value bound here+b        at 28:7 is a global selector, Records.b+b        at 28:7 is a global selector, Records.b c        at 28:10 is a global selector, Records.c c        at 28:10 is a global selector, Records.c y        at 28:18 is a value bound here@@ -72,6 +76,7 @@ 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 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@@ -108,7 +113,8 @@ f3       at 48:1 is a value bound here A        at 48:4 is a global constructor, Records.A A        at 48:4 is a global constructor, Records.A-b        at 48:8 is a value bound here+b        at 48:8 is a global selector, Records.b+b        at 48:8 is a global selector, Records.b ..       at 48:11 is a record pattern wildcard which brings the following fields: Records.c b        at 48:19 is a local value defined at 48:8 b        at 48:19 is a local value defined at 48:8@@ -144,6 +150,7 @@ 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: Records.b = (a local value defined at 61:11) r5       at 64:1 is a value bound here

@@ -0,0 +1,4 @@+{-# LANGUAGE TypeFamilies #-}+module DataFamilies where++data family Vector a

@@ -0,0 +1,12 @@+Symbols+  (fromList [])+  (fromList+     [ SymDataFam+         { st_origName =+             OrigName+               { origPackage = Nothing+               , origGName = GName { gModule = "DataFamilies" , gName = "Vector" }+               }+         , st_fixity = Nothing+         }+     ])