ghc-lib-parser-ex-9.4.0.0/cbits/0000755000000000000000000000000014274052553014374 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/0000755000000000000000000000000014274052553014057 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/0000755000000000000000000000000014274052553015602 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/0000755000000000000000000000000014274052553017165 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/0000755000000000000000000000000014274052553022027 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/0000755000000000000000000000000014274052553022430 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Driver/0000755000000000000000000000000014274052553023663 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/0000755000000000000000000000000014274052553023002 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Settings/0000755000000000000000000000000014274052553024230 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Types/0000755000000000000000000000000014274052553023534 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Types/Name/0000755000000000000000000000000014274052553024414 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Utils/0000755000000000000000000000000014274052553023530 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/test/0000755000000000000000000000000014274052553014247 5ustar0000000000000000ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/Dump.hs0000644000000000000000000002066214274052553023276 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} {- HLINT ignore -} -- Not our code. {-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.Dump( showAstData , BlankSrcSpan(..) #if defined(GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) , BlankEpAnnotations(..) #endif ) where #if !defined(MIN_VERSION_ghc_lib_parser) -- Using native ghc. # if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined(GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs.Dump # else import HsDumpAst # endif #else -- Using ghc-lib-parser. Recent versions will include -- GHC.Hs.Dump (it got moved in from ghc-lib on 2020-02-05). # if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs.Dump # else -- For simplicity, just assume it's missing from 8.8 ghc-lib-parser -- builds and reproduce the implementation. import Prelude as X hiding ((<>)) import Data.Data hiding (Fixity) import Bag import BasicTypes import FastString import NameSet import Name import DataCon import SrcLoc #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif import OccName hiding (occName) import Var import Module import Outputable import qualified Data.ByteString as B data BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan deriving (Eq,Show) -- | Show a GHC syntax tree. This parameterised because it is also used for -- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked -- out, to avoid comparing locations, only structure showAstData :: Data a => BlankSrcSpan -> a -> SDoc showAstData b a0 = blankLine $$ showAstData' a0 where showAstData' :: Data a => a -> SDoc showAstData' = generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan `extQ` lit `extQ` litr `extQ` litt `extQ` bytestring `extQ` name `extQ` occName `extQ` moduleName `extQ` var `extQ` dataCon `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet `extQ` fixity `ext2Q` located where generic :: Data a => a -> SDoc generic t = parens $ text (showConstr (toConstr t)) $$ vcat (gmapQ showAstData' t) string :: String -> SDoc string = text . normalize_newlines . show fastString :: FastString -> SDoc fastString s = braces $ text "FastString: " <> text (normalize_newlines . show $ s) bytestring :: B.ByteString -> SDoc bytestring = text . normalize_newlines . show list [] = brackets empty list [x] = brackets (showAstData' x) list (x1 : x2 : xs) = (text "[" <> showAstData' x1) $$ go x2 xs where go y [] = text "," <> showAstData' y <> text "]" go y1 (y2 : ys) = (text "," <> showAstData' y1) $$ go y2 ys -- Eliminate word-size dependence lit :: HsLit GhcPs -> SDoc lit (HsWordPrim s x) = numericLit "HsWord{64}Prim" x s lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s lit (HsIntPrim s x) = numericLit "HsInt{64}Prim" x s lit (HsInt64Prim s x) = numericLit "HsInt{64}Prim" x s lit l = generic l litr :: HsLit GhcRn -> SDoc litr (HsWordPrim s x) = numericLit "HsWord{64}Prim" x s litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s litr (HsIntPrim s x) = numericLit "HsInt{64}Prim" x s litr (HsInt64Prim s x) = numericLit "HsInt{64}Prim" x s litr l = generic l litt :: HsLit GhcTc -> SDoc litt (HsWordPrim s x) = numericLit "HsWord{64}Prim" x s litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s litt (HsIntPrim s x) = numericLit "HsInt{64}Prim" x s litt (HsInt64Prim s x) = numericLit "HsInt{64}Prim" x s litt l = generic l numericLit :: String -> Integer -> SourceText -> SDoc numericLit tag x s = braces $ hsep [ text tag , generic x , generic s ] name :: Name -> SDoc name nm = braces $ text "Name: " <> ppr nm occName n = braces $ text "OccName: " <> text (OccName.occNameString n) moduleName :: ModuleName -> SDoc moduleName m = braces $ text "ModuleName: " <> ppr m srcSpan :: SrcSpan -> SDoc srcSpan ss = case b of BlankSrcSpan -> text "{ ss }" NoBlankSrcSpan -> braces $ char ' ' <> (hang (ppr ss) 1 -- TODO: show annotations here (text "")) var :: Var -> SDoc var v = braces $ text "Var: " <> ppr v dataCon :: DataCon -> SDoc dataCon c = braces $ text "DataCon: " <> ppr c bagRdrName:: Bag (Located (HsBind GhcPs)) -> SDoc bagRdrName bg = braces $ text "Bag(Located (HsBind GhcPs)):" $$ (list . bagToList $ bg) bagName :: Bag (Located (HsBind GhcRn)) -> SDoc bagName bg = braces $ text "Bag(Located (HsBind Name)):" $$ (list . bagToList $ bg) bagVar :: Bag (Located (HsBind GhcTc)) -> SDoc bagVar bg = braces $ text "Bag(Located (HsBind Var)):" $$ (list . bagToList $ bg) nameSet ns = braces $ text "NameSet:" $$ (list . nameSetElemsStable $ ns) fixity :: Fixity -> SDoc fixity fx = braces $ text "Fixity: " <> ppr fx located :: (Data b,Data loc) => GenLocated loc b -> SDoc located (L ss a) = parens $ case cast ss of Just (s :: SrcSpan) -> srcSpan s Nothing -> text "nnnnnnnn" $$ showAstData' a normalize_newlines :: String -> String normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs normalize_newlines (x:xs) = x:normalize_newlines xs normalize_newlines [] = [] {- ************************************************************************ * * * Copied from syb * * ************************************************************************ -} -- | The type constructor for queries newtype Q q x = Q { unQ :: x -> q } -- | Extend a generic query by a type-specific case extQ :: ( Typeable a , Typeable b ) => (a -> q) -> (b -> q) -> a -> q extQ f g a = maybe (f a) g (cast a) -- | Type extension of queries for type constructors ext1Q :: (Data d, Typeable t) => (d -> q) -> (forall e. Data e => t e -> q) -> d -> q ext1Q def ext = unQ ((Q def) `ext1` (Q ext)) -- | Type extension of queries for type constructors ext2Q :: (Data d, Typeable t) => (d -> q) -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q ext2Q def ext = unQ ((Q def) `ext2` (Q ext)) -- | Flexible type extension ext1 :: (Data a, Typeable t) => c a -> (forall d. Data d => c (t d)) -> c a ext1 def ext = maybe def id (dataCast1 ext) -- | Flexible type extension ext2 :: (Data a, Typeable t) => c a -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2)) -> c a ext2 def ext = maybe def id (dataCast2 ext) # endif #endif ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/Fixity.hs0000644000000000000000000002470714274052553023651 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -- -- Adapted from (1) https://github.com/mpickering/apply-refact.git and -- (2) https://gitlab.haskell.org/ghc/ghc ('compiler/renamer/RnTypes.hs'). {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.Fixity( applyFixities , fixitiesFromModule , preludeFixities, baseFixities , infixr_, infixl_, infix_, fixity ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Hs #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) import GHC.Types.Fixity import GHC.Types.SourceText #else import GHC.Types.Basic #endif import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Types.SrcLoc #elif defined (GHCLIB_API_810) import GHC.Hs import BasicTypes import RdrName import OccName import SrcLoc #else import HsSyn import BasicTypes import RdrName import OccName import SrcLoc #endif import Data.Maybe import Data.Data hiding (Fixity) import Data.Generics.Uniplate.Data #if defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noExt :: NoExtField noExt = noExtField #endif -- | Rearrange a parse tree to account for fixities. applyFixities :: Data a => [(String, Fixity)] -> a -> a applyFixities fixities m = let m' = transformBi (expFix fixities) m m'' = transformBi (patFix fixities) m' in m'' expFix :: [(String, Fixity)] -> LHsExpr GhcPs -> LHsExpr GhcPs expFix fixities (L loc (OpApp _ l op r)) = mkOpApp (getFixities fixities) loc l op (findFixity (getFixities fixities) op) r expFix _ e = e -- LPat and Pat have gone through a lot of churn. See -- https://gitlab.haskell.org/ghc/ghc/merge_requests/1925 for details. patFix :: [(String, Fixity)] -> LPat GhcPs -> LPat GhcPs #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) patFix fixities (L loc (ConPat _ op (InfixCon pat1 pat2))) = L loc (mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2) #elif defined (GHCLIB_API_810) patFix fixities (L loc (ConPatIn op (InfixCon pat1 pat2))) = L loc (mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2) #else patFix fixities (dL -> L _ (ConPatIn op (InfixCon pat1 pat2))) = mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2 #endif patFix _ p = p mkConOpPat :: [(String, Fixity)] #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) -> LocatedN RdrName #else -> Located RdrName #endif -> Fixity -> LPat GhcPs -> LPat GhcPs -> Pat GhcPs #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) mkConOpPat fs op2 fix2 p1@(L loc (ConPat _ op1 (InfixCon p11 p12))) p2 #elif defined (GHCLIB_API_810) mkConOpPat fs op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2 #else mkConOpPat fs op2 fix2 p1@(dL->L loc (ConPatIn op1 (InfixCon p11 p12))) p2 #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) | nofix_error = ConPat noAnn op2 (InfixCon p1 p2) #elif defined (GHCLIB_API_900) | nofix_error = ConPat noExtField op2 (InfixCon p1 p2) #else | nofix_error = ConPatIn op2 (InfixCon p1 p2) #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) | associate_right = ConPat noAnn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2))) #elif defined (GHCLIB_API_900) | associate_right = ConPat noExtField op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2))) #elif defined (GHCLIB_API_810) | associate_right = ConPatIn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2))) #else | associate_right = ConPatIn op1 (InfixCon p11 (cL loc (mkConOpPat fs op2 fix2 p12 p2))) #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) | otherwise = ConPat noAnn op2 (InfixCon p1 p2) #elif defined (GHCLIB_API_900) | otherwise = ConPat noExtField op2 (InfixCon p1 p2) #else | otherwise = ConPatIn op2 (InfixCon p1 p2) #endif where fix1 = findFixity' fs op1 (nofix_error, associate_right) = compareFixity fix1 fix2 #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) mkConOpPat _ op _ p1 p2 = ConPat noAnn op (InfixCon p1 p2) #elif defined (GHCLIB_API_900) mkConOpPat _ op _ p1 p2 = ConPat noExtField op (InfixCon p1 p2) #else mkConOpPat _ op _ p1 p2 = ConPatIn op (InfixCon p1 p2) #endif mkOpApp :: [(String, Fixity)] #if defined(GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) -> SrcSpanAnnA #else -> SrcSpan #endif -> LHsExpr GhcPs -- Left operand; already rearrange. -> LHsExpr GhcPs -> Fixity -- Operator and fixity. -> LHsExpr GhcPs -- Right operand (not an OpApp, but might be a NegApp). -> LHsExpr GhcPs -- (e11 `op1` e12) `op2` e2 mkOpApp fs loc e1@(L _ (OpApp x1 e11 op1 e12)) op2 fix2 e2 #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) | nofix_error = L loc (OpApp noAnn e1 op2 e2) #else | nofix_error = L loc (OpApp noExt e1 op2 e2) #endif | associate_right = L loc (OpApp x1 e11 op1 (mkOpApp fs loc' e12 op2 fix2 e2 )) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) loc'= combineLocsA e12 e2 #else loc'= combineLocs e12 e2 #endif fix1 = findFixity fs op1 (nofix_error, associate_right) = compareFixity fix1 fix2 -- (- neg_arg) `op` e2 mkOpApp fs loc e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2 #if defined(GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) | nofix_error = L loc (OpApp noAnn e1 op2 e2) #else | nofix_error = L loc (OpApp noExt e1 op2 e2) #endif #if defined(GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) | associate_right = L loc (NegApp noAnn (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name) #else | associate_right = L loc (NegApp noExt (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name) #endif where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) loc' = combineLocsA neg_arg e2 #else loc' = combineLocs neg_arg e2 #endif (nofix_error, associate_right) = compareFixity negateFixity fix2 -- e1 `op` - neg_arg mkOpApp _ loc e1 op1 fix1 e2@(L _ NegApp {}) -- NegApp can occur on the right. #if defined(GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) | not associate_right = L loc (OpApp noAnn e1 op1 e2)-- We *want* right association. #else | not associate_right = L loc (OpApp noExt e1 op1 e2)-- We *want* right association. #endif where (_, associate_right) = compareFixity fix1 negateFixity -- Default case, no rearrangment. #if defined(GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noAnn e1 op e2) #else mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noExt e1 op e2) #endif getIdent :: LHsExpr GhcPs -> String getIdent (unLoc -> HsVar _ (L _ n)) = occNameString . rdrNameOcc $ n getIdent _ = error "Must be HsVar" -- If there are no fixities, give 'baseFixities'. getFixities :: [(String, Fixity)] -> [(String, Fixity)] getFixities fixities = if null fixities then baseFixities else fixities findFixity :: [(String, Fixity)] -> LHsExpr GhcPs -> Fixity findFixity fs r = askFix fs (getIdent r) -- Expressions. #if defined(GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) findFixity' :: [(String, Fixity)] -> LocatedN RdrName -> Fixity #else findFixity' :: [(String, Fixity)] -> Located RdrName -> Fixity #endif findFixity' fs r = askFix fs (occNameString . rdrNameOcc . unLoc $ r) -- Patterns. askFix :: [(String, Fixity)] -> String -> Fixity askFix xs = \k -> lookupWithDefault defaultFixity k xs where lookupWithDefault def_v k mp1 = fromMaybe def_v $ lookup k mp1 -- All fixities defined in the Prelude. preludeFixities :: [(String, Fixity)] preludeFixities = concat [ infixr_ 9 ["."] , infixl_ 9 ["!!"] , infixr_ 8 ["^","^^","**"] , infixl_ 7 ["*","/","quot","rem","div","mod",":%","%"] , infixl_ 6 ["+","-"] , infixr_ 5 [":","++"] , infix_ 4 ["==","/=","<","<=",">=",">","elem","notElem"] , infixr_ 3 ["&&"] , infixr_ 2 ["||"] , infixl_ 1 [">>",">>="] , infixr_ 1 ["=<<"] , infixr_ 0 ["$","$!","seq"] ] -- All fixities defined in the base package. Note that the @+++@ -- operator appears in both Control.Arrows and -- Text.ParserCombinators.ReadP. The listed precedence for @+++@ in -- this list is that of Control.Arrows. baseFixities :: [(String, Fixity)] baseFixities = preludeFixities ++ concat [ infixr_ 9 ["Compose"] , infixl_ 9 ["!","//","!:"] , infixl_ 8 ["shift","rotate","shiftL","shiftR","rotateL","rotateR"] , infixl_ 7 [".&."] , infixl_ 6 ["xor"] , infix_ 6 [":+"] , infixr_ 6 ["<>"] , infixl_ 5 [".|."] , infixr_ 5 ["+:+","<++","<+>","<|"] -- Fixity conflict for +++ between ReadP and Arrow. , infix_ 5 ["\\\\"] , infixl_ 4 ["<$>","<$","$>","<*>","<*","*>","<**>","<$!>"] , infix_ 4 ["elemP","notElemP",":~:", ":~~:"] , infixl_ 3 ["<|>"] , infixr_ 3 ["&&&","***"] , infixr_ 2 ["+++","|||"] , infixr_ 1 ["<=<",">=>",">>>","<<<","^<<","<<^","^>>",">>^"] , infixl_ 0 ["on"] , infixr_ 0 ["par","pseq"] ] infixr_, infixl_, infix_ :: Int -> [String] -> [(String,Fixity)] infixr_ = fixity InfixR infixl_ = fixity InfixL infix_ = fixity InfixN fixity :: FixityDirection -> Int -> [String] -> [(String, Fixity)] fixity a p = map (,Fixity (SourceText "") p a) #if defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) fixitiesFromModule :: Located HsModule -> [(String, Fixity)] #else fixitiesFromModule :: Located (HsModule GhcPs) -> [(String, Fixity)] #endif #if defined (GHCLIB_API_HEAD) fixitiesFromModule (L _ (HsModule _ _ _ _ decls)) = concatMap f decls #elif defined (GHCLIB_API_904) || defined(GHCLIB_API_902) fixitiesFromModule (L _ (HsModule _ _ _ _ _ decls _ _)) = concatMap f decls #elif defined (GHCLIB_API_900) fixitiesFromModule (L _ (HsModule _ _ _ _ decls _ _)) = concatMap f decls #else fixitiesFromModule (L _ (HsModule _ _ _ decls _ _)) = concatMap f decls #endif where f :: LHsDecl GhcPs -> [(String, Fixity)] f (L _ (SigD _ (FixSig _ (FixitySig _ ops (Fixity _ p dir))))) = fixity dir p (map (occNameString. rdrNameOcc . unLoc) ops) f _ = [] ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Settings/Config.hs0000644000000000000000000000645114274052553025777 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# OPTIONS_GHC -Wno-missing-fields #-} {-# LANGUAGE CPP #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Settings.Config( fakeSettings #if !defined (GHCLIB_API_HEAD) , fakeLlvmConfig #endif ) where #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Settings.Config import GHC.Driver.Session import GHC.Utils.Fingerprint import GHC.Platform import GHC.Settings #elif defined (GHCLIB_API_810) import Config import DynFlags import Fingerprint import GHC.Platform import ToolSettings #else import Config import DynFlags import Fingerprint import Platform #endif fakeSettings :: Settings fakeSettings = Settings #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810) { sGhcNameVersion=ghcNameVersion , sFileSettings=fileSettings , sTargetPlatform=platform , sPlatformMisc=platformMisc # if !defined(GHCLIB_API_HEAD) && !defined(GHCLIB_API_904) && !defined(GHCLIB_API_902) , sPlatformConstants=platformConstants # endif , sToolSettings=toolSettings } #else { sTargetPlatform=platform , sPlatformConstants=platformConstants , sProjectVersion=cProjectVersion , sProgramName="ghc" , sOpt_P_fingerprint=fingerprint0 } #endif where #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810) toolSettings = ToolSettings { toolSettings_opt_P_fingerprint=fingerprint0 } fileSettings = FileSettings {} platformMisc = PlatformMisc {} ghcNameVersion = GhcNameVersion{ghcNameVersion_programName="ghc" ,ghcNameVersion_projectVersion=cProjectVersion } #endif platform = #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined (GHCLIB_API_902) genericPlatform #else Platform{ # if defined (GHCLIB_API_900) -- It doesn't matter what values we write here as these fields are -- not referenced for our purposes. However the fields are strict -- so we must say something. platformByteOrder=LittleEndian , platformHasGnuNonexecStack=True , platformHasIdentDirective=False , platformHasSubsectionsViaSymbols=False , platformIsCrossCompiling=False , platformLeadingUnderscore=False , platformTablesNextToCode=False , # endif # if defined (GHCLIB_API_810) || defined (GHCLIB_API_900) platformWordSize=PW8 , platformMini=PlatformMini {platformMini_arch=ArchUnknown, platformMini_os=OSUnknown} # else platformWordSize=8 , platformOS=OSUnknown # endif , platformUnregisterised=True } #endif #if !defined(GHCLIB_API_HEAD) && !defined(GHCLIB_API_904) && !defined(GHCLIB_API_902) platformConstants = PlatformConstants{pc_DYNAMIC_BY_DEFAULT=False,pc_WORD_SIZE=8} #endif #if defined (GHCLIB_API_HEAD) -- Intentionally empty #elif defined(GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)|| defined (GHCLIB_API_810) fakeLlvmConfig :: LlvmConfig fakeLlvmConfig = LlvmConfig [] [] #else fakeLlvmConfig :: (LlvmTargets, LlvmPasses) fakeLlvmConfig = ([], []) #endif ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Driver/Flags.hs0000644000000000000000000000077714274052553025266 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-orphans #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Driver.Flags () where #if !(defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)) import DynFlags #endif -- This instance landed in -- https://gitlab.haskell.org/ghc/ghc/merge_requests/2905. #if defined(GHCLIB_API_808) || defined(GHCLIB_API_810) instance Bounded Language where minBound = Haskell98 maxBound = Haskell2010 #endif ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Driver/Session.hs0000644000000000000000000001712414274052553025647 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-orphans #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Driver.Session( readExtension , extensionImplications -- Landed in https://gitlab.haskell.org/ghc/ghc/merge_requests/2654. #if defined (GHCLIB_API_808) || defined (GHCLIB_API_810) , TurnOnFlag, turnOn, turnOff, impliedGFlags, impliedOffGFlags, impliedXFlags #endif , parsePragmasIntoDynFlags ) where #if defined (GHCLIB_API_808) || defined (GHCLIB_API_810) import qualified GHC.LanguageExtensions as LangExt #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Utils.Panic import GHC.Parser.Header import GHC.Data.StringBuffer import GHC.Driver.Session #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) import GHC.Types.SourceError #else import GHC.Driver.Types #endif #else import Panic import HeaderInfo import StringBuffer import DynFlags import HscTypes #endif import GHC.LanguageExtensions.Type import Data.List import Data.Maybe import qualified Data.Map as Map -- Landed in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707. #if defined (GHCLIB_API_808) || defined (GHCLIB_API_810) import Data.Function -- For `compareOn`. instance Ord Extension where compare = compare `on` fromEnum #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) import GHC.Driver.Config.Parser #endif -- | Parse a GHC extension. readExtension :: String -> Maybe Extension readExtension s = flagSpecFlag <$> find (\(FlagSpec n _ _ _) -> n == s) xFlags -- | Implicitly enabled/disabled extensions. extensionImplications :: [(Extension, ([Extension], [Extension]))] extensionImplications = map f $ Map.toList implicationsMap where f (e, ps) = (fromJust (readExtension e), ps) implicationsMap :: Map.Map String ([Extension], [Extension]) implicationsMap = Map.fromListWith (<>) [(show a, ([c | b], [c | not b])) | (a, flag, c) <- impliedXFlags, let b = flag == turnOn] -- Landed in -- https://gitlab.haskell.org/ghc/ghc/merge_requests/2654. Copied from -- 'ghc/compiler/main/DynFlags.hs'. #if defined(GHCLIB_API_808) || defined(GHCLIB_API_810) type TurnOnFlag = Bool -- True <=> we are turning the flag on -- False <=> we are turning the flag off turnOn :: TurnOnFlag; turnOn = True turnOff :: TurnOnFlag; turnOff = False -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles) ,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables) ,(Opt_Strictness, turnOn, Opt_WorkerWrapper) ,(Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) ,(Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppVarsOfHoleFits) ,(Opt_UnclutterValidHoleFits, turnOff, Opt_ShowDocsOfHoleFits) ,(Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) ,(Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits)] -- General flags that are switched on/off when other general flags are switched -- off impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)] impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)] impliedXFlags -- See Note [Updating flag description in the User's Guide] = [ (LangExt.RankNTypes, turnOn, LangExt.ExplicitForAll) , (LangExt.QuantifiedConstraints, turnOn, LangExt.ExplicitForAll) , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExplicitForAll) , (LangExt.LiberalTypeSynonyms, turnOn, LangExt.ExplicitForAll) , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll) , (LangExt.FlexibleInstances, turnOn, LangExt.TypeSynonymInstances) , (LangExt.FunctionalDependencies, turnOn, LangExt.MultiParamTypeClasses) , (LangExt.MultiParamTypeClasses, turnOn, LangExt.ConstrainedClassMethods) -- c.f. #7854 , (LangExt.TypeFamilyDependencies, turnOn, LangExt.TypeFamilies) , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! , (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies) , (LangExt.GADTs, turnOn, LangExt.GADTSyntax) , (LangExt.GADTs, turnOn, LangExt.MonoLocalBinds) , (LangExt.TypeFamilies, turnOn, LangExt.MonoLocalBinds) , (LangExt.TypeFamilies, turnOn, LangExt.KindSignatures) -- Type families use kind signatures , (LangExt.PolyKinds, turnOn, LangExt.KindSignatures) -- Ditto polymorphic kinds -- TypeInType is now just a synonym for a couple of other extensions. , (LangExt.TypeInType, turnOn, LangExt.DataKinds) , (LangExt.TypeInType, turnOn, LangExt.PolyKinds) , (LangExt.TypeInType, turnOn, LangExt.KindSignatures) #if defined(GHCLIB_API_810) -- Standalone kind signatures are a replacement for CUSKs. , (LangExt.StandaloneKindSignatures, turnOff, LangExt.CUSKs) #endif -- AutoDeriveTypeable is not very useful without DeriveDataTypeable , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable) -- We turn this on so that we can export associated type -- type synonyms in subordinates (e.g. MyClass(type AssocType)) , (LangExt.TypeFamilies, turnOn, LangExt.ExplicitNamespaces) , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces) , (LangExt.ImpredicativeTypes, turnOn, LangExt.RankNTypes) -- Record wild-cards implies field disambiguation -- Otherwise if you write (C {..}) you may well get -- stuff like " 'a' not in scope ", which is a bit silly -- if the compiler has just filled in field 'a' of constructor 'C' , (LangExt.RecordWildCards, turnOn, LangExt.DisambiguateRecordFields) , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp) , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI) , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor) , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable) -- Duplicate record fields require field disambiguation , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields) , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes) , (LangExt.Strict, turnOn, LangExt.StrictData) ] #endif parsePragmasIntoDynFlags :: DynFlags -> ([Extension], [Extension]) -> FilePath -> String -> IO (Either String DynFlags) parsePragmasIntoDynFlags flags (enable, disable) file str = catchErrors $ do #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) let (_, opts) = getOptions (initParserOpts flags) (stringToStringBuffer str) file #else let opts = getOptions flags (stringToStringBuffer str) file #endif -- Important : apply enables, disables *before* parsing dynamic -- file pragmas. let flags' = foldl' xopt_set flags enable let flags'' = foldl' xopt_unset flags' disable (flags, _, _) <- parseDynamicFilePragma flags'' opts return $ Right (flags `gopt_set` Opt_KeepRawTokenStream) where catchErrors :: IO (Either String DynFlags) -> IO (Either String DynFlags) catchErrors act = handleGhcException reportErr (handleSourceError reportErr act) reportErr e = return $ Left (show e) ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs.hs0000644000000000000000000000154214274052553023340 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs( modName ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Hs # if !defined (GHCLIB_API_HEAD) import GHC.Unit.Module # endif import GHC.Types.SrcLoc #elif defined (GHCLIB_API_810) import GHC.Hs import Module import SrcLoc #else import HsSyn import Module import SrcLoc #endif #if defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) modName :: Located HsModule -> String #else modName :: Located (HsModule GhcPs) -> String #endif modName (L _ HsModule {hsmodName=Nothing}) = "Main" modName (L _ HsModule {hsmodName=Just (L _ n)}) = moduleNameString n ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs0000644000000000000000000002332514274052553024261 0ustar0000000000000000-- 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, isQuasiQuoteExpr, isQuasiQuoteSplice, isOverLabel, isDotApp, isTypeApp, isWHNF, isLCase, isFieldPun, isFieldPunUpdate, isRecStmt, isParComp, isMDo, isListComp, isMonadComp, isTupleSection, isString, isPrimLiteral, isSpliceDecl, isFieldWildcard, isUnboxed, isWholeFrac, isStrictMatch, isMultiIf, isProc, isTransStmt, hasFieldsDotDot, varToStr, strToVar, fromChar ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) import GHC.Types.SourceText #endif import GHC.Types.SrcLoc import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Types.Basic import GHC.Builtin.Types #else import SrcLoc import RdrName import OccName import Name import BasicTypes import TysWiredIn #endif import Data.Ratio -- '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, isQuasiQuoteExpr, isLambda, isDotApp, isTypeApp, isWHNF, isLCase, isOverLabel :: 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 #if defined (GHCLIB_API_HEAD) isQuasiQuoteExpr = \case (L _ (HsUntypedSplice _ HsQuasiQuote{})) -> True; _ -> False #else isQuasiQuoteExpr = \case (L _ (HsSpliceE _ HsQuasiQuote{})) -> True; _ -> False #endif isQuasiQuote = isQuasiQuoteExpr -- Backwards compat. 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 #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) (L _ (HsPar _ _ x _)) -> isWHNF x #else (L _ (HsPar _ x)) -> isWHNF x #endif (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 isOverLabel = \case (L _ HsOverLabel{}) -> True; _ -> False #if defined (GHCLIB_API_HEAD) isQuasiQuoteSplice :: HsUntypedSplice GhcPs -> Bool #else isQuasiQuoteSplice :: HsSplice GhcPs -> Bool #endif isQuasiQuoteSplice = \case HsQuasiQuote{} -> True; _ -> False #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_901) isStrictMatch :: HsMatchContext GhcPs -> Bool #else isStrictMatch :: HsMatchContext RdrName -> Bool #endif isStrictMatch = \case FunRhs{mc_strictness=SrcStrict} -> True; _ -> False -- Field is punned e.g. '{foo}'. #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isFieldPun :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool isFieldPun = \case (L _ HsFieldBind {hfbPun=True}) -> True; _ -> False #else isFieldPun :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool isFieldPun = \case (L _ HsRecField {hsRecPun=True}) -> True; _ -> False #endif -- Field puns in updates have a different type to field puns in -- constructions. #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isFieldPunUpdate :: HsFieldBind (LAmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool isFieldPunUpdate = \case HsFieldBind {hfbPun=True} -> True; _ -> False #else isFieldPunUpdate :: HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool isFieldPunUpdate = \case HsRecField {hsRecPun=True} -> True; _ -> False #endif -- 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 -- TODO: Seems `HsStmtContext (HsDoRn p)` on master right now. #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isMDo :: HsDoFlavour -> Bool isMDo = \case MDoExpr _ -> True; _ -> False isMonadComp :: HsDoFlavour -> Bool isMonadComp = \case MonadComp -> True; _ -> False isListComp :: HsDoFlavour -> Bool isListComp = \case ListComp -> True; _ -> False #elif defined(GHCLIB_API_902) || defined (GHCLIB_API_900) isMDo :: HsStmtContext GhcRn -> Bool isMDo = \case MDoExpr _ -> True; _ -> False isMonadComp :: HsStmtContext GhcRn -> Bool isMonadComp = \case MonadComp -> True; _ -> False isListComp :: HsStmtContext GhcRn -> Bool isListComp = \case ListComp -> True; _ -> False #else isMDo :: HsStmtContext Name -> Bool isMDo = \case MDoExpr -> True; _ -> False isMonadComp :: HsStmtContext Name -> Bool isMonadComp = \case MonadComp -> True; _ -> False isListComp :: HsStmtContext Name -> Bool isListComp = \case ListComp -> True; _ -> False #endif 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 #if defined (GHCLIB_API_HEAD) isSpliceDecl = \case HsTypedSplice{} -> True HsUntypedSplice{} -> True _ -> False #else isSpliceDecl = \case HsSpliceE{} -> True; _ -> False #endif isMultiIf :: HsExpr GhcPs -> Bool isMultiIf = \case HsMultiIf{} -> True; _ -> False isProc :: HsExpr GhcPs -> Bool isProc = \case HsProc{} -> True; _ -> False isTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool isTransStmt = \case TransStmt{} -> True; _ -> False -- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'. #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool #else isFieldWildcard :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool #endif isFieldWildcard = \case #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) (L _ HsFieldBind {hfbRHS=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_" #elif defined(GHCLIB_API_902) || defined (GHCLIB_API_900) (L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_" #elif defined (GHCLIB_API_810) (L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ _))}) -> True #else (L _ HsRecField {hsRecFieldArg=(L _ (EWildPat _))}) -> True #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) (L _ HsFieldBind {hfbPun=True}) -> True (L _ HsFieldBind {}) -> False #else (L _ HsRecField {hsRecPun=True}) -> True (L _ HsRecField {}) -> False #endif isUnboxed :: Boxity -> Bool isUnboxed = \case Unboxed -> True; _ -> False isWholeFrac :: HsExpr GhcPs -> Bool #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isWholeFrac (HsLit _ (HsRat _ fl@FL{} _)) = denominator (rationalFromFractionalLit fl) == 1 isWholeFrac (HsOverLit _ (OverLit _ (HsFractional fl@FL {}) )) = denominator (rationalFromFractionalLit fl) == 1 #elif defined(GHCLIB_API_902) isWholeFrac (HsLit _ (HsRat _ fl@FL{} _)) = denominator (rationalFromFractionalLit fl) == 1 isWholeFrac (HsOverLit _ (OverLit _ (HsFractional fl@FL {}) _)) = denominator (rationalFromFractionalLit fl) == 1 #else isWholeFrac (HsLit _ (HsRat _ (FL _ _ v) _)) = denominator v == 1 isWholeFrac (HsOverLit _ (OverLit _ (HsFractional (FL _ _ v)) _)) = denominator v == 1 #endif isWholeFrac _ = 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 #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) strToVar x = noLocA $ HsVar noExtField (noLocA $ mkRdrUnqual (mkVarOcc x)) #elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810) strToVar x = noLoc $ HsVar noExtField (noLoc $ mkRdrUnqual (mkVarOcc x)) #else strToVar x = noLoc $ HsVar noExt (noLoc $ mkRdrUnqual (mkVarOcc x)) #endif fromChar :: LHsExpr GhcPs -> Maybe Char fromChar = \case (L _ (HsLit _ (HsChar _ x))) -> Just x; _ -> Nothing ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/Pat.hs0000644000000000000000000001643214274052553024070 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs.Pat( patToStr, strToPat , fromPChar , hasPFieldsDotDot , isPFieldWildcard, isPWildcard, isPFieldPun, isPatTypeSig, isPBangPat, isPViewPat , isSplicePat ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc import GHC.Builtin.Types import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Data.FastString #else import SrcLoc import TysWiredIn import RdrName import OccName import FastString #endif patToStr :: LPat GhcPs -> String #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "True" = "True" patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "False" = "False" patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "[]" = "[]" patToStr _ = "" #elif defined (GHCLIB_API_900) patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True" patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False" patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]" patToStr _ = "" #elif defined (GHCLIB_API_810) patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True" patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False" patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]" patToStr _ = "" #else patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True" patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False" patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]" patToStr _ = "" #endif strToPat :: String -> LPat GhcPs strToPat z | z == "True" = #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) noLocA $ #elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noLoc $ #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) ConPat noAnn (noLocA true_RDR) (PrefixCon [] []) #elif defined (GHCLIB_API_900) ConPat noExtField (noLoc true_RDR) (PrefixCon []) #else ConPatIn (noLoc true_RDR) (PrefixCon []) #endif | z == "False" = #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) noLocA $ #elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noLoc $ #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) ConPat noAnn (noLocA false_RDR) (PrefixCon [] []) #elif defined (GHCLIB_API_900) ConPat noExtField (noLoc false_RDR) (PrefixCon []) #else ConPatIn (noLoc false_RDR) (PrefixCon []) #endif | z == "[]" = #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) noLocA $ #elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noLoc $ #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) ConPat noAnn (noLocA $ nameRdrName nilDataConName) (PrefixCon [] []) #elif defined (GHCLIB_API_900) ConPat noExtField (noLoc $ nameRdrName nilDataConName) (PrefixCon []) #else ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon []) #endif | otherwise = #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) noLocA $ VarPat noExtField (noLocA $ mkVarUnqual (fsLit z)) #elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noLoc $ VarPat noExtField (noLoc $ mkVarUnqual (fsLit z)) #else VarPat noExt (noLoc $ mkVarUnqual (fsLit z)) #endif fromPChar :: LPat GhcPs -> Maybe Char #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) fromPChar (L _ (LitPat _ (HsChar _ x))) = Just x #else fromPChar (dL -> L _ (LitPat _ (HsChar _ x))) = Just x #endif fromPChar _ = Nothing -- Contains a '..' as in 'Foo{..}' hasPFieldsDotDot :: HsRecFields GhcPs (LPat GhcPs) -> Bool hasPFieldsDotDot HsRecFields {rec_dotdot=Just _} = True hasPFieldsDotDot _ = False -- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'. #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isPFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool #else isPFieldWildcard :: LHsRecField GhcPs (LPat GhcPs) -> Bool #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isPFieldWildcard (L _ HsFieldBind {hfbRHS=L _ WildPat {}}) = True isPFieldWildcard (L _ HsFieldBind {hfbPun=True}) = True isPFieldWildcard (L _ HsFieldBind {}) = False #elif defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isPFieldWildcard (L _ HsRecField {hsRecFieldArg=L _ WildPat {}}) = True isPFieldWildcard (L _ HsRecField {hsRecPun=True}) = True isPFieldWildcard (L _ HsRecField {}) = False #else isPFieldWildcard (dL -> L _ HsRecField {hsRecFieldArg=LL _ WildPat {}}) = True isPFieldWildcard (dL -> L _ HsRecField {hsRecPun=True}) = True isPFieldWildcard (dL -> L _ HsRecField {}) = False #endif isPWildcard :: LPat GhcPs -> Bool #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isPWildcard (L _ (WildPat _)) = True #else isPWildcard (dL -> L _ (WildPat _)) = True #endif isPWildcard _ = False #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isPFieldPun :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool #else isPFieldPun :: LHsRecField GhcPs (LPat GhcPs) -> Bool #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) isPFieldPun (L _ HsFieldBind {hfbPun=True}) = True #elif defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isPFieldPun (L _ HsRecField {hsRecPun=True}) = True #else isPFieldPun (dL -> L _ HsRecField {hsRecPun=True}) = True #endif isPFieldPun _ = False isPatTypeSig, isPBangPat, isPViewPat :: LPat GhcPs -> Bool #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isPatTypeSig (L _ SigPat{}) = True; isPatTypeSig _ = False isPBangPat (L _ BangPat{}) = True; isPBangPat _ = False isPViewPat (L _ ViewPat{}) = True; isPViewPat _ = False #else isPatTypeSig (dL -> L _ SigPat{}) = True; isPatTypeSig _ = False isPBangPat (dL -> L _ BangPat{}) = True; isPBangPat _ = False isPViewPat (dL -> L _ ViewPat{}) = True; isPViewPat _ = False #endif isSplicePat :: LPat GhcPs -> Bool #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) isSplicePat (L _ SplicePat{}) = True; isSplicePat _ = False #else isSplicePat (dL -> L _ SplicePat{}) = True; isSplicePat _ = False #endif ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/Type.hs0000644000000000000000000000206214274052553024257 0ustar0000000000000000-- Copyright (c) 2021, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs.Type ( fromTyParen , isTyQuasiQuote, isUnboxedTuple, isKindTyApp ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc #else import SrcLoc #endif isKindTyApp :: LHsType GhcPs -> Bool isKindTyApp = \case (L _ HsAppKindTy{}) -> True; _ -> False fromTyParen :: LHsType GhcPs -> LHsType GhcPs fromTyParen (L _ (HsParTy _ x)) = x fromTyParen x = x isTyQuasiQuote :: LHsType GhcPs -> Bool isTyQuasiQuote (L _ (HsSpliceTy _ HsQuasiQuote{})) = True isTyQuasiQuote _ = False isUnboxedTuple :: HsTupleSort -> Bool isUnboxedTuple HsUnboxedTuple = True isUnboxedTuple _ = False ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/Types.hs0000644000000000000000000000054014274052553024441 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. module Language.Haskell.GhclibParserEx.GHC.Hs.Types {-# DEPRECATED "Use Language.Haskell.GhclibParserEx.GHC.Hs.Type instead" #-} ( module Language.Haskell.GhclibParserEx.GHC.Hs.Type ) where import Language.Haskell.GhclibParserEx.GHC.Hs.Type ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/Decls.hs0000644000000000000000000000163614274052553024376 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs.Decls( isNewType, isForD, isDerivD, isClsDefSig ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc #else import SrcLoc #endif isNewType :: NewOrData -> Bool isNewType NewType = True isNewType DataType = False isForD, isDerivD :: LHsDecl GhcPs -> Bool isForD (L _ ForD{}) = True; isForD _ = False isDerivD (L _ DerivD{}) = True; isDerivD _ = False isClsDefSig :: Sig GhcPs -> Bool isClsDefSig (ClassOpSig _ True _ _) = True; isClsDefSig _ = False ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/Binds.hs0000644000000000000000000000105114274052553024372 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs.Binds( isPatSynBind ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs.Binds import GHC.Hs.Extension #else import HsBinds import HsExtension #endif isPatSynBind :: HsBind GhcPs -> Bool isPatSynBind PatSynBind{} = True isPatSynBind _ = False ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/ImpExp.hs0000644000000000000000000000267114274052553024546 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs.ImpExp( isPatSynIE #if defined (MIN_VERSION_ghc_lib_parser) # if !MIN_VERSION_ghc_lib_parser(1, 0, 0) || MIN_VERSION_ghc_lib_parser(8, 10, 0) , isImportQualifiedPost # endif #elif __GLASGOW_HASKELL__ >= 810 , isImportQualifiedPost #endif ) where #if defined (GHCLIB_API_HEAD) import GHC.Hs.Extension (GhcPs) #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Hs.ImpExp # if !defined (GHCLIB_API_HEAD) import GHC.Types.Name.Reader # endif #elif defined (GHCLIB_API_810) import GHC.Hs.ImpExp import RdrName #else import HsImpExp import RdrName #endif #if defined (GHCLIB_API_HEAD) isPatSynIE :: IEWrappedName GhcPs -> Bool #else isPatSynIE :: IEWrappedName RdrName -> Bool #endif isPatSynIE IEPattern{} = True isPatSynIE _ = False #if defined (MIN_VERSION_ghc_lib_parser) # if !MIN_VERSION_ghc_lib_parser(1, 0, 0) || MIN_VERSION_ghc_lib_parser(8, 10, 0) isImportQualifiedPost :: ImportDeclQualifiedStyle -> Bool isImportQualifiedPost QualifiedPost = True isImportQualifiedPost _ = False # endif #elif __GLASGOW_HASKELL__ >= 810 isImportQualifiedPost :: ImportDeclQualifiedStyle -> Bool isImportQualifiedPost QualifiedPost = True isImportQualifiedPost _ = False #endif ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Hs/ExtendInstances.hs0000644000000000000000000000426614274052553026445 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} #include "ghclib_api.h" 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. #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Utils.Outputable #else import Outputable #endif 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) = #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) showPprUnsafe $ showAstData BlankSrcSpan BlankEpAnnotations e #else showSDocUnsafe $ showAstData BlankSrcSpan e #endif 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) = #if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902) showPprUnsafe $ ppr e #else showSDocUnsafe $ ppr e #endif ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Parser.hs0000644000000000000000000001270114274052553024221 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Parser( parseFile , parseModule , parseSignature , parseImport , parseStatement , parseBackpack , parseDeclaration , parseExpression , parsePattern , parseTypeSignature , parseStmt , parseIdentifier , parseType , parseHeader , parse ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) # if defined (GHCLIB_API_902) import GHC.Driver.Config # endif # if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) import GHC.Driver.Config.Parser # endif #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Parser.PostProcess import GHC.Driver.Session import GHC.Data.StringBuffer import GHC.Parser.Lexer import qualified GHC.Parser.Lexer as Lexer import qualified GHC.Parser as Parser import GHC.Data.FastString import GHC.Types.SrcLoc import GHC.Driver.Backpack.Syntax import GHC.Unit.Info import GHC.Types.Name.Reader #else import DynFlags import StringBuffer import Lexer import qualified Parser import FastString import SrcLoc import BkpSyn import PackageConfig import RdrName #endif #if defined (GHCLIB_API_810) import RdrHsSyn #endif parse :: P a -> String -> DynFlags -> ParseResult a parse p str flags = Lexer.unP p parseState where location = mkRealSrcLoc (mkFastString "") 1 1 buffer = stringToStringBuffer str parseState = #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) initParserState (initParserOpts flags) buffer location #else mkPState flags buffer location #endif #if defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) parseModule :: String -> DynFlags -> ParseResult (Located HsModule) #else parseModule :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs)) #endif parseModule = parse Parser.parseModule #if defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) 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) parseImport = parse Parser.parseImport parseStatement :: String -> DynFlags -> ParseResult (LStmt GhcPs (LHsExpr GhcPs)) parseStatement = parse Parser.parseStatement parseBackpack :: String -> DynFlags -> ParseResult [LHsUnit PackageName] parseBackpack = parse Parser.parseBackpack parseDeclaration :: String -> DynFlags -> ParseResult (LHsDecl GhcPs) parseDeclaration = parse Parser.parseDeclaration parseExpression :: String -> DynFlags -> ParseResult (LHsExpr GhcPs) #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) parseExpression s flags = -- The need for annotations here came about first manifested with -- ghc-9.0.1 case parse Parser.parseExpression s flags of POk state e -> let e' = e :: ECP parser_validator = unECP e' :: PV (LHsExpr GhcPs) parser = runPV parser_validator :: P (LHsExpr GhcPs) in unP parser state :: ParseResult (LHsExpr GhcPs) PFailed ps -> PFailed ps #elif defined (GHCLIB_API_810) || defined (GHCLIB_API_900) parseExpression s flags = case parse Parser.parseExpression s flags of POk s e -> unP (runECP_P e) s PFailed ps -> PFailed ps #else parseExpression = parse Parser.parseExpression #endif parsePattern :: String -> DynFlags -> ParseResult (LPat GhcPs) parsePattern = parse Parser.parsePattern parseTypeSignature :: String -> DynFlags -> ParseResult (LHsDecl GhcPs) parseTypeSignature = parse Parser.parseTypeSignature parseStmt :: String -> DynFlags -> ParseResult (Maybe (LStmt GhcPs (LHsExpr GhcPs))) parseStmt = parse Parser.parseStmt #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) parseIdentifier :: String -> DynFlags -> ParseResult (LocatedN RdrName) #else parseIdentifier :: String -> DynFlags -> ParseResult (Located RdrName) #endif parseIdentifier = parse Parser.parseIdentifier parseType :: String -> DynFlags -> ParseResult (LHsType GhcPs) parseType = parse Parser.parseType #if defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) parseHeader :: String -> DynFlags -> ParseResult (Located HsModule) #else parseHeader :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs)) #endif parseHeader = parse Parser.parseHeader #if defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) parseFile :: String -> DynFlags -> String -> ParseResult (Located HsModule) #else parseFile :: String -> DynFlags -> String -> ParseResult (Located (HsModule GhcPs)) #endif parseFile filename flags str = unP Parser.parseModule parseState where location = mkRealSrcLoc (mkFastString filename) 1 1 buffer = stringToStringBuffer str parseState = #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) initParserState (initParserOpts flags) buffer location #else mkPState flags buffer location #endif ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Types/Name/Reader.hs0000644000000000000000000000432214274052553026153 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader( occNameStr, rdrNameStr, isSpecial, unqual, fromQual, isSymbolRdrName ) where #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined (GHCLIB_API_902) import GHC.Parser.Annotation #endif #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc import GHC.Types.Name import GHC.Types.Name.Reader #else import SrcLoc import RdrName import OccName import Name #endif -- These names may not seem natural here but they work out in -- practice. The use of thse two functions is thoroughly ubiquitous. occNameStr :: RdrName -> String; occNameStr = occNameString . rdrNameOcc #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined (GHCLIB_API_902) rdrNameStr :: GHC.Parser.Annotation.LocatedN RdrName -> String #else rdrNameStr :: Located RdrName -> String #endif rdrNameStr = occNameStr . unLoc -- Builtin type or data constructors. #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined (GHCLIB_API_902) isSpecial :: LocatedN RdrName -> Bool #else isSpecial :: Located RdrName -> Bool #endif isSpecial (L _ (Exact n)) = isDataConName n || isTyConName n isSpecial _ = False -- Coerce qualified names to unqualified (by discarding the -- qualifier). #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined (GHCLIB_API_902) unqual :: LocatedN RdrName -> LocatedN RdrName #else unqual :: Located RdrName -> Located RdrName #endif unqual (L loc (Qual _ n)) = L loc $ mkRdrUnqual n unqual x = x -- Extract the occ name from a qualified/unqualified reader name. #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_904) || defined (GHCLIB_API_902) fromQual :: LocatedN RdrName -> Maybe OccName #else fromQual :: Located RdrName -> Maybe OccName #endif fromQual (L _ (Qual _ x)) = Just x fromQual (L _ (Unqual x)) = Just x fromQual _ = Nothing -- Test if the reader name is that of an operator (be it a data -- constructor, variable or whatever). isSymbolRdrName :: RdrName -> Bool isSymbolRdrName = isSymOcc . rdrNameOcc ghc-lib-parser-ex-9.4.0.0/src/Language/Haskell/GhclibParserEx/GHC/Utils/Outputable.hs0000644000000000000000000000113014274052553026203 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Utils.Outputable ( unsafePrettyPrint ) where #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Utils.Outputable #else import Outputable #endif unsafePrettyPrint :: Outputable a => a -> String unsafePrettyPrint = #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) showPprUnsafe . ppr #else showSDocUnsafe . ppr #endif ghc-lib-parser-ex-9.4.0.0/test/Test.hs0000644000000000000000000005207414274052553015532 0ustar0000000000000000-- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} #include "ghclib_api.h" import Test.Tasty import Test.Tasty.HUnit import System.FilePath import System.Directory as Directory import System.Environment import qualified System.FilePath as FilePath import System.IO.Extra import Control.Monad import Data.List.Extra import Data.Maybe import Data.Generics.Uniplate.Data #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) import GHC.Data.Bag #if !defined (GHCLIB_API_902) import GHC.Driver.Errors.Types #endif import GHC.Types.Error #endif import Language.Haskell.GhclibParserEx.Dump import Language.Haskell.GhclibParserEx.Fixity import Language.Haskell.GhclibParserEx.GHC.Settings.Config import Language.Haskell.GhclibParserEx.GHC.Parser import Language.Haskell.GhclibParserEx.GHC.Hs import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Language.Haskell.GhclibParserEx.GHC.Hs.Pat import Language.Haskell.GhclibParserEx.GHC.Hs.Type -- We only test 'isImportQualifiedPost' at this time which requires >= -- 8.10; avoid unused import warning. #if defined (MIN_VERSION_ghc_lib_parser) # if !MIN_VERSION_ghc_lib_parser(1, 0, 0) || MIN_VERSION_ghc_lib_parser(8, 10, 0) import Language.Haskell.GhclibParserEx.GHC.Hs.ImpExp # endif #elif __GLASGOW_HASKELL__ >= 810 import Language.Haskell.GhclibParserEx.GHC.Hs.ImpExp #endif import Language.Haskell.GhclibParserEx.GHC.Driver.Flags() import Language.Haskell.GhclibParserEx.GHC.Driver.Session import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810) import GHC.Hs #else import HsSyn #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) import GHC.Types.SrcLoc import GHC.Driver.Session import GHC.Parser.Lexer # if !defined (GHCLIB_API_HEAD) import GHC.Utils.Outputable #endif # if !defined (GHCLIB_API_900) import GHC.Driver.Ppr # if !defined (GHCLIB_API_HEAD) && !defined (GHCLIB_API_904) import GHC.Parser.Errors.Ppr # endif # endif import GHC.Utils.Error import GHC.Types.Name.Reader import GHC.Types.Name.Occurrence #else import SrcLoc import DynFlags import Lexer import Outputable import ErrUtils import RdrName import OccName #endif import GHC.LanguageExtensions.Type #if defined (GHCLIB_API_808) import Bag #endif basicDynFlags :: DynFlags basicDynFlags = defaultDynFlags fakeSettings #if !defined (GHCLIB_API_HEAD) fakeLlvmConfig #endif main :: IO () main = do setEnv "TASTY_NUM_THREADS" "1" setUnsafeGlobalDynFlags basicDynFlags defaultMain tests tests :: TestTree tests = testGroup " All tests" [ parseTests , fixityTests , extendInstancesTests , expressionPredicateTests , typePredicateTests , patternPredicateTests , dynFlagsTests , nameTests ] makeFile :: FilePath -> String -> IO FilePath makeFile relPath contents = do Directory.createDirectoryIfMissing True $ FilePath.takeDirectory relPath writeFile relPath contents return relPath #if defined(GHCLIB_API_HEAD) || defined (GHCLIB_API_904) report :: DynFlags -> Bag (MsgEnvelope GhcMessage) -> String report flags msgs = concat [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLoc msgs ] #elif defined (GHCLIB_API_902) report :: DynFlags -> Bag (MsgEnvelope DecoratedSDoc) -> String report flags msgs = concat [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLoc msgs ] #else report :: DynFlags -> WarningMessages -> String report flags msgs = concat [ showSDoc flags msg | msg <- pprErrMsgBagWithLoc msgs ] #endif chkParseResult :: DynFlags -> ParseResult a -> IO () chkParseResult flags = \case POk s _ -> do #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) let (wrns, errs) = getPsMessages s #elif defined (GHCLIB_API_902) let (wrns, errs) = getMessages s #else let (wrns, errs) = getMessages s flags #endif when (not (null errs) || not (null wrns)) $ #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) assertFailure ( report flags (getMessages (GhcPsMessage <$> wrns)) ++ report flags (getMessages (GhcPsMessage <$> errs)) ) #elif defined (GHCLIB_API_902) assertFailure (report flags (fmap pprWarning wrns) ++ report flags (fmap pprError errs)) #else assertFailure (report flags wrns ++ report flags errs) #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) PFailed s -> assertFailure (report flags $ getMessages (GhcPsMessage <$> snd (getPsMessages s))) #elif defined (GHCLIB_API_902) PFailed s -> assertFailure (report flags $ fmap pprError (snd (getMessages s))) #elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810) PFailed s -> assertFailure (report flags $ snd (getMessages s flags)) #else PFailed _ loc err -> assertFailure (report flags $ unitBag $ mkPlainErrMsg flags loc err) #endif parseTests :: TestTree parseTests = testGroup "Parse tests" [ testCase "Module" $ chkParseResult flags ( parseModule (unlines [ "module Foo (readMany) where" , "import Data.List" , "import Data.Maybe" , "readMany = unfoldr $ listToMaybe . concatMap reads . tails" ]) flags) , testCase "Module" $ chkParseResult flags ( parseModule (unlines [ "module Foo (readMany) where" , "import Data.List" , "import Data.Maybe" , "readMany = unfoldr $ listToMaybe . concatMap reads . tails" ]) flags) , testCase "Signature" $ chkParseResult flags ( parseSignature (unlines [ "signature Str where" , "data Str" , "empty :: Str" , "append :: Str -> Str -> Str" ]) flags) , testCase "Import" $ chkParseResult flags ( parseImport "import qualified \"foo-lib\" Foo as Bar hiding ((<.>))" flags) , testCase "Statement" $ chkParseResult flags ( parseStatement "Foo foo <- bar" flags) , testCase "Backpack" $ chkParseResult flags ( parseBackpack (unlines [ "unit main where" , " module Main where" , " main = putStrLn \"Hello world!\"" ]) flags) , testCase "Expression" $ chkParseResult flags ( parseExpression "unfoldr $ listToMaybe . concatMap reads . tails" flags) , testCase "Declaration (1)" $ chkParseResult 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 flags ( parseDeclaration "infixr 4 <%@~" flags) , testCase "File" $ withTempDir $ \tmpDir -> do foo <- makeFile (tmpDir "Foo.hs") $ unlines ["{-# LANGUAGE ScopedTypeVariables #-}" , "module Foo (readMany) where" , "import Data.List" , "import Data.Maybe" , "readMany = unfoldr $ listToMaybe . concatMap reads . tails" ] s <- readFile' foo parsePragmasIntoDynFlags flags ([], []) foo s >>= \case Left msg -> assertFailure msg Right flags -> chkParseResult flags (parseFile foo flags s) ] where flags = basicDynFlags #if defined (GHCLIB_API_904) || defined (GHCLIB_API_902) || defined (GHCLIB_API_900) moduleTest :: String -> DynFlags -> (Located HsModule -> IO ()) -> IO () #else moduleTest :: String -> DynFlags -> (Located (HsModule GhcPs) -> IO ()) -> IO () #endif moduleTest s flags test = case parseModule s flags of POk _ e -> test e _ -> assertFailure "parse error" exprTest :: String -> DynFlags -> (LHsExpr GhcPs -> IO ()) -> IO () exprTest s flags test = case parseExpression s flags of POk _ e -> test e _ -> assertFailure "parse error" typeTest :: String -> DynFlags -> (LHsType GhcPs -> IO ()) -> IO () typeTest s flags test = case parseType s flags of POk _ e -> test e _ -> assertFailure "parse error" patTest :: String -> DynFlags -> (LPat GhcPs -> IO ()) -> IO () patTest s flags test = case parsePattern s flags of POk _ e -> test e _ -> assertFailure "parse error" fixityTests :: TestTree fixityTests = testGroup "Fixity tests" [ testCase "Expression" $ exprTest "1 + 2 * 3" flags (\e -> assertBool "parse tree not affected" $ #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations e) /= showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations (applyFixities [] e)) #else showSDocUnsafe (showAstData BlankSrcSpan e) /= showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] e)) #endif ) , testCase "Pattern" $ case parseDeclaration "f (1 : 2 :[]) = 1" flags of POk _ d -> assertBool "parse tree not affected" $ #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) || defined (GHCLIB_API_902) showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations d) /= showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations (applyFixities [] d)) #else showSDocUnsafe (showAstData BlankSrcSpan d) /= showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] d)) #endif PFailed{} -> assertFailure "parse error" , testCase "fixitiesFromModule" $ case parseModule "infixl 4 <*!" flags of POk _ m -> assertBool "one fixity expected" $ not (null (fixitiesFromModule m)) PFailed{} -> assertFailure "parse error" ] where flags = basicDynFlags extendInstancesTests :: TestTree extendInstancesTests = testGroup "Extend instances tests" [ testCase "Eq, Ord" $ exprTest "1 + 2 * 3" flags (\e -> 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' ) ] where flags = basicDynFlags typePredicateTests :: TestTree typePredicateTests = testGroup "Type predicate tests" [ testCase "isKindTyApp" $ test_with_exts [TypeApplications] "K @T" $ assert' . isKindTyApp , testCase "isKindTyApp" $ test_with_exts [TypeApplications] "K T" $ assert' . not . isKindTyApp ] where assert' = assertBool "" test_with_exts exts s = typeTest s (flags exts) flags = foldl' xopt_set basicDynFlags expressionPredicateTests :: TestTree expressionPredicateTests = testGroup "Expression predicate tests" [ testCase "isTag" $ test "foo" $ assert' . isTag "foo" , testCase "isTag" $ test "bar" $ assert' . not . isTag "foo" , testCase "isDol" $ test "f $ x" $ \case L _ (OpApp _ _ op _) -> assert' $ isDol op; _ -> assertFailure "unexpected" , testCase "isDot" $ test "f . g" $ \case L _ (OpApp _ _ op _) -> assert' $ isDot op; _ -> assertFailure "unexpected" , testCase "isReturn" $ test "return x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected" , testCase "isReturn" $ test "pure x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected" #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ _ x _) -> assert' $ isSection x; _ -> assertFailure "unexpected" #else , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected" #endif #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_904) , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ _ x _) -> assert' $ isSection x; _ -> assertFailure "unexpected" #else , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected" #endif , testCase "isRecConstr" $ test "Foo {bar=1}" $ assert' . isRecConstr , testCase "isRecUpdate" $ test "foo {bar=1}" $ assert' . isRecUpdate , testCase "isVar" $ test "foo" $ assert' . isVar , testCase "isVar" $ test "3" $ assert' . not. isVar , testCase "isPar" $ test "(foo)" $ assert' . isPar , testCase "isPar" $ test "foo" $ assert' . not . isPar , testCase "isApp" $ test "f x" $ assert' . isApp , testCase "isApp" $ test "x" $ assert' . not . isApp , testCase "isOpApp" $ test "l `op` r" $ assert' . isOpApp , testCase "isOpApp" $ test "op l r" $ assert' . not . isOpApp , testCase "isAnyApp" $ test "l `op` r" $ assert' . isAnyApp , testCase "isAnyApp" $ test "f x" $ assert' . isAnyApp , testCase "isAnyApp" $ test "f x y" $ assert' . isAnyApp , testCase "isAnyApp" $ test "(f x y)" $ assert' . not . isAnyApp , testCase "isLexeme" $ test "foo" $ assert' . isLexeme , testCase "isLexeme" $ test "3" $ assert' . isLexeme , testCase "isLexeme" $ test "f x" $ assert' . not . isLexeme , testCase "isLambda" $ test "\\x -> 12" $ assert' . isLambda , testCase "isLambda" $ test "foo" $ assert' . not . isLambda , testCase "isDotApp" $ test "f . g" $ assert' . isDotApp , testCase "isDotApp" $ test "f $ g" $ assert' . not . isDotApp , testCase "isTypeApp" $ test "f @Int" $ assert' . isTypeApp #if defined (GHCLIB_API_808) || defined (GHCLIB_API_810) , testCase "isTypeApp" $ test "f @ Int" $ assert' . isTypeApp #else , testCase "isTypeApp" $ test "f @ Int" $ assert' . not . isTypeApp #endif , testCase "isTypeApp" $ test "f" $ assert' . not . isTypeApp , testCase "isWHNF" $ test "[]" $ assert' . isWHNF , testCase "isWHNF" $ test "[1, 2]" $ assert' . isWHNF , testCase "isWHNF" $ test "'f'" $ assert' . isWHNF , testCase "isWHNF" $ test "foo" $ assert' . not . isWHNF , testCase "isWHNF" $ test "42" $ assert' . not . isWHNF , testCase "isWHNF" $ test "\\foo -> []" $ assert' . isWHNF , testCase "isWHNF" $ test "(\\foo -> [])" $ assert' . isWHNF , testCase "isWHNF" $ test "(\\foo -> []) x" $ assert' . not . isWHNF , testCase "isWHNF" $ test "(42, \"foo\")" $ assert' . isWHNF , testCase "isWHNF" $ test "(42, \"foo\") :: (Int, String)" $ assert' . isWHNF , testCase "isWHNF" $ test "(\\x -> x * x) 3 :: Int" $ assert' . not . isWHNF , testCase "isWHNF" $ test "Just foo" $ assert' . isWHNF , testCase "isWHNF" $ test "Left foo" $ assert' . isWHNF , testCase "isWHNF" $ test "Right foo" $ assert' . isWHNF , testCase "isWHNF" $ test "POk s" $ assert' . not . isWHNF , testCase "isLCase" $ test "\\case _ -> False" $ assert' . isLCase , testCase "isLCase" $ test "case x of _ -> False" $ assert' . not . isLCase , testCase "isSpliceDecl" $ test "$x" $ assert' . isSpliceDecl . unLoc , testCase "isSpliceDecl" $ test "f$x" $ assert' . not . isSpliceDecl . unLoc , testCase "isSpliceDecl" $ test "$(a + b)" $ assert' . isSpliceDecl . unLoc , testCase "isQuasiQuoteExpr" $ test "[expr|1 + 2|]" $ assert' . isQuasiQuoteExpr , testCase "isQuasiQuoteExpr" $ test "[expr(1 + 2)]" $ assert' . not . isQuasiQuoteExpr , testCase "isWholeFrac" $ test "3.2e1" $ assert' . isWholeFrac . unLoc , testCase "isWholeFrac" $ test "3.22e1" $ assert' . not . isWholeFrac . unLoc , testCase "isMDo" $ test_with_exts [ RecursiveDo ] "mdo { pure () }" $ assert' . any isMDo . universeBi , testCase "isListComp (1)" $ test "[ x + y | x <- xs, y <- ys ]" $ assert' . any isListComp . universeBi , testCase "isListComp (2)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- xs, y <- ys ]" $ assert' . any isMonadComp . universeBi , testCase "isMonadComp (0)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . not . any isListComp . universeBi , testCase "isMonadComp (1)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . any isMonadComp . universeBi , testCase "isMonadComp (2)" $ test_with_exts [] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . not . any isMonadComp . universeBi , testCase "isMonadComp (3)" $ test_with_exts [] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . any isListComp . universeBi , testCase "strToVar" $ assert' . isVar . strToVar $ "foo" , testCase "varToStr" $ test "[]" $ assert' . (== "[]") . varToStr , testCase "varToStr" $ test "foo" $ assert' . (== "foo") . varToStr , testCase "varToStr" $ test "3" $ assert' . null . varToStr ] where assert' = assertBool "" test s = exprTest s (flags []) test_with_exts exts s = exprTest s (flags exts) flags exts = foldl' xopt_set basicDynFlags (exts ++ [ TemplateHaskell , TemplateHaskellQuotes , QuasiQuotes , TypeApplications , LambdaCase ] ) patternPredicateTests :: TestTree patternPredicateTests = testGroup "Pattern predicate tests" [ testCase "patToStr" $ test "True" $ assert' . (== "True") . patToStr , testCase "patToStr" $ test "False" $ assert' . (== "False") . patToStr , testCase "patToStr" $ test "[]" $ assert' . (== "[]") . patToStr , testCase "strToPat" $ assert' . (== "True") . patToStr . strToPat $ "True" , testCase "strToPat" $ assert' . (== "False") . patToStr . strToPat $ "False" , testCase "strToPat" $ assert' . (== "[]") . patToStr . strToPat $ "[]" , testCase "fromPChar" $ test "'a'" $ assert' . (== Just 'a') . fromPChar , testCase "fromPChar" $ test "\"a\"" $ assert' . isNothing . fromPChar , testCase "isSplicePat" $ test "$(varP pylonExPtrVarName)" $ assert' . isSplicePat ] where assert' = assertBool "" test = test_with_exts [] test_with_exts exts s = patTest s (flags exts) flags exts = foldl' xopt_set basicDynFlags (exts ++ [ TemplateHaskell , TemplateHaskellQuotes , QuasiQuotes , TypeApplications , LambdaCase ] ) dynFlagsTests :: TestTree dynFlagsTests = testGroup "DynFlags tests" [ testCase "readExtension" $ assertBool "parse DeriveTraversable" (readExtension "DeriveTraversable" == Just DeriveTraversable) , testCase "readExtension" $ assertBool "parse DeriveTravresable" (isNothing $ readExtension "DeriveTravresable") , testCase "extensionImplications" $ do Just (_, (es, ds)) <- return $ find (\(e, _) -> e == DeriveTraversable) extensionImplications assertBool "no extensions disabled" (null ds) assertBool "two extensions enabled" $ DeriveFunctor `elem` es && DeriveFoldable `elem` es , testCase "check instance Bounded Language" $ assertBool "enumerate is null" (not (null (enumerate @Language))) , testCase "check instance Ord Extension" $ assertBool "minBound >= maxBound" (minBound @Extension < maxBound @Extension) , testCase "disable via pragma" $ withTempDir $ \tmpDir -> do foo <- makeFile (tmpDir "Foo.hs") $ unlines [ "{-# LANGUAGE NoStarIsType #-}" , "{-# LANGUAGE ExplicitNamespaces #-}" , "import GHC.TypeLits(KnownNat, type (+), type (*))" ] s <- readFile' foo -- If 'StarIsType' ends up enabled after -- 'parsePragmasIntoDynflags' has done its work, we'll get a -- parse error (see -- https://github.com/ndmitchell/hlint/issues/971). parsePragmasIntoDynFlags flags ([StarIsType], []) foo s >>= \case Left msg -> assertFailure msg Right flags -> chkParseResult flags (parseFile foo flags s) #if defined (MIN_VERSION_ghc_lib_parser) # if !MIN_VERSION_ghc_lib_parser(1, 0, 0) || MIN_VERSION_ghc_lib_parser(8, 10, 0) , testCase "ImportQualifiedPost" $ do case parseImport "import Foo qualified" (flags `xopt_set` ImportQualifiedPost) of POk _ (L _ decl) -> assertBool "expected postpositive" (isImportQualifiedPost . ideclQualified $ decl) PFailed _ -> assertFailure "parse error" # endif #elif __GLASGOW_HASKELL__ >= 810 , testCase "ImportQualifiedPost" $ do case parseImport "import Foo qualified" (flags `xopt_set` ImportQualifiedPost) of POk _ (L _ decl) -> assertBool "expected postpositive" (isImportQualifiedPost . ideclQualified $ decl) PFailed _ -> assertFailure "parse error" #endif ] where flags = basicDynFlags nameTests :: TestTree nameTests = testGroup "Name tests" [ testCase "modName (1)" $ moduleTest "module Foo.Bar.Baz where" flags (\n -> assertBool "Unexpected name string" $ modName n == "Foo.Bar.Baz") , testCase "modName (2)" $ moduleTest "f x = x * 2" flags (\n -> assertBool "Unexpected name string" $ modName n == "Main") , testCase "isSymbolRdrName (1)" $ assertBool "Expected 'True'" $ isSymbolRdrName (mkRdrUnqual (mkVarOcc "+")) , testCase "isSymbolRdrName (2)" $ assertBool "Expected 'False'" $ not (isSymbolRdrName (mkRdrUnqual (mkVarOcc "_foo"))) , testCase "isSymbolRdrName (3)" $ assertBool "Expected 'False'" $ not (isSymbolRdrName (mkRdrUnqual (mkVarOcc "foo'"))) , testCase "isSymbolRdrName (4)" $ assertBool "Expected 'True'" $ isSymbolRdrName (mkRdrUnqual (mkVarOcc ":+:")) ] where flags = basicDynFlags ghc-lib-parser-ex-9.4.0.0/README.md0000644000000000000000000000547614274052553014563 0ustar0000000000000000# 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-2022 Shayne Fletcher. All rights reserved. SPDX-License-Identifier: BSD-3-Clause The `ghc-lib-parser-ex` package contains GHC API parse tree utilities. It works with or without [`ghc-lib-parser`](https://github.com/digital-asset/ghc-lib). ## Using `ghc-lib-parser-ex` Package `ghc-lib-parser-ex` is on [Hackage](https://hackage.haskell.org/package/ghc-lib-parser-ex) e.g. `cabal install ghc-lib-parser-ex`. Like `ghc-lib-parser`, there are two release streams within the `ghc-lib-parser-ex` name. ### Versioning policy Package `ghc-lib-parser-ex` does **not** conform to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). Version numbers are of the form α.β.γ.δ where α.β corresponds to a GHC series and γ.δ are the major and minor parts of the `ghc-lib-ex-parser` package release. Examples: * Version 8.10.1.3 is compatible with any `ghc-lib-parser-8.10.*` (or `ghc-8.10.*`) package; * Version 0.20190204.2.0 is compatible with [`ghc-lib-parser-0.20190204`](http://hackage.haskell.org/package/ghc-lib-0.20190204). The major part γ of the release number indicates an interface breaking change from the previous release. The minor part δ indicates a non-interface breaking change from the previous release. ## Building `ghc-lib-parser-ex` Produce and test `ghc-lib-parser-ex` package distributions by executing the CI script: ```bash # Setup git clone git@github.com:shayne-fletcher/ghc-lib-parser-ex.git cd ghc-lib-parser-ex stack runhaskell --package extra --package optparse-applicative CI.hs ``` Run `stack runhaskell --package extra --package optparse-applicative CI.hs -- --help` for more options. To run [`hlint`](https://github.com/ndmitchell/hlint) on this repository, `hlint --cpp-include cbits --cpp-define GHCLIB_API_XXX .` (where `XXX` at this time is one of `808`, `810`, `900`, `902`, `904` or `HEAD`). ## Releasing `ghc-lib-parser-ex` (notes for maintainers) Update the [changelog](./ChangeLog.md), `git tag && git push origin ` 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). ghc-lib-parser-ex-9.4.0.0/ChangeLog.md0000644000000000000000000002245514274052553015451 0ustar0000000000000000# Changelog for ghc-lib-parser-ex ## 9.4.0.0 released - Update to `ghc-lib-parser-9.4.1.20220807` ## 0.20220801 released - Update to `ghc-lib-parser-0.20220801` ## 9.2.1.1 released - Update to `ghc-lib-parser-9.2.4.20220527` ## 0.20220701 released - Update to `ghc-lib-parser-0.20220701` ## 9.2.1.0 released - The Cabal flag `auto` now defaults to `False`: - When `auto` has the value `False`: - `ghc-lib-parser-ex` depends on `ghc-lib-parser` - When `auto` has the value `True`: - When the build compiler is >=9.2.2 && <9.3.0 - `ghc-lib-parser-ex` depends on the compiler libs - Otherwise, `ghc-lib-parser-ex` depends on `ghc-lib-parser` - Deprecated modues removed: - `Language.Haskell.GhclibParserEx.Config` - `Language.Haskell.GhclibParserEx.Parse` - `Language.Haskell.GhclibParserEx.Outputable` ## 0.20220601 released - Update to `ghc-lib-parser-0.20220601` - `fakeLlvmConfig` removed for `GHCLIB_API_HEAD` ## 9.2.0.4 released - Update to `ghc-lib-parser-9.2.3.20220527` - Add support for ghc-9.4 series: `GHCLIB_API_904` ## 0.20220501 released - Update to `ghc-lib-parser-0.20220501` ## 0.20220401 released - Update to `ghc-lib-parser-0.20220401` ## 9.2.0.3 released - Fix ghc bounds in auto mode to use ghc-lib not ghc if build compiler ghc-9.2.1 (see [issue](https://github.com/ndmitchell/hlint/issues/1314)) ## 9.2.0.2 released - Update to `ghc-lib-parser-9.2.2.20220307` ## 0.20220301 released - Update to `ghc-lib-parser-0.20220301` ## 8.10.0.24 released - Update to `ghc-lib-parser-8.10.7.20220219` ## 0.20220201 released - Update to `ghc-lib-parser-0.20220201` ## 0.20220103 released - New function `isOverLabel` - Update to `ghc-lib-parser-0.20220103` ## 9.0.0.6 released 2021-12-26 - Add back `isQuasiQuote` for backwards compatibility ## 9.0.0.5 released 2021-12-25 - Bugfix to `isFieldPunUpdate` - New module `Language.Haskell.GHC.Hs.Type.hs` to replace `Language.Haskell.GHC.Hs.Types.hs` (which remains for now but deprecated and will be removed in a future release) - New function `isKindTyApp` - Rename `isQuasiQuote` to `isQuasiQuoteExpr` - Add new function `isQuasiQuoteSplice` - Update to `ghc-lib-parser-9.0.2.20211226` ## 9.2.0.1 released 2021-11-01 - Update to `ghc-lib-parser-9.2.1.20211101` ## 0.20211101 released 2021-11-01 - Update to `ghc-lib-parser-0.20211101` ## 9.2.0.0 released 2021-10-30 - Update to `ghc-lib-parser-9.2.1.20211030` ## 0.20211001 released 2021-10-01 - Add `isSplicePat` to `Language.Haskell.GhclibParserEx.GHC.Hs.Pat` - Use `genericPlatform` on `GHCLIB_API_HEAD` in `GhclibParserEx.GHC.Settings.Config.hs` - Update to `ghc-lib-parser-0.20211001` ## 0.20210901 released 2021-09-01 - Update to `ghc-lib-parser-0.20210901` ## 8.10.0.23 released 2021-08-28 - Update to `ghc-lib-parser-8.10.7.20210828` ## 8.10.0.22 released 2021-08-14 - Update to `ghc-lib-parser-0.20210814` - Added to `GhclibParserEx.GHC.Hs.Expr`: - `isMonadComp` - `isListComp` ## 0.20210701 released 2021-07-01 - Update to `ghc-lib-0.20210701` ## 8.10.0.21 released 2021-06-07 - Bugfix cabal files ## 8.10.0.20 released 2021-06-06 - Update to `ghc-lib-8.10.5.20210606` ## 0.20210601 released 2021-06-01 - Update to `ghc-lib-parser-0.20210601` - Update types in `GHC.Types.Name.Reader` for ghc-9.2.1, `Located` becomes `LocatedN` ## 0.20210501 released 2021-05-01 - Update to `ghc-lib-0.20210501` ## 0.20210331 released 2021-02-31 - Update to `ghc-lib-0.20210331` - Update to `ghc-lib-parser-9.0.1.20210324` ## 9.0.0.4 released 2021-03-11 - Bugfix for `GHC.Hs.Dump` ## 0.20210228 released 2021-02-28 - Update to `ghc-lib-0.20210228` ## 9.0.0.3 released 2021-02-08 - Cabal bugfix ## 9.0.0.2 released 2021-02-08 - Cabal bugfix ## 8.10.0.19 released 2021-02-08 - Cabal bugfix ## 8.10.0.18 released 2021-02-06 - Update to ghc-8.10.4. ## 9.0.0.1 released 2021-02-05 - Upgrade Cabal defaults flag to 9.0.1 ## 9.0.0.0 released 2021-02-05 - Update to ghc-9.0.1 ## 0.20210201 released 2021-02-01 - Update to `ghc-lib-0.20210201` ## 0.20210101 released 2021-01-01 - Update to `ghc-lib-0.20210101` ## 8.10.0.17 released 2020-12-20 - Update to ghc-8.10.3. ## 0.20201101 released 2020-11-01 - Update to `ghc-lib-0.20201101` ## 0.20201001 released 2020-10-01 - Update to `ghc-lib-0.20201001` - `GHCLIB_API_811` -> `GHCLIB_API_HEAD` - Add support for `GHCLIB_API_900` ## 0.20200901 released 2020-09-01 - Update to `ghc-lib-0.20200901` ## 8.10.0.16 released 2020-08-08 - Update to ghc-8.10.2. ## 0.20200801 released 2020-08-01 - Update to `ghc-lib-0.20200801` ## 8.8.6.1 released 2020-07-16 ## 0.20200704 released 2020-07-04 - New function `isImportQualifiedPost` ## 8.10.0.15 released 2020-07-04 - New function `isImportQualifiedPost` ## 8.10.0.14 released 2020-06-10 - New function `isSymbolRdrName` - New module - `Language.Haskell.GhclibParserEx.GHC.Settings.Config` to replace `Language.Haskell.GhclibParserEx.Config` (which remains for now but deprecated and will be removed in a future release) ## 0.20200601 released 2020-06-01 ## 8.10.0.13 released 2020-05-31 - Sync `extra` with HLint ## 8.10.0.12 released 2020-05-31 - New module `Language.Haskell.GhclibParserEx.GHC.Hs` ## 8.10.0.11 released 2020-05-18 - Upgrade to `ghc-lib-parser-8.10.1.20200523` ## 8.10.0.10 released 2020-05-18 - Upgrade to `ghc-lib-parser-8.10.1.20200518` ## 8.10.0.9 released 2020-05-16 - New modules - `Language.Haskell.GhclibParserEx.GHC.Hs.Binds` - `Language.Haskell.GhclibParserEx.GHC.Hs.ImpExp` ## 8.10.0.8 released 2020-05-14 - New module `Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader` ## 8.10.0.7 released 2020-05-13 - New function `fixitiesFromModule` ## 8.10.0.6 released 2020-05-05 - Bugfix in `parsePragmasIntoDynFlags` that meant that default enabled/disabled extensions subsequently disabled/enabled via pragma weren't getting disabled/enabled ## 8.10.0.5 released 2020-05-02 - New modules - `Language.Haskell.GhclibParserEx.GHC.Parser`, `Language.Haskell.GhcLibParserEx.GHC.Utils.Outputable` to replace `Language.Haskell.GhclibParserEx.Parse` and `Language.Haskell.GhclibParserEx.Outputable` (which remain for now but deprecated and will be removed in a future release) ## 0.20200501 released 2020-05-01 ## 8.10.0.4 released 2020-04-04 - Add expression predicates `isWholeFrac`, `isFieldPunUpdate`, `isStrictMatch`, `isMultiIf`, `isProc`, `isTransStmt`; - Add pattern predicate `isPFieldPun`. ## 8.10.0.3 released 2020-04-03 - `strToPat` now returns an `LPat GhcPs` - `parseExpression` now returns an `ParseResult (LHsExpr GhcPs)` (>= ghc-8.10) ## 0.20200401 released 2020-04-01 ## 8.10.0.2 released 2020-03-30 - Rework cabal flags; allow full configurability with a good default: - Have two flags `auto` and `no-ghc-lib`. Default behavior exactly as `hlint` linking `ghc-lib-parser-8.10.*` if not on `ghc-8.10.*` and `ghc-8.10.*` otherwise. ## 8.10.0.1 released 2020-03-28 - Unless the Cabal flag `ghc-lib` is `true` link native ghc-libs (without regard for the compiler version) - Change the signature of `hasPFieldsDotDot` - This has no impact on 8.8 parse trees but matters when it comes to >= 8.10 - Change the signature of `isPFieldWildcard` - This has no impact on 8.8 parse trees but matters when it comes to >= 8.10 ## 8.10.0.0 released 2020-03-24 - First release of the ghc-8.10 series ## 8.8.6.0 released 2020-03-22 - `Language.Haskell.GhclibParserEx.DynFlags` is now `Language.Haskell.GhclibParserEx.GHC.Driver.Session` ## 8.8.5.8 released 2020-03-17 - New module `Language.Haskell.GhclibParserEx.GHC.Driver.Flags` - Export `Bounded` instance for `Language` (https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues/30) ## 8.8.5.7 released 2020-03-16 - From `Language.Haskell.GhclibParserEx.Fixity`: - Supply missing fixities (https://github.com/ndmitchell/hlint/issues/913) - In `Language.Haskell.GhclibParserEx.DynFlags`: - Give `Extension` an `Ord` instance ## 8.8.5.6 released 2020-03-13 - From `Language.Haskell.GhclibParserEx.Fixity`: - Expose `infixr_`, `infixl_`, `infix_` and `fixity` ## 8.8.5.5 released 2020-03-12 - Remove from `Language.Haskell.GhclibParserEx.Fixity`: - `preludeFixities` - `baseFixities` ## 8.8.5.4 released 2020-03-11 - Expose from `Language.Haskell.GhclibParserEx.Fixity`: - `preludeFixities` - `baseFixities` - `lensFixities` - `otherFixities` ## 0.20200301 released 2020-03-01 ## 8.8.5.3 released 2020-02-25 - New modules: - `Language.Haskell.GhclibParserEx.Pat` - `Language.Haskell.GhclibParserEx.Types` - `Language.Haskell.GhclibParserEx.Decls` ## 8.8.5.2 released 2020-02-16 - New `DynFlags` functions `readExtension`, `extensionImplications`. ## 8.8.5.1 released 2020-02-09 - Expression predicate tests. ## 8.8.5.0 released 2020-02-07 - Expose `impliedGFlags` and friends from `DynFlags` (https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues/19). ## 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: - `Language.Haskell.GhclibParserEx.Config` - `Language.Haskell.GhclibParserEx.DynFlags` - `parsePragmasIntoDynFlags` signature change. ## 8.8.1.20191204, 8.8.2, 0.20200102 released 2020-01-18 - First releases ghc-lib-parser-ex-9.4.0.0/cbits/ghclib_api.h0000644000000000000000000000276414274052553016637 0ustar0000000000000000/* Copyright (c) 2020, 2021 Shayne Fletcher. All rights reserved. SPDX-License-Identifier: BSD-3-Clause. */ #if !defined(GHCLIB_API_H) # define GHCLIB_API_H # if !(defined (GHCLIB_API_HEAD) \ || defined (GHCLIB_API_904) \ || defined (GHCLIB_API_902) \ || defined (GHCLIB_API_900) \ || defined (GHCLIB_API_810) \ || defined (GHCLIB_API_808)) # if defined(MIN_VERSION_ghc_lib_parser) # if !MIN_VERSION_ghc_lib_parser( 1, 0, 0) # define GHCLIB_API_HEAD # elif MIN_VERSION_ghc_lib_parser(9, 4, 0) # define GHCLIB_API_904 # elif MIN_VERSION_ghc_lib_parser(9, 2, 0) # define GHCLIB_API_902 # elif MIN_VERSION_ghc_lib_parser(9, 0, 0) # define GHCLIB_API_900 # elif MIN_VERSION_ghc_lib_parser(8, 10, 0) # define GHCLIB_API_810 # elif MIN_VERSION_ghc_lib_parser(8, 8, 0) # define GHCLIB_API_808 # else # error Unsupported GHC API version # endif # else # if __GLASGOW_HASKELL__ == 905 # define GHCLIB_API_HEAD # elif __GLASGOW_HASKELL__ == 904 # define GHCLIB_API_904 # elif __GLASGOW_HASKELL__ == 902 # define GHCLIB_API_902 # elif __GLASGOW_HASKELL__ == 900 # define GHCLIB_API_900 # elif __GLASGOW_HASKELL__ == 810 # define GHCLIB_API_810 # elif __GLASGOW_HASKELL__ == 808 # define GHCLIB_API_808 # else # error Unsupported GHC API version # endif # endif # endif #endif ghc-lib-parser-ex-9.4.0.0/LICENSE0000644000000000000000000000311614274052553014276 0ustar0000000000000000Copyright Shayne Fletcher 2020. * BSD-3-Clause license (https://opensource.org/licenses/BSD-3-Clause) BSD 3-Clause License All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Neil Mitchell nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ghc-lib-parser-ex-9.4.0.0/Setup.hs0000644000000000000000000000005614274052553014725 0ustar0000000000000000import Distribution.Simple main = defaultMain ghc-lib-parser-ex-9.4.0.0/ghc-lib-parser-ex.cabal0000644000000000000000000000664514274052553017500 0ustar0000000000000000cabal-version: 1.18 name: ghc-lib-parser-ex version: 9.4.0.0 description: Please see the README on GitHub at homepage: https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme bug-reports: https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues author: Shayne Fletcher maintainer: shayne@shaynefletcher.org copyright: Copyright © 2020-2022 Shayne Fletcher. All rights reserved. license: BSD3 license-file: LICENSE category: Development synopsis: Algorithms on GHC parse trees build-type: Simple extra-source-files: README.md ChangeLog.md cbits/ghclib_api.h source-repository head type: git location: https://github.com/shayne-fletcher/ghc-lib-parser-ex flag auto default: False manual: True description: Use default configuration flag no-ghc-lib default: False manual: True description: Force dependency on native ghc-libs library exposed-modules: Language.Haskell.GhclibParserEx.Dump Language.Haskell.GhclibParserEx.Fixity Language.Haskell.GhclibParserEx.GHC.Settings.Config Language.Haskell.GhclibParserEx.GHC.Driver.Flags Language.Haskell.GhclibParserEx.GHC.Driver.Session Language.Haskell.GhclibParserEx.GHC.Hs Language.Haskell.GhclibParserEx.GHC.Hs.Expr Language.Haskell.GhclibParserEx.GHC.Hs.Pat Language.Haskell.GhclibParserEx.GHC.Hs.Type Language.Haskell.GhclibParserEx.GHC.Hs.Types Language.Haskell.GhclibParserEx.GHC.Hs.Decls Language.Haskell.GhclibParserEx.GHC.Hs.Binds Language.Haskell.GhclibParserEx.GHC.Hs.ImpExp Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances Language.Haskell.GhclibParserEx.GHC.Parser Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader Language.Haskell.GhclibParserEx.GHC.Utils.Outputable other-modules: Paths_ghc_lib_parser_ex hs-source-dirs: src build-depends: base >=4.7 && <5, uniplate >= 1.5, bytestring >= 0.10.8.2, containers >= 0.5.8.1 if flag(auto) && impl(ghc >= 9.4.0) && impl(ghc < 9.5.0) build-depends: ghc == 9.4.*, ghc-boot-th, ghc-boot else if flag(auto) build-depends: ghc-lib-parser == 9.4.* else if flag(no-ghc-lib) build-depends: ghc == 9.4.*, ghc-boot-th, ghc-boot else build-depends: ghc-lib-parser == 9.4.* include-dirs: cbits install-includes: cbits/ghclib_api.h default-language: Haskell2010 test-suite ghc-lib-parser-ex-test type: exitcode-stdio-1.0 main-is: Test.hs other-modules: Paths_ghc_lib_parser_ex hs-source-dirs: test include-dirs: cbits ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 , tasty >= 1.2 , tasty-hunit >= 0.10.0 , directory >= 1.3.3 , filepath >= 1.4.2 , extra >=1.6 , uniplate >= 1.6.12 , ghc-lib-parser-ex if flag(auto) && impl(ghc >= 9.4.0) && impl(ghc < 9.5.0) build-depends: ghc == 9.4.*, ghc-boot-th, ghc-boot else if flag(auto) build-depends: ghc-lib-parser == 9.4.* else if flag(no-ghc-lib) build-depends: ghc == 9.4.*, ghc-boot-th, ghc-boot else build-depends: ghc-lib-parser == 9.4.* default-language: Haskell2010