ghc-lib-parser-ex 8.8.3.0 → 8.8.4.0

raw patch · 7 files changed

+264/−9 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +13/−0
• README.md +2/−2
• ghc-lib-parser-ex.cabal +6/−4
• src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs +139/−0
• src/Language/Haskell/GhclibParserEx/GHC/Hs/ExtendInstances.hs +50/−0
• src/Language/Haskell/GhclibParserEx/Parse.hs +17/−1
• test/Test.hs +37/−2

@@ -1,5 +1,18 @@ # Changelog for ghc-lib-parser-ex +## Unreleased changes++## 8.8.4.0 released 2020-02-01+- New modules:+  - `Language.Haskell.GhclibparserEx.GHC.Hs.Expr`+- Moved modules:+  - `Language.Haskell.GhclibparserEx.HsExtendInstances` ->+    `Language.Haskell.GhclibparserEx.GHC.Hs.ExtendInstances`;++## 0.20200201.1.0 released 2020-02-01+- New modules:+  - `Language.Haskell.GhclibparserEx.HsExtendInstances`.+ ## 8.8.3.0 released 2020-01-25 - Change in versioning scheme; - New modules:

@@ -1,4 +1,4 @@-# ghc-lib-parser-ex [![Build Status](https://shayne-fletcher.visualstudio.com/ghc-lib-parser-ex/_apis/build/status/shayne-fletcher.ghc-lib-parser-ex?branchName=master)](https://shayne-fletcher.visualstudio.com/ghc-lib-parser-ex/_build/latest?definitionId=1&branchName=master)+# ghc-lib-parser-ex [![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) [![Hackage version](https://img.shields.io/hackage/v/ghc-lib-parser-ex.svg?label=Hackage)](https://hackage.haskell.org/package/ghc-lib-parser-ex) [![Stackage version](https://www.stackage.org/package/ghc-lib-parser-ex/badge/nightly?label=Stackage)](https://www.stackage.org/package/ghc-lib-parser-ex)  [![Build Status](https://shayne-fletcher.visualstudio.com/ghc-lib-parser-ex/_apis/build/status/shayne-fletcher.ghc-lib-parser-ex?branchName=master)](https://shayne-fletcher.visualstudio.com/ghc-lib-parser-ex/_build/latest?definitionId=1&branchName=master) Copyright © 2020, Shayne Fletcher. All rights reserved. SPDX-License-Identifier: BSD-3-Clause @@ -29,4 +29,4 @@  ## Releasing `ghc-lib-parser-ex` (notes for maintainers) -Build `ghc-lib-parser-ex` using the [above instructions](#building-ghc-lib-parser-ex)  and upload the resulting `.tar.gz` files to [Hackage](https://hackage.haskell.org/upload).+Update the [changelog](./ChangeLog.md), `git tag <version> && git push origin <version>` then build via the [above instructions](#building-ghc-lib-parser-ex) and upload the resulting `.tar.gz` files to [Hackage](https://hackage.haskell.org/upload).

@@ -1,6 +1,6 @@ cabal-version: >= 1.18 name:           ghc-lib-parser-ex-version:        8.8.3.0+version:        8.8.4.0 description:    Please see the README on GitHub at <https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme> homepage:       https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme bug-reports:    https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues@@ -12,7 +12,7 @@ category:       Development synopsis:       Algorithms on GHC parse trees build-type:     Simple-tested-with:    GHC==8.8.1, GHC==8.6.5, GHC==8.4.4+tested-with:    GHC==8.8.2, GHC==8.6.5 extra-source-files:     README.md     ChangeLog.md@@ -30,11 +30,13 @@ library   exposed-modules:       Language.Haskell.GhclibParserEx.Config+      Language.Haskell.GhclibParserEx.Dump       Language.Haskell.GhclibParserEx.DynFlags+      Language.Haskell.GhclibParserEx.Fixity+      Language.Haskell.GhclibParserEx.GHC.Hs.Expr+      Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances       Language.Haskell.GhclibParserEx.Parse       Language.Haskell.GhclibParserEx.Outputable-      Language.Haskell.GhclibParserEx.Dump-      Language.Haskell.GhclibParserEx.Fixity   other-modules:       Paths_ghc_lib_parser_ex   hs-source-dirs:

@@ -0,0 +1,139 @@+-- Copyright (c) 2020, Shayne Fletcher. All rights reserved.+-- SPDX-License-Identifier: BSD-3-Clause.++{-# OPTIONS_GHC -Wno-missing-fields #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+#include "ghclib_api.h"++module Language.Haskell.GhclibParserEx.GHC.Hs.Expr(+  isTag, isDol, isDot, isReturn, isSection, isRecConstr, isRecUpdate,+  isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isLambda, isQuasiQuote,+  isDotApp, isTypeApp, isWHNF, isLCase,+  isFieldPun, isRecStmt, isParComp, isMDo, isTupleSection, isString, isPrimLiteral,+  isSpliceDecl, isFieldWildcard, isUnboxed,+  hasFieldsDotDot,+  varToStr, strToVar,+  fromChar+  ) where++#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+import GHC.Hs+#else+import HsSyn+#endif+import SrcLoc+import RdrName+import OccName+import Name+import BasicTypes+import TysWiredIn++#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+noExt :: NoExtField+noExt = noExtField+#endif++-- 'True' if the provided expression is a variable with name 'tag'.+isTag :: String -> LHsExpr GhcPs -> Bool+isTag tag = \case (L _ (HsVar _ (L _ s))) -> occNameString (rdrNameOcc s) == tag; _ -> False++isDot, isDol, isReturn, isSection, isRecConstr, isRecUpdate,+  isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isQuasiQuote,+  isLambda, isDotApp, isTypeApp, isWHNF, isLCase :: LHsExpr GhcPs -> Bool+isDol = isTag "$"+isDot = isTag "."+isReturn x = isTag "return" x || isTag "pure" x -- Allow both 'pure' and 'return' as they have the same semantics.+isSection = \case (L _ SectionL{}) -> True ; (L _ SectionR{}) -> True; _ -> False+isRecConstr = \case (L _ RecordCon{}) -> True; _ -> False+isRecUpdate = \case (L _ RecordUpd{}) -> True; _ -> False+isVar = \case (L _ HsVar{}) -> True; _ -> False+isPar = \case (L _ HsPar{}) -> True; _ -> False+isApp = \case (L _ HsApp{}) -> True; _ -> False+isOpApp = \case (L _ OpApp{}) -> True; _ -> False+isAnyApp x = isApp x || isOpApp x+isLexeme = \case (L _ HsVar{}) -> True; (L _ HsOverLit{}) -> True; (L _ HsLit{}) -> True; _ -> False+isLambda = \case (L _ HsLam{}) -> True; _ -> False+isQuasiQuote = \case (L _ (HsSpliceE _ HsQuasiQuote{})) -> True; _ -> False+isDotApp = \case (L _ (OpApp _ _ op _)) -> isDot op; _ -> False+isTypeApp = \case (L _ HsAppType{}) -> True; _ -> False+isWHNF = \case+  (L _ (HsVar _ (L _ x))) -> isRdrDataCon x+  (L _ (HsLit _ x)) -> case x of HsString{} -> False; HsInt{} -> False; HsRat{} -> False; _ -> True+  (L _ HsLam{}) -> True+  (L _ ExplicitTuple{}) -> True+  (L _ ExplicitList{}) -> True+  (L _ (HsPar _ x)) -> isWHNF x+  (L _ (ExprWithTySig _ x _)) -> isWHNF x+  -- Other (unknown) constructors may have bang patterns in them, so+  -- approximate.+  (L _ (HsApp _ (L _ (HsVar _ (L _ x))) _))+    | occNameString (rdrNameOcc x) `elem` ["Just", "Left", "Right"] -> True+  _ -> False+isLCase = \case (L _ HsLamCase{}) -> True; _ -> False++-- Field is punned e.g. '{foo}'.+isFieldPun :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool+isFieldPun = \case (L _ HsRecField {hsRecPun=True}) -> True; _ -> False++-- Contains a '..' as in 'Foo{..}'+hasFieldsDotDot :: HsRecFields GhcPs (LHsExpr GhcPs) -> Bool+hasFieldsDotDot = \case HsRecFields {rec_dotdot=Just _} -> True; _ -> False++isRecStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool+isRecStmt = \case RecStmt{} -> True; _ -> False++isParComp :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool+isParComp = \case ParStmt{} -> True; _ -> False++isMDo :: HsStmtContext Name -> Bool+isMDo = \case MDoExpr -> True; _ -> False++isTupleSection :: HsTupArg GhcPs -> Bool+isTupleSection = \case Missing{} -> True; _ -> False++isString :: HsLit GhcPs -> Bool+isString = \case HsString{} -> True; _ -> False++isPrimLiteral :: HsLit GhcPs -> Bool+isPrimLiteral = \case+  HsCharPrim{} -> True+  HsStringPrim{} -> True+  HsIntPrim{} -> True+  HsWordPrim{} -> True+  HsInt64Prim{} -> True+  HsWord64Prim{} -> True+  HsFloatPrim{} -> True+  HsDoublePrim{} -> True+  _ -> False++isSpliceDecl :: HsExpr GhcPs -> Bool+isSpliceDecl = \case HsSpliceE{} -> True; _ -> False++-- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'.+isFieldWildcard :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool+isFieldWildcard = \case+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+  (L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_"+#else+  (L _ HsRecField {hsRecFieldArg=(L _ (EWildPat _))}) -> True+#endif+  (L _ HsRecField {hsRecPun=True}) -> True+  (L _ HsRecField {}) -> False++isUnboxed :: Boxity -> Bool+isUnboxed = \case Unboxed -> True; _ -> False++varToStr :: LHsExpr GhcPs -> String+varToStr (L _ (HsVar _ (L _ n)))+  | n == consDataCon_RDR = ":"+  | n == nameRdrName nilDataConName = "[]"+  | n == nameRdrName (getName (tupleDataCon Boxed 0)) = "()"+  | otherwise = occNameString (rdrNameOcc n)+varToStr _ = ""++strToVar :: String -> LHsExpr GhcPs+strToVar x = noLoc $ HsVar noExt (noLoc $ mkRdrUnqual (mkVarOcc x))++fromChar :: LHsExpr GhcPs -> Maybe Char+fromChar = \case (L _ (HsLit _ (HsChar _ x))) -> Just x; _ -> Nothing

@@ -0,0 +1,50 @@+-- Copyright (c) 2020, Shayne Fletcher. All rights reserved.+-- SPDX-License-Identifier: BSD-3-Clause.++{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances (+    HsExtendInstances(..), extendInstances, astEq, astListEq)+where++-- At times, there are terms in Haskell syntax we work with that are+-- not in `Eq`, `Show` or `Ord` and we need them to be.++-- This work-around resorts to implementing Eq and Ord via+-- lexicographic string comparisons. As long as two different terms+-- never map to the same string, basing `Eq` and `Ord` on their string+-- representations rather than the terms themselves, leads to+-- identical results.++import Outputable+import Data.Data+import Data.Function++import Language.Haskell.GhclibParserEx.Dump++newtype HsExtendInstances a =+  HsExtendInstances { unextendInstances :: a }+    deriving Outputable++extendInstances :: a -> HsExtendInstances a+extendInstances = HsExtendInstances++-- Use 'showAstData'. This is preferable to 'ppr' in that trees that+-- only differ in arrangement due to fixities will produce differing+-- string representations.+toStr :: Data a => HsExtendInstances a -> String+toStr (HsExtendInstances e) =+  Outputable.showSDocUnsafe $ showAstData BlankSrcSpan e++instance Data a => Eq (HsExtendInstances a) where (==) a b = toStr a == toStr b+instance Data a => Ord (HsExtendInstances a) where compare = compare `on` toStr++astEq :: Data a => a -> a -> Bool+astEq a b = extendInstances a == extendInstances b++astListEq :: Data a => [a] -> [a] -> Bool+astListEq as bs = length as == length bs && all (uncurry astEq) (zip as bs)++-- Use 'ppr' for 'Show'.+instance Outputable a => Show (HsExtendInstances a) where+  show (HsExtendInstances e) =  Outputable.showSDocUnsafe $ Outputable.ppr e

@@ -37,7 +37,11 @@ import FastString import SrcLoc import BkpSyn+#if defined (GHCLIB_API_811)+import UnitInfo+#else import PackageConfig+#endif import RdrName  parse :: P a -> String -> DynFlags -> ParseResult a@@ -48,10 +52,18 @@     buffer = stringToStringBuffer str     parseState = mkPState flags buffer location +#if defined (GHCLIB_API_811)+parseModule :: String -> DynFlags -> ParseResult (Located HsModule)+#else parseModule :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))+#endif parseModule = parse Parser.parseModule +#if defined (GHCLIB_API_811)+parseSignature :: String -> DynFlags -> ParseResult (Located HsModule)+#else parseSignature :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))+#endif parseSignature = parse Parser.parseSignature  parseImport :: String -> DynFlags -> ParseResult (LImportDecl GhcPs)@@ -88,10 +100,14 @@ parseType :: String -> DynFlags -> ParseResult (LHsType GhcPs) parseType = parse Parser.parseType +#if defined(GHCLIB_API_811)+parseHeader :: String -> DynFlags -> ParseResult (Located HsModule)+#else parseHeader :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))+#endif parseHeader = parse Parser.parseHeader -#if defined (GHC_API_811)+#if defined (GHCLIB_API_811) parseFile :: String           -> DynFlags           -> String

@@ -18,6 +18,7 @@ import Language.Haskell.GhclibParserEx.Parse import Language.Haskell.GhclibParserEx.Dump import Language.Haskell.GhclibParserEx.Fixity+import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances  #if defined (GHCLIB_API_811) || defined (GHCLIB_API_810) import GHC.Hs@@ -38,7 +39,7 @@   defaultMain tests  tests :: TestTree-tests = testGroup " All tests" [parseTests, fixityTests]+tests = testGroup " All tests" [parseTests, fixityTests, extendInstancesTests]  chkParseResult :: (DynFlags -> WarningMessages -> String) -> DynFlags -> ParseResult a -> IO () chkParseResult report flags = \case@@ -87,9 +88,12 @@   , testCase "Expression" $       chkParseResult report flags $         parseExpression "unfoldr $ listToMaybe . concatMap reads . tails" flags-  , testCase "Declaration" $+  , testCase "Declaration (1)" $       chkParseResult report flags $         parseDeclaration "fact n = if n <= 1 then 1 else n * fact (n - 1)" flags+  , testCase "Declaration (2)" $ -- Example from https://github.com/ndmitchell/hlint/issues/842.+      chkParseResult report flags $+        parseDeclaration "infixr 4 <%@~" flags   , testCase "File" $ do       foo <- makeFile "Foo.hs" $ unlines         ["{-# LANGUAGE ScopedTypeVariables #-}"@@ -144,3 +148,34 @@     Directory.createDirectoryIfMissing True $ FilePath.takeDirectory relPath     writeFile relPath contents     return relPath++extendInstancesTests :: TestTree+extendInstancesTests = testGroup "Extend instances tests"+  [+    testCase "Eq, Ord" $ do+      let flags = defaultDynFlags fakeSettings fakeLlvmConfig+      case parseExpression "1 + 2 * 3" flags of+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+        POk s e ->+#else+        POk _ e ->+#endif+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+          case unP (runECP_P e >>= \e -> return e) s :: ParseResult (LHsExpr GhcPs) of+            POk _  e ->+#endif+              do+                e' <- return $ applyFixities [] e+                assertBool "astEq" $ astEq e e+                assertBool "astEq" $ not (astEq e e')+                e  <- return $ extendInstances e+                e' <- return $ extendInstances e'+                assertBool "==" $ e == e+                assertBool "/=" $ e /= e'+                assertBool "< " $ e' < e+                assertBool ">=" $ e  >= e'+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+            _ -> assertFailure "ecp failure"+#endif+        _ -> assertFailure "parse error"+  ]