haskell-tools-backend-ghc 0.4.1.3 → 0.5.0.0

raw patch · 20 files changed

+197/−143 lines, 20 filesdep ~haskell-tools-astPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-tools-ast

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/AST/FromGHC.hs +1/−1
• Language/Haskell/Tools/AST/FromGHC/AddTypeInfo.hs +5/−5
• Language/Haskell/Tools/AST/FromGHC/Binds.hs +60/−19
• Language/Haskell/Tools/AST/FromGHC/Binds.hs-boot +6/−6
• Language/Haskell/Tools/AST/FromGHC/Decls.hs +25/−39
• Language/Haskell/Tools/AST/FromGHC/Exprs.hs +8/−5
• Language/Haskell/Tools/AST/FromGHC/Exprs.hs-boot +4/−4
• Language/Haskell/Tools/AST/FromGHC/GHCUtils.hs +6/−6
• Language/Haskell/Tools/AST/FromGHC/Kinds.hs +2/−2
• Language/Haskell/Tools/AST/FromGHC/Literals.hs +2/−2
• Language/Haskell/Tools/AST/FromGHC/Modules.hs +25/−21
• Language/Haskell/Tools/AST/FromGHC/Monad.hs +8/−4
• Language/Haskell/Tools/AST/FromGHC/Names.hs +8/−4
• Language/Haskell/Tools/AST/FromGHC/Patterns.hs +13/−12
• Language/Haskell/Tools/AST/FromGHC/SourceMap.hs +1/−1
• Language/Haskell/Tools/AST/FromGHC/Stmts.hs +2/−2
• Language/Haskell/Tools/AST/FromGHC/TH.hs +1/−1
• Language/Haskell/Tools/AST/FromGHC/TH.hs-boot +4/−4
• Language/Haskell/Tools/AST/FromGHC/Utils.hs +14/−3
• haskell-tools-backend-ghc.cabal +2/−2

@@ -2,7 +2,7 @@ -- the Ghc monad. The conversion can be performed from the Parsed and the Renamed GHC AST. If the renamed AST 
 -- is given, additional semantic information is looked up while traversing the AST. 
 module Language.Haskell.Tools.AST.FromGHC 
-  ( trfModule, trfModuleRename, addTypeInfos, runTrf ) where
+  ( trfModule, trfModuleRename, addTypeInfos, runTrf) where
 
 import Language.Haskell.Tools.AST.FromGHC.AddTypeInfo (addTypeInfos)
 import Language.Haskell.Tools.AST.FromGHC.Modules (trfModule, trfModuleRename)

@@ -7,17 +7,17 @@ import Bag as GHC (bagToList)
 import GHC
 import HscTypes as GHC
-import Id as GHC (Id(..), mkVanillaGlobal)
-import Module as GHC (Module(..), moduleEnvElts)
+import Id as GHC (Id, mkVanillaGlobal)
+import Module as GHC (Module, moduleEnvElts)
 import Name as GHC hiding (varName)
-import OccName as GHC (OccName(..), mkDataOcc)
+import OccName as GHC (OccName, mkDataOcc)
 import SrcLoc as GHC
 import TcEvidence as GHC (EvBind(..), TcEvBinds(..))
-import Type as GHC (Type(..), mkTyVarTy, mkTyConTy)
+import Type as GHC (Type, mkTyVarTy, mkTyConTy)
 import TysWiredIn as GHC (starKindTyCon)
 import UniqFM as GHC (eltsUFM)
 import UniqSupply as GHC (uniqFromSupply, mkSplitUniqSupply)
-import Var as GHC (Var(..), Id(..))
+import Var as GHC (Var(..), Id)
 
 import Control.Applicative (Applicative(..), (<$>), Alternative(..))
 import Control.Monad.IO.Class (MonadIO(..))

@@ -7,12 +7,16 @@ import ApiAnnotation as GHC (AnnKeywordId(..))
 import Bag as GHC (bagToList)
 import BasicTypes as GHC (FixityDirection(..), Fixity(..))
+import BasicTypes as GHC
 import HsBinds as GHC
 import HsExpr as GHC
-import HsPat as GHC (LPat(..))
+import HsPat as GHC (LPat)
 import HsTypes as GHC (HsWildCardBndrs(..), HsImplicitBndrs(..))
+import Outputable as GHC (Outputable(..), showSDocUnsafe)
 import SrcLoc as GHC
 
+import Control.Monad.Reader (Monad(..), mapM, asks)
+import Data.Data (Data(..))
 import Data.List
 
 import Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr)
@@ -22,7 +26,7 @@ import Language.Haskell.Tools.AST.FromGHC.Types (trfType)
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
-import Language.Haskell.Tools.AST (Ann(), AnnMaybeG(), AnnListG(), Dom, RangeStage)
+import Language.Haskell.Tools.AST (Ann, AnnMaybeG, AnnListG, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
 trfBind :: TransformName n r => Located (HsBind n) -> Trf (Ann AST.UValueBind (Dom r) RangeStage)
@@ -32,10 +36,14 @@ -- a value binding (not a function)
 trfBind' (FunBind { fun_id = id, fun_matches = MG { mg_alts = L _ [L _ (Match { m_pats = [], m_grhss = GRHSs [L _ (GRHS [] expr)] (L _ locals) })]} }) 
   = AST.USimpleBind <$> copyAnnot AST.UVarPat (define $ trfName id)
-                    <*> addToScope locals (annLocNoSema (combineSrcSpans (getLoc expr) <$> tokenLoc AnnEqual) (AST.UUnguardedRhs <$> trfExpr expr))
-                    <*> addToScope locals (trfWhereLocalBinds locals)
-trfBind' (FunBind id (MG (unLoc -> matches) _ _ _) _ _ _) = AST.UFunBind <$> makeNonemptyIndentedList (mapM (trfMatch (unLoc id)) matches)
-trfBind' (PatBind pat (GRHSs rhs (unLoc -> locals)) _ _ _) = AST.USimpleBind <$> trfPattern pat <*> trfRhss rhs <*> trfWhereLocalBinds locals
+                    <*> addEmptyScope (addToScope locals (annLocNoSema (combineSrcSpans (getLoc expr) <$> tokenLoc AnnEqual) (AST.UUnguardedRhs <$> trfExpr expr)))
+                    <*> addEmptyScope (trfWhereLocalBinds (getLoc expr) locals)
+trfBind' (FunBind id (MG (unLoc -> matches) _ _ _) _ _ _) 
+  = AST.UFunBind <$> makeNonemptyIndentedList (mapM (trfMatch (unLoc id)) matches)
+trfBind' (PatBind pat (GRHSs rhs (unLoc -> locals)) _ _ _) 
+  = AST.USimpleBind <$> trfPattern pat 
+                    <*> addEmptyScope (addToScope locals (trfRhss rhs))
+                    <*> addEmptyScope (trfWhereLocalBinds (collectLocs rhs) locals)
 trfBind' (PatSynBind _) = error "Pattern synonym bindings should be recognized on the declaration level"
 trfBind' _ = error "Bindings generated by the compiler cannot be converted"
 
@@ -46,8 +54,8 @@ trfMatch' name (Match funid pats typ (GRHSs rhss (unLoc -> locBinds)))
   -- TODO: add the optional typ to pats
   = AST.UMatch <$> trfMatchLhs name funid pats
-               <*> addToScope pats (trfRhss rhss)
-               <*> addToScope pats (trfWhereLocalBinds locBinds)
+               <*> addToScope pats (addToScope locBinds (trfRhss rhss))
+               <*> addToScope pats (trfWhereLocalBinds (collectLocs rhss) locBinds)
 
 trfMatchLhs :: TransformName n r => n -> MatchFixity n -> [LPat n] -> Trf (Ann AST.UMatchLhs (Dom r) RangeStage)
 trfMatchLhs name fb pats 
@@ -79,12 +87,13 @@ trfRhsGuard' (BindStmt pat body _ _ _) = AST.UGuardBind <$> trfPattern pat <*> trfExpr body
 trfRhsGuard' (BodyStmt body _ _ _) = AST.UGuardCheck <$> trfExpr body
 trfRhsGuard' (LetStmt (unLoc -> binds)) = AST.UGuardLet <$> trfLocalBinds binds
-trfRhsGuard' _ = error "trfRhsGuard': not a valid guard stmt"
+trfRhsGuard' d = error $ "Illegal guard: " ++ showSDocUnsafe (ppr d) ++ " (ctor: " ++ show (toConstr d) ++ ")"
   
-trfWhereLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnMaybeG AST.ULocalBinds (Dom r) RangeStage)
-trfWhereLocalBinds EmptyLocalBinds = nothing "" "" atTheEnd
-trfWhereLocalBinds binds
-  = makeJust <$> annLocNoSema (combineSrcSpans (getBindLocs binds) <$> tokenLocBack AnnWhere) (AST.ULocalBinds <$> addToScope binds (trfLocalBinds binds))
+trfWhereLocalBinds :: TransformName n r => SrcSpan -> HsLocalBinds n -> Trf (AnnMaybeG AST.ULocalBinds (Dom r) RangeStage)
+trfWhereLocalBinds _ EmptyLocalBinds = nothing "" "" atTheEnd
+trfWhereLocalBinds bef binds
+  = makeJust <$> annLocNoSema (combineSrcSpans (srcLocSpan (srcSpanEnd bef) `combineSrcSpans` getBindLocs binds) <$> tokenLocBack AnnWhere) 
+                              (AST.ULocalBinds <$> addToScope binds (trfLocalBinds binds))
 
 getBindLocs :: HsLocalBinds n -> SrcSpan
 getBindLocs (HsValBinds (ValBindsIn binds sigs)) = foldLocs $ map getLoc (bagToList binds) ++ map getLoc sigs
@@ -120,7 +129,8 @@ trfLocalSig = trfLocNoSema $ \case
   ts@(TypeSig {}) -> AST.ULocalSignature <$> annContNoSema (trfTypeSig' ts)
   (FixSig fs) -> AST.ULocalFixity <$> annContNoSema (trfFixitySig fs)
-  _ -> error "trfLocalSig: not a type or fixity sig"
+  (InlineSig name prag) -> AST.ULocalInline <$> trfInlinePragma name prag
+  d -> error $ "Illegal local signature: " ++ showSDocUnsafe (ppr d) ++ " (ctor: " ++ show (toConstr d) ++ ")"
   
 trfTypeSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.UTypeSignature (Dom r) RangeStage)
 trfTypeSig = trfLocNoSema trfTypeSig'
@@ -128,15 +138,46 @@ trfTypeSig' :: TransformName n r => Sig n -> Trf (AST.UTypeSignature (Dom r) RangeStage)
 trfTypeSig' (TypeSig names typ) 
   = defineTypeVars $ AST.UTypeSignature <$> makeNonemptyList ", " (mapM trfName names) <*> trfType (hswc_body $ hsib_body typ)
-trfTypeSig' _ = error "trfTypeSig': not a type sig"
+trfTypeSig' ts = error $ "Illegal type signature: " ++ showSDocUnsafe (ppr ts) ++ " (ctor: " ++ show (toConstr ts) ++ ")"
 
 trfFixitySig :: TransformName n r => FixitySig n -> Trf (AST.UFixitySignature (Dom r) RangeStage)
 trfFixitySig (FixitySig names (Fixity _ prec dir)) 
-  = AST.UFixitySignature <$> transformDir dir
-                         <*> annLocNoSema (tokenLoc AnnVal) (pure $ AST.Precedence prec) 
-                         <*> (nonemptyAnnList . nub <$> mapM trfOperator names)
+  = do precLoc <- tokenLoc AnnVal
+       AST.UFixitySignature <$> transformDir dir
+                            <*> (if isGoodSrcSpan precLoc 
+                                   then makeJust <$> (annLocNoSema (return precLoc) $ pure $ AST.Precedence prec)
+                                                                                         -- names cannot be empty
+                                   else nothing "" " " (return $ srcSpanStart $ getLoc $ head names))
+                            <*> (nonemptyAnnList . nub <$> mapM trfOperator names)
   where transformDir InfixL = directionChar (pure AST.AssocLeft)
         transformDir InfixR = directionChar (pure AST.AssocRight)
         transformDir InfixN = annLocNoSema (srcLocSpan . srcSpanEnd <$> tokenLoc AnnInfix) (pure AST.AssocNone)
         
-        directionChar = annLocNoSema ((\l -> mkSrcSpan (updateCol (subtract 1) l) l) . srcSpanEnd <$> tokenLoc AnnInfix)+        directionChar = annLocNoSema ((\l -> mkSrcSpan (updateCol (subtract 1) l) l) . srcSpanEnd <$> tokenLoc AnnInfix)
+
+trfInlinePragma :: TransformName n r => Located n -> InlinePragma -> Trf (Ann AST.UInlinePragma (Dom r) RangeStage)
+trfInlinePragma name (InlinePragma _ Inlinable _ phase _) 
+  = annContNoSema (AST.UInlinablePragma <$> trfPhase (pure $ srcSpanStart $ getLoc name) phase <*> trfName name)
+trfInlinePragma name (InlinePragma src NoInline _ _ cl) = annContNoSema (AST.UNoInlinePragma <$> trfName name)
+trfInlinePragma name (InlinePragma src Inline _ phase cl) 
+  = annContNoSema $ do rng <- asks contRange
+                       let parts = map getLoc $ splitLocated (L rng src)
+                       AST.UInlinePragma <$> trfConlike parts cl 
+                                         <*> trfPhase (pure $ srcSpanStart (getLoc name)) phase 
+                                         <*> trfName name
+
+trfPhase :: Trf SrcLoc -> Activation -> Trf (AnnMaybeG AST.UPhaseControl (Dom r) RangeStage)
+trfPhase l AlwaysActive = nothing " " "" l
+trfPhase _ (ActiveAfter _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS) 
+                                                          (AST.UPhaseControl <$> nothing "" "" (before AnnCloseS) <*> trfPhaseNum pn)
+trfPhase _ (ActiveBefore _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS)
+                                                           (AST.UPhaseControl <$> (makeJust <$> annLocNoSema (tokenLoc AnnTilde) (pure AST.PhaseInvert)) <*> trfPhaseNum pn)
+trfPhase _ NeverActive = do range <- asks contRange 
+                            error $ "NeverActive pragmas should be checked earlier : " ++ show range
+
+trfPhaseNum ::  PhaseNum -> Trf (Ann AST.PhaseNumber (Dom r) RangeStage)
+trfPhaseNum i = annLocNoSema (tokenLoc AnnVal) $ pure (AST.PhaseNumber $ fromIntegral i)
+
+trfConlike :: [SrcSpan] -> RuleMatchInfo -> Trf (AnnMaybeG AST.UConlikeAnnot (Dom r) RangeStage)
+trfConlike parts ConLike = makeJust <$> annLocNoSema (pure $ parts !! 2) (pure AST.UConlikeAnnot)
+trfConlike parts FunLike = nothing " " "" (pure $ srcSpanEnd $ parts !! 1)

@@ -1,14 +1,14 @@ module Language.Haskell.Tools.AST.FromGHC.Binds where
 
-import HsBinds as GHC (HsLocalBinds(..))
-import HsExpr as GHC (Stmt(..), LHsExpr(..))
-import Language.Haskell.Tools.AST (Ann(), AnnMaybeG(), AnnListG(), Dom, RangeStage)
+import HsBinds as GHC (HsLocalBinds)
+import HsExpr as GHC (Stmt, LHsExpr)
+import Language.Haskell.Tools.AST (Ann, AnnMaybeG, AnnListG, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.FromGHC.Monad (Trf(..))
+import Language.Haskell.Tools.AST.FromGHC.Monad (Trf)
 import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..))
-import SrcLoc as GHC (Located(..))
+import SrcLoc as GHC (Located, SrcSpan)
 
 trfLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnListG AST.ULocalBind (Dom r) RangeStage)
-trfWhereLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnMaybeG AST.ULocalBinds (Dom r) RangeStage)
+trfWhereLocalBinds :: TransformName n r => SrcSpan -> HsLocalBinds n -> Trf (AnnMaybeG AST.ULocalBinds (Dom r) RangeStage)
 trfRhsGuard :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.URhsGuard (Dom r) RangeStage)
 trfRhsGuard' :: TransformName n r => Stmt n (LHsExpr n) -> Trf (AST.URhsGuard (Dom r) RangeStage)

@@ -9,13 +9,13 @@ import Bag as GHC (bagToList)
 import BasicTypes as GHC
 import BooleanFormula as GHC (BooleanFormula(..))
-import Class as GHC (FunDep(..))
+import Class as GHC (FunDep)
 import ForeignCall as GHC (Safety(..), CExportSpec(..), CCallConv(..))
 import qualified GHC
 import HsSyn as GHC
-import Name as GHC (Name(..), occNameString, nameOccName)
+import Name as GHC (Name, occNameString, nameOccName)
 import Outputable as GHC (Outputable(..), showSDocUnsafe)
-import RdrName as GHC (RdrName(..), rdrNameOcc)
+import RdrName as GHC (RdrName, rdrNameOcc)
 import SrcLoc as GHC
 import TyCon as GHC (Role(..))
 
@@ -37,7 +37,7 @@ import Language.Haskell.Tools.AST.FromGHC.Types
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
-import Language.Haskell.Tools.AST (Ann(), AnnMaybeG(), AnnListG(), getRange, Dom, RangeStage)
+import Language.Haskell.Tools.AST (Ann, AnnMaybeG, AnnListG, getRange, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 import Language.Haskell.Tools.AST.SemaInfoTypes as AST (nameInfo)
 
@@ -76,8 +76,9 @@     
     getDeclsToInsert :: Trf [Ann AST.UDecl (Dom r) RangeStage]
     getDeclsToInsert = do decls <- asks declsToInsert
-                          locals <- asks (head . localsInScope)
-                          liftGhc $ mapM (loadIdsForDecls locals) decls
+                          allLocals <- asks localsInScope
+                          case allLocals of locals:_ -> liftGhc $ mapM (loadIdsForDecls locals) decls
+                                            [] -> error "getDeclsToInsert: empty scope"
        where loadIdsForDecls :: [GHC.Name] -> Ann AST.UDecl (Dom RdrName) RangeStage -> GHC.Ghc (Ann AST.UDecl (Dom r) RangeStage)
              loadIdsForDecls locals = AST.semaTraverse $
                 AST.SemaTrf (AST.nameInfo !~ findName) pure (traverse findName) pure pure pure
@@ -112,15 +113,17 @@                     <*> trfInstBody binds sigs typefam datafam
   InstD (DataFamInstD (DataFamInstDecl con pats (HsDataDefn nd _ _ _ cons derivs) _))
     -> AST.UDataInstDecl <$> trfDataKeyword nd
-                        <*> between AnnInstance AnnEqual (makeInstanceRuleTyVars con pats)
-                        <*> makeList " | " (after AnnEqual) (mapM trfConDecl cons)
+                        <*> (focusAfter AnnInstance . focusBeforeIfPresent AnnEqual . focusBeforeIfPresent AnnDeriving) 
+                              (makeInstanceRuleTyVars con pats)
+                                                       -- the location is needed when there is no = sign
+                        <*> makeListBefore " = " " | " (pure $ srcSpanStart $ foldLocs $ getLoc con : map getLoc (hsib_body pats)) (mapM trfConDecl cons)
                         <*> trfMaybe "" "" trfDerivings derivs
   InstD (TyFamInstD (TyFamInstDecl (L _ (TyFamEqn con pats rhs)) _))
     -> AST.UTypeInstDecl <$> between AnnInstance AnnEqual (makeInstanceRuleTyVars con pats) <*> trfType rhs
   ValD bind -> trfVal bind
   SigD sig -> trfSig sig
   DerivD (DerivDecl t overlap) -> AST.UDerivDecl <$> trfMaybeDefault " " "" trfOverlap (after AnnInstance) overlap <*> trfInstanceRule (hsib_body t)
-  -- TODO: INLINE, SPECIALIZE, MINIMAL, VECTORISE pragmas, Warnings, Annotations, rewrite rules, role annotations
+  -- TODO: Warnings, rewrite rules
   RuleD (HsRules _ rules) -> AST.UPragmaDecl <$> annContNoSema (AST.URulePragma <$> makeIndentedList (before AnnClose) (mapM trfRewriteRule rules))
   RoleAnnotD (RoleAnnotDecl name roles) -> AST.URoleDecl <$> trfQualifiedName name <*> makeList " " atTheEnd (mapM trfRole roles)
   DefD (DefaultDecl types) -> AST.UDefaultDecl . nonemptyAnnList <$> mapM trfType types
@@ -129,6 +132,10 @@   ForD (ForeignExport name (hsib_body -> typ) _ (CExport (L l (CExportStatic _ _ ccall)) _)) 
     -> AST.UForeignExport <$> annLocNoSema (pure l) (trfCallConv' ccall) <*> trfName name <*> trfType typ
   SpliceD (SpliceDecl (unLoc -> spl) _) -> AST.USpliceDecl <$> (annContNoSema $ trfSplice' spl)
+  WarningD (Warnings src [L _ (Warning names (DeprecatedTxt _ [L l (StringLiteral _ fs)]))]) 
+    -> AST.UPragmaDecl <$> annContNoSema (AST.UDeprPragma <$> (makeNonemptyList " " $ mapM trfName names) <*> trfFastString (L l fs))
+  WarningD (Warnings src [L _ (Warning names (WarningTxt _ [L l (StringLiteral _ fs)]))]) 
+    -> AST.UPragmaDecl <$> annContNoSema (AST.UWarningPragma <$> (makeNonemptyList " " $ mapM trfName names) <*> trfFastString (L l fs))
   AnnD (HsAnnotation stxt subject expr) 
     -> AST.UPragmaDecl <$> annContNoSema (AST.UAnnPragma <$> trfAnnotationSubject stxt subject (srcSpanStart $ getLoc expr) <*> trfExpr expr)
   d -> error ("Illegal declaration: " ++ showSDocUnsafe (ppr d) ++ " (ctor: " ++ show (toConstr d) ++ ")")
@@ -163,26 +170,14 @@ trfSig (FixSig fs) = AST.UFixityDecl <$> (annContNoSema $ trfFixitySig fs)
 trfSig (PatSynSig id typ) 
   = AST.UPatTypeSigDecl <$> annContNoSema (AST.UPatternTypeSignature <$> trfName id <*> trfType (hsib_body typ))
-trfSig (InlineSig name (InlinePragma _ Inlinable _ phase _)) 
-  = AST.UPragmaDecl <$> annContNoSema (AST.UInlinablePragma <$> trfPhase (pure $ srcSpanStart $ getLoc name) phase <*> trfName name)
-trfSig (InlineSig name (InlinePragma src inl _ phase cl)) 
-  = do rng <- asks contRange
-       let parts = map getLoc $ splitLocated (L rng src)
-       -- TODO: Inlinable, EmptyInlineSpec
-       AST.UPragmaDecl <$> annContNoSema ((case inl of Inline -> AST.UInlinePragma; NoInline -> AST.UNoInlinePragma) 
-                                     <$> trfConlike parts cl 
-                                     <*> trfPhase (pure $ srcSpanStart (getLoc name)) phase 
-                                     <*> trfName name)
+trfSig (InlineSig name prag)  
+  = AST.UPragmaDecl <$> annContNoSema (AST.UInlinePragmaDecl <$> trfInlinePragma name prag)
 trfSig (SpecSig name (map hsib_body -> types) (inl_act -> phase)) 
   = AST.UPragmaDecl <$> annContNoSema (AST.USpecializePragma <$> trfPhase (pure $ srcSpanStart (getLoc name)) phase 
                                        <*> trfName name 
                                        <*> (orderAnnList <$> trfAnnList ", " trfType' types))
 trfSig s = error ("Illegal signature: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
 
-trfConlike :: [SrcSpan] -> RuleMatchInfo -> Trf (AnnMaybeG AST.UConlikeAnnot (Dom r) RangeStage)
-trfConlike parts ConLike = makeJust <$> annLocNoSema (pure $ parts !! 2) (pure AST.UConlikeAnnot)
-trfConlike parts FunLike = nothing " " "" (pure $ srcSpanEnd $ parts !! 1)
-
 trfConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.UConDecl (Dom r) RangeStage)
 trfConDecl = trfLocNoSema trfConDecl'
 
@@ -279,7 +274,8 @@                                      (AST.UTyApp <$> pure typ <*> trfType p)) base pats
                  
 trfFunDeps :: TransformName n r => [Located (FunDep (Located n))] -> Trf (AnnMaybeG AST.UFunDeps (Dom r) RangeStage)
-trfFunDeps [] = nothing "| " "" $ focusBeforeIfPresent AnnWhere atTheEnd
+trfFunDeps [] = do whereToken <- tokenLoc AnnWhere
+                   nothing "| " "" (if isGoodSrcSpan whereToken then pure $ srcSpanStart whereToken else atTheEnd)
 trfFunDeps fundeps = makeJust <$> annLocNoSema (combineSrcSpans (collectLocs fundeps) <$> tokenLoc AnnVbar) 
                                          (AST.UFunDeps <$> trfAnnList ", " trfFunDep' fundeps)
   
@@ -335,7 +331,8 @@   ClassOpSig False names typ -> AST.UClsSig <$> (annContNoSema $ AST.UTypeSignature <$> define (makeNonemptyList ", " (mapM trfName names)) 
                                            <*> trfType (hsib_body typ))
   MinimalSig _ formula -> AST.UClsMinimal <$> trfMinimalFormula formula
-  s -> error ("Illegal signature: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
+  InlineSig name prag -> AST.UClsInline <$> trfInlinePragma name prag
+  s -> error ("Illegal signature in class: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
          
 trfTypeFam :: TransformName n r => Located (FamilyDecl n) -> Trf (Ann AST.UTypeFamily (Dom r) RangeStage)
 trfTypeFam = trfLocNoSema trfTypeFam'
@@ -376,6 +373,7 @@   ClassOpSig _ names typ -> AST.UInstBodyTypeSig <$> (annContNoSema $ AST.UTypeSignature <$> define (makeNonemptyList ", " (mapM trfName names)) 
                                                 <*> trfType (hsib_body typ))
   SpecInstSig _ typ -> AST.USpecializeInstance <$> trfType (hsib_body typ)
+  InlineSig name prag -> AST.UInlineInstance <$> trfInlinePragma name prag
   s -> error ("Illegal class instance signature: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
           
 trfInstTypeFam :: TransformName n r => Located (TyFamInstDecl n) -> Trf (Ann AST.UInstBodyDecl (Dom r) RangeStage)
@@ -481,24 +479,12 @@                                Just Representational -> pure AST.URepresentational
                                Just GHC.Phantom -> pure AST.UPhantom
                                Nothing -> error "trfRole: no role"
-         
-trfPhase :: Trf SrcLoc -> Activation -> Trf (AnnMaybeG AST.UPhaseControl (Dom r) RangeStage)
-trfPhase l AlwaysActive = nothing "" " " l
-trfPhase _ (ActiveAfter _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS) 
-                                                          (AST.UPhaseControl <$> nothing "" "" (before AnnCloseS) <*> trfPhaseNum pn)
-trfPhase _ (ActiveBefore _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS)
-                                                           (AST.UPhaseControl <$> (makeJust <$> annLocNoSema (tokenLoc AnnTilde) (pure AST.PhaseInvert)) <*> trfPhaseNum pn)
--- TODO
-trfPhase _ NeverActive = error "NeverActive pragmas not yet supported"
 
-trfPhaseNum ::  PhaseNum -> Trf (Ann AST.PhaseNumber (Dom r) RangeStage)
-trfPhaseNum i = annLocNoSema (tokenLoc AnnVal) $ pure (AST.PhaseNumber $ fromIntegral i) 
-   
 trfRewriteRule :: TransformName n r => Located (RuleDecl n) -> Trf (Ann AST.URule (Dom r) RangeStage)
 trfRewriteRule = trfLocNoSema $ \(HsRule (L nameLoc (_, ruleName)) act bndrs left _ right _) ->
   AST.URule <$> trfFastString (L nameLoc ruleName) 
-            <*> trfPhase (before AnnForall) act
-            <*> makeNonemptyList " " (mapM trfRuleBndr bndrs)
+            <*> trfPhase (pure $ srcSpanEnd nameLoc) act
+            <*> makeListAfter " " " " (pure $ srcSpanStart $ getLoc left) (mapM trfRuleBndr bndrs)
             <*> trfExpr left
             <*> trfExpr right
 

@@ -14,6 +14,7 @@ 
 import BasicTypes as GHC (Boxity(..))
 import GHC
+import OccName as GHC (occNameString)
 import Outputable as GHC (Outputable(..), showSDocUnsafe)
 import PrelNames as GHC (negateName)
 import SrcLoc as GHC
@@ -28,9 +29,9 @@ import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.TH (trfBracket', trfSplice', trfQuasiQuotation')
 import Language.Haskell.Tools.AST.FromGHC.Types (trfType)
 import Language.Haskell.Tools.AST.FromGHC.Utils
-import Language.Haskell.Tools.AST.SemaInfoTypes (ScopeInfo(..), mkScopeInfo)
+import Language.Haskell.Tools.AST.SemaInfoTypes (ScopeInfo, mkScopeInfo)
 
-import Language.Haskell.Tools.AST (Ann(), AnnListG(), Dom, RangeStage)
+import Language.Haskell.Tools.AST (Ann, AnnListG, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
 trfExpr :: forall n r . TransformName n r => Located (HsExpr n) -> Trf (Ann AST.UExpr (Dom r) RangeStage)
@@ -56,6 +57,7 @@ 
 trfExpr' :: TransformName n r => HsExpr n -> Trf (AST.UExpr (Dom r) RangeStage)
 trfExpr' (HsVar name) = AST.UVar <$> trfName name
+trfExpr' (HsUnboundVar name) = AST.UVar <$> trfNameText (occNameString $ unboundVarOcc name)
 trfExpr' (HsRecFld fld) = AST.UVar <$> (asks contRange >>= \l -> trfAmbiguousFieldName' l fld)
 trfExpr' (HsIPVar ip) = AST.UVar <$> trfImplicitName ip
 trfExpr' (HsOverLit (ol_val -> val)) = AST.ULit <$> annContNoSema (trfOverloadedLit val)
@@ -75,10 +77,11 @@ trfExpr' (HsPar (unLoc -> SectionR (unLoc -> HsVar op) expr)) = AST.URightSection <$> trfOperator op <*> trfExpr expr
 trfExpr' (HsPar expr) = AST.UParen <$> trfExpr expr
 trfExpr' (ExplicitTuple tupArgs box) | all tupArgPresent tupArgs 
-  = wrap <$> between AnnOpenP AnnCloseP (trfAnnList' ", " (trfExpr . (\(Present e) -> e) . unLoc) tupArgs)
+  = wrap <$> between (if box == Boxed then AnnOpenP else AnnOpen) (if box == Boxed then AnnCloseP else AnnClose) 
+               (trfAnnList' ", " (trfExpr . (\(Present e) -> e) . unLoc) tupArgs)
   where wrap = if box == Boxed then AST.UTuple else AST.UUnboxedTuple
 trfExpr' (ExplicitTuple tupArgs box)
-  = wrap <$> between AnnOpenP AnnCloseP
+  = wrap <$> between (if box == Boxed then AnnOpenP else AnnOpen) (if box == Boxed then AnnCloseP else AnnClose)
                (do locs <- elemLocs
                    makeList ", " atTheEnd $ mapM trfTupSecElem (zip (map unLoc tupArgs) locs))
   where wrap = if box == Boxed then AST.UTupleSection else AST.UUnboxedTupSec
@@ -172,7 +175,7 @@ 
 gTrfAlt' :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> Match n (Located (ge n)) -> Trf (AST.UAlt' ae (Dom r) RangeStage)
 gTrfAlt' te (Match _ [pat] _ (GRHSs rhss (unLoc -> locBinds)))
-  = AST.UAlt <$> trfPattern pat <*> gTrfCaseRhss te rhss <*> trfWhereLocalBinds locBinds
+  = AST.UAlt <$> trfPattern pat <*> gTrfCaseRhss te rhss <*> trfWhereLocalBinds (collectLocs rhss) locBinds
 gTrfAlt' _ _ = error "gTrfAlt': not exactly one alternative when transforming a case alternative"
   
 trfCaseRhss :: TransformName n r => [Located (GRHS n (LHsExpr n))] -> Trf (Ann AST.UCaseRhs (Dom r) RangeStage)

@@ -1,11 +1,11 @@ module Language.Haskell.Tools.AST.FromGHC.Exprs where
 
-import HsExpr as GHC (HsExpr(..), HsCmd(..))
-import Language.Haskell.Tools.AST (Ann(), Dom, RangeStage)
+import HsExpr as GHC (HsExpr, HsCmd)
+import Language.Haskell.Tools.AST (Ann, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.FromGHC.Monad (Trf(..))
+import Language.Haskell.Tools.AST.FromGHC.Monad (Trf)
 import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..))
-import SrcLoc as GHC (Located(..))
+import SrcLoc as GHC (Located)
 
 trfExpr :: TransformName n r => Located (HsExpr n) -> Trf (Ann AST.UExpr (Dom r) RangeStage)
 trfExpr' :: TransformName n r => HsExpr n -> Trf (AST.UExpr (Dom r) RangeStage)

@@ -11,14 +11,14 @@ import Data.Generics.Uniplate.Data ()
 import Data.List
 
-import Bag (Bag(..), bagToList, unionManyBags)
+import Bag (Bag, bagToList, unionManyBags)
 import ConLike (ConLike(..))
 import GHC
-import Id (Id(..), mkVanillaGlobal)
-import OccName (OccName(..))
+import Id (Id, mkVanillaGlobal)
+import OccName (OccName)
 import Outputable (Outputable(..), OutputableBndr(..), showSDocUnsafe)
 import PatSyn (patSynSig)
-import RdrName (RdrName(..), rdrNameOcc, nameRdrName)
+import RdrName (RdrName, rdrNameOcc, nameRdrName)
 import SrcLoc
 import Type (TyThing(..), mkFunTys)
 
@@ -200,9 +200,9 @@ cleanHsType (HsAppsTy [unLoc -> HsAppInfix t]) = HsTyVar t
 cleanHsType (HsAppsTy apps) = unLoc $ guessType (splitHsAppsTy apps)
   where guessType :: OutputableBndr n => ([[LHsType n]], [Located n]) -> LHsType n
-        guessType (term:terms, operator:operators)  
+        guessType (term@(hd:_):terms, operator:operators)  
           = let rhs = guessType (terms,operators)
-             in L (getLoc (head term) `combineSrcSpans` getLoc rhs) $ HsOpTy (doApps term) operator rhs
+             in L (getLoc hd `combineSrcSpans` getLoc rhs) $ HsOpTy (doApps term) operator rhs
         guessType ([term],[]) = doApps term
         guessType x = error ("guessType: " ++ showSDocUnsafe (ppr x))
         doApps term = foldl1 (\core t -> L (getLoc core `combineSrcSpans` getLoc t) $ HsAppTy core t) term

@@ -16,10 +16,10 @@ import Control.Monad.Reader (Monad(..), asks)
 import Data.Data (toConstr)
 
-import Language.Haskell.Tools.AST (Ann(), AnnMaybeG(), Dom, RangeStage, HasNoSemanticInfo)
+import Language.Haskell.Tools.AST (Ann, AnnMaybeG, Dom, RangeStage, HasNoSemanticInfo)
 import qualified Language.Haskell.Tools.AST as AST
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils (GHCName(..), cleanHsType)
-import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf(..), transformingPossibleVar)
+import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf, transformingPossibleVar)
 import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..), trfName)
 import Language.Haskell.Tools.AST.FromGHC.Utils
 

@@ -8,8 +8,8 @@ import HsLit as GHC (OverLitVal(..), HsLit(..))
 
 import Language.Haskell.Tools.AST (Dom, RangeStage)
-import qualified Language.Haskell.Tools.AST as AST (ULiteral(..), Dom(..), RangeStage(..))
-import Language.Haskell.Tools.AST.FromGHC.Monad (Trf(..))
+import qualified Language.Haskell.Tools.AST as AST (ULiteral(..), Dom, RangeStage)
+import Language.Haskell.Tools.AST.FromGHC.Monad (Trf)
 
 trfLiteral' :: HsLit -> Trf (AST.ULiteral (Dom r) RangeStage)
 trfLiteral' (HsChar _ ch) = pure $ AST.UCharLit ch

@@ -21,7 +21,7 @@ import ErrUtils as GHC (pprErrMsgBagWithLoc)
 import FastString as GHC (unpackFS)
 import GHC
-import HscTypes as GHC (WarningTxt(..), ModSummary(..), HscEnv(..))
+import HscTypes as GHC (WarningTxt(..), ModSummary, HscEnv(..))
 import Language.Haskell.TH.LanguageExtensions (Extension(..))
 import Name as GHC hiding (varName)
 import Outputable as GHC (vcat, showSDocUnsafe, (<+>))
@@ -31,7 +31,7 @@ import SrcLoc as GHC
 import TcRnMonad as GHC
 
-import Language.Haskell.Tools.AST (Ann(..), AnnMaybeG(), AnnListG(..), Dom, RangeStage
+import Language.Haskell.Tools.AST (Ann(..), AnnMaybeG, AnnListG(..), Dom, RangeStage
                                   , sourceInfo, semantics, annotation, nodeSpan)
 import qualified Language.Haskell.Tools.AST as AST
 import Language.Haskell.Tools.AST.FromGHC.Decls (trfDecls, trfDeclsGroup)
@@ -109,8 +109,8 @@ trfModuleHead (Just mn) exports modPrag
   = makeJust <$> (annLocNoSema (tokensLoc [AnnModule, AnnWhere])
                                (AST.UModuleHead <$> trfModuleName mn 
-                                                <*> trfExportList (srcSpanEnd $ getLoc mn) exports
-                                                <*> trfModulePragma modPrag))
+                                                <*> trfModulePragma (srcSpanEnd $ getLoc mn) modPrag
+                                                <*> trfExportList (before AnnWhere) exports))
 trfModuleHead _ Nothing _ = nothing "" "" moduleHeadPos
   where moduleHeadPos = after AnnClose >>= \case loc@(RealSrcLoc _) -> return loc
                                                  _ -> atTheStart
@@ -131,18 +131,18 @@ trfOptionsPragma :: Located String -> Trf (Ann AST.UFilePragma (Dom r) RangeStage)
 trfOptionsPragma (L l str) = annLocNoSema (pure l) (AST.UOptionsPragma <$> annContNoSema (pure $ AST.UStringNode str))
 
-trfModulePragma :: Maybe (Located WarningTxt) -> Trf (AnnMaybeG AST.UModulePragma (Dom r) RangeStage)
-trfModulePragma = trfMaybeDefault " " "" (trfLocNoSema $ \case WarningTxt _ txts -> AST.UModuleWarningPragma <$> trfAnnList " " trfText' txts
-                                                               DeprecatedTxt _ txts -> AST.UModuleDeprecatedPragma <$> trfAnnList " " trfText' txts) 
-                                  (before AnnWhere)
+trfModulePragma :: SrcLoc -> Maybe (Located WarningTxt) -> Trf (AnnMaybeG AST.UModulePragma (Dom r) RangeStage)
+trfModulePragma l = trfMaybeDefault " " "" (trfLocNoSema $ \case WarningTxt _ txts -> AST.UModuleWarningPragma <$> trfAnnList " " trfText' txts
+                                                                 DeprecatedTxt _ txts -> AST.UModuleDeprecatedPragma <$> trfAnnList " " trfText' txts) 
+                                    (pure l)
 
 trfText' :: StringLiteral -> Trf (AST.UStringNode (Dom r) RangeStage)
 trfText' = pure . AST.UStringNode . unpackFS . sl_fs
 
 
 
-trfExportList :: TransformName n r => SrcLoc -> Maybe (Located [LIE n]) -> Trf (AnnMaybeG AST.UExportSpecs (Dom r) RangeStage)
-trfExportList loc = trfMaybeDefault " " "" (trfLocNoSema trfExportList') (pure loc)
+trfExportList :: TransformName n r => Trf SrcLoc -> Maybe (Located [LIE n]) -> Trf (AnnMaybeG AST.UExportSpecs (Dom r) RangeStage)
+trfExportList loc = trfMaybeDefault "" " " (trfLocNoSema trfExportList') loc
 
 trfExportList' :: TransformName n r => [LIE n] -> Trf (AST.UExportSpecs (Dom r) RangeStage)
 trfExportList' exps = AST.UExportSpecs <$> (makeList ", " (after AnnOpenP) (orderDefs . catMaybes <$> (mapM trfExport exps)))
@@ -161,17 +161,20 @@                                                   <*> (srcLocSpan . srcSpanEnd <$> tokenLoc AnnWhere))
 trfImport :: TransformName n r => LImportDecl n -> Trf (Ann AST.UImportDecl (Dom r) RangeStage)
 trfImport (L l impDecl@(GHC.ImportDecl _ name pkg isSrc isSafe isQual _ declAs declHiding)) =
-  let -- default positions of optional parts of an import declaration
-      annBeforeQual = if isSrc then AnnClose else AnnImport
-      annBeforeSafe = if isQual then AnnQualified else annBeforeQual
-      annBeforePkg = if isSafe then AnnSafe else annBeforeSafe
-  in annLoc (createImportData impDecl) (pure l) $ AST.UImportDecl 
+  do safeTok <- tokenLoc AnnSafe
+
+     let -- default positions of optional parts of an import declaration
+         annBeforeQual = if isSrc then AnnClose else AnnImport
+         annBeforeSafe = if isQual then AnnQualified else annBeforeQual
+         annBeforePkg = if isGoodSrcSpan safeTok then AnnSafe else annBeforeSafe
+
+     annLoc (createImportData impDecl) (pure l) $ AST.UImportDecl 
        <$> (if isSrc then makeJust <$> annLocNoSema (tokensLoc [AnnOpen, AnnClose]) (pure AST.UImportSource)
                      else nothing " " "" (after AnnImport))
        <*> (if isQual then makeJust <$> (annLocNoSema (tokenLoc AnnQualified) (pure AST.UImportQualified)) 
                       else nothing " " "" (after annBeforeQual))
-       <*> (if isSafe then makeJust <$> (annLocNoSema (tokenLoc AnnSafe) (pure AST.UImportSafe)) 
-                      else nothing " " "" (after annBeforeSafe))
+       <*> (if isGoodSrcSpan safeTok then makeJust <$> (annLocNoSema (pure safeTok) (pure AST.UImportSafe)) 
+                                     else nothing " " "" (after annBeforeSafe))
        <*> maybe (nothing " " "" (after annBeforePkg)) 
                  (\str -> makeJust <$> (annLocNoSema (tokenLoc AnnPackageName) (pure (AST.UStringNode (unpackFS $ sl_fs str))))) pkg
        <*> trfModuleName name 
@@ -196,11 +199,12 @@ trfIESpec' (IEVar n) = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n <*> (nothing "(" ")" atTheEnd))
 trfIESpec' (IEThingAbs n) = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n <*> (nothing "(" ")" atTheEnd))
 trfIESpec' (IEThingAll n) 
-  = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n <*> (makeJust <$> (annLocNoSema (tokenLoc AnnDotdot) (pure AST.USubSpecAll))))
+  = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n <*> (makeJust <$> subspec))
+  where subspec = betweenIncluding AnnOpenP AnnCloseP $ annContNoSema (pure AST.USubSpecAll)
 trfIESpec' (IEThingWith n _ ls _)
-  = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n
-                          <*> (makeJust <$> between AnnOpenP AnnCloseP 
-                                                   (annContNoSema $ AST.USubSpecList <$> makeList ", " (after AnnOpenP) (mapM trfName ls))))
+  = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n <*> (makeJust <$> subspec))
+  where subspec = betweenIncluding AnnOpenP AnnCloseP $ annContNoSema 
+                    $ AST.USubSpecList <$> between AnnOpenP AnnCloseP (makeList ", " atTheStart (mapM trfName ls))
 trfIESpec' _ = pure Nothing
 
 trfImportModifier :: Trf (AnnMaybeG AST.UImportModifier (Dom r) RangeStage)

@@ -2,16 +2,16 @@ -- during the conversion from GHC AST to our representation.
 module Language.Haskell.Tools.AST.FromGHC.Monad where
 
-import ApiAnnotation (ApiAnnKey(..))
+import ApiAnnotation (ApiAnnKey)
 import Control.Monad.Reader
 import Data.Function (on)
-import Data.Map as Map (Map(..), lookup, empty)
+import Data.Map as Map (Map, lookup, empty)
 import Data.Maybe (fromMaybe)
 import GHC
 import Language.Haskell.Tools.AST
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils (HsHasName(..), rdrNameStr)
-import Language.Haskell.Tools.AST.FromGHC.SourceMap (SourceMap(..), annotationsToSrcMap)
-import Name (Name(..), isVarName, isTyVarName)
+import Language.Haskell.Tools.AST.FromGHC.SourceMap (SourceMap, annotationsToSrcMap)
+import Name (Name, isVarName, isTyVarName)
 import SrcLoc
 
 -- | The transformation monad type
@@ -68,6 +68,10 @@ transformingPossibleVar n = case hsGetNames n of 
   [name] | isVarName name || isTyVarName name -> typeVarTransform
   _                                           -> id
+
+-- | Perform the transformation putting the given definition in a new local scope.
+addEmptyScope :: Trf a -> Trf a
+addEmptyScope = local (\s -> s { localsInScope = [] : localsInScope s }) 
 
 -- | Perform the transformation putting the given definition in a new local scope.
 addToScope :: HsHasName e => e -> Trf a -> Trf a

@@ -16,18 +16,18 @@ import Control.Monad.Reader ((=<<), asks)
 import Data.Char (isDigit, isLetter)
 
-import FastString as GHC (FastString(..), unpackFS)
+import FastString as GHC (FastString, unpackFS)
 import HsSyn as GHC
 import Name as GHC (isSymOcc)
 import qualified Name as GHC (Name)
-import RdrName as GHC (RdrName(..))
+import RdrName as GHC (RdrName)
 import SrcLoc as GHC
 
-import Language.Haskell.Tools.AST (Ann(..), AnnListG(), RangeStage, Dom)
+import Language.Haskell.Tools.AST (Ann(..), AnnListG, RangeStage, Dom)
 import qualified Language.Haskell.Tools.AST as AST
 
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils
-import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf(..), getOriginalName)
+import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf, getOriginalName)
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
 trfOperator :: TransformName n r => Located n -> Trf (Ann AST.UOperator (Dom r) RangeStage)
@@ -86,6 +86,10 @@ 
 instance {-# OVERLAPS #-} (TransformableName res, GHCName res, HsHasName res) => TransformName GHC.Name res where
   transformName = fromGHCName
+
+trfNameText :: String -> Trf (Ann AST.UName (Dom r) RangeStage)
+trfNameText str
+  = annContNoSema (AST.UNormalName <$> annLoc (createImplicitNameInfo str) (asks contRange) (AST.nameFromList <$> trfNameStr str))
 
 trfImplicitName :: HsIPName -> Trf (Ann AST.UName (Dom r) RangeStage)
 trfImplicitName (HsIPName fs) 

@@ -17,23 +17,24 @@ 
 import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr)
 import Language.Haskell.Tools.AST.FromGHC.Literals (trfLiteral', trfOverloadedLit)
-import Language.Haskell.Tools.AST.FromGHC.Monad (Trf(..), define)
+import Language.Haskell.Tools.AST.FromGHC.Monad (Trf, define)
 import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..), trfOperator, trfName)
 import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.TH (trfSplice')
 import Language.Haskell.Tools.AST.FromGHC.Types (trfType)
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
-import Language.Haskell.Tools.AST (Ann(), Dom, RangeStage)
+import Language.Haskell.Tools.AST (Ann, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 
 trfPattern :: TransformName n r => Located (Pat n) -> Trf (Ann AST.UPattern (Dom r) RangeStage)
 -- field wildcards are not directly represented in GHC AST
 trfPattern (L l (ConPatIn name (RecCon (HsRecFields flds _)))) | any ((l ==) . getLoc) flds 
-  = do let (fromWC, notWC) = partition ((l ==) . getLoc) flds
-       normalFields <- mapM (trfLocNoSema trfPatternField') notWC
-       wildc <- annLocNoSema (tokenLoc AnnDotdot) (AST.UFieldWildcardPattern <$> annCont (createImplicitFldInfo (unLoc . (\(VarPat n) -> n) . unLoc) (map unLoc fromWC)) (pure AST.FldWildcard))
-       annLocNoSema (pure l) (AST.URecPat <$> trfName name <*> makeNonemptyList ", " (pure (normalFields ++ [wildc])))
-trfPattern p | otherwise = trfLocNoSema trfPattern' (correctPatternLoc p)
+  = focusOn l $ do 
+      let (fromWC, notWC) = partition ((l ==) . getLoc) flds
+      normalFields <- mapM (trfLocNoSema trfPatternField') notWC
+      wildc <- annLocNoSema (tokenLoc AnnDotdot) (AST.UFieldWildcardPattern <$> annCont (createImplicitFldInfo (unLoc . (\(VarPat n) -> n) . unLoc) (map unLoc fromWC)) (pure AST.FldWildcard))
+      annLocNoSema (pure l) (AST.URecPat <$> trfName name <*> makeNonemptyList ", " (pure (normalFields ++ [wildc])))
+trfPattern p = trfLocNoSema trfPattern' (correctPatternLoc p)
 
 -- | Locations for right-associative infix patterns are incorrect in GHC AST
 correctPatternLoc :: Located (Pat n) -> Located (Pat n)
@@ -48,11 +49,11 @@ trfPattern' (AsPat name pat) = AST.UAsPat <$> define (trfName name) <*> trfPattern pat
 trfPattern' (ParPat pat) = AST.UParenPat <$> trfPattern pat
 trfPattern' (BangPat pat) = AST.UBangPat <$> trfPattern pat
-trfPattern' (ListPat pats _ _) = AST.UListPat <$> trfAnnList ", " trfPattern' pats
-trfPattern' (TuplePat pats Boxed _) = AST.UTuplePat <$> trfAnnList ", " trfPattern' pats
-trfPattern' (TuplePat pats Unboxed _) = AST.UUnboxTuplePat <$> trfAnnList ", " trfPattern' pats
-trfPattern' (PArrPat pats _) = AST.UParArrPat <$> trfAnnList ", " trfPattern' pats
-trfPattern' (ConPatIn name (PrefixCon args)) = AST.UAppPat <$> trfName name <*> trfAnnList " " trfPattern' args
+trfPattern' (ListPat pats _ _) = AST.UListPat <$> makeList ", " atTheEnd (mapM trfPattern pats)
+trfPattern' (TuplePat pats Boxed _) = AST.UTuplePat <$> makeList ", " atTheEnd (mapM trfPattern pats)
+trfPattern' (TuplePat pats Unboxed _) = AST.UUnboxTuplePat <$> makeList ", " atTheEnd (mapM trfPattern pats)
+trfPattern' (PArrPat pats _) = AST.UParArrPat <$> makeList ", " atTheEnd (mapM trfPattern pats)
+trfPattern' (ConPatIn name (PrefixCon args)) = AST.UAppPat <$> trfName name <*> makeList " " atTheEnd (mapM trfPattern args)
 trfPattern' (ConPatIn name (RecCon (HsRecFields flds _))) = AST.URecPat <$> trfName name <*> trfAnnList ", " trfPatternField' flds
 trfPattern' (ConPatIn name (InfixCon left right)) = AST.UInfixAppPat <$> trfPattern left <*> trfOperator name <*> trfPattern right
 trfPattern' (ViewPat expr pat _) = AST.UViewPat <$> trfExpr expr <*> trfPattern pat

@@ -2,7 +2,7 @@ -- | A representation of the tokens that build up the source file.
 module Language.Haskell.Tools.AST.FromGHC.SourceMap where
 
-import ApiAnnotation (AnnKeywordId(..), ApiAnnKey(..))
+import ApiAnnotation (AnnKeywordId, ApiAnnKey)
 import Data.List as List
 import Data.Map as Map
 import Data.Maybe (Maybe(..), maybe, fromMaybe)

@@ -11,11 +11,11 @@ import HsExpr as GHC
 import SrcLoc as GHC
 
-import Language.Haskell.Tools.AST (Ann(), AnnListG(), Dom, RangeStage)
+import Language.Haskell.Tools.AST (Ann, AnnListG, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
 import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.Binds (trfLocalBinds)
 import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr)
-import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf(..), addToScope)
+import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf, addToScope)
 import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..))
 import Language.Haskell.Tools.AST.FromGHC.Patterns (trfPattern)
 import Language.Haskell.Tools.AST.FromGHC.Utils

@@ -13,7 +13,7 @@ import Language.Haskell.Tools.AST.FromGHC.Decls (trfDecls, trfDeclsGroup)
 import Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr, createScopeInfo)
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils (GHCName(..))
-import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf(..))
+import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf)
 import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..), trfName')
 import Language.Haskell.Tools.AST.FromGHC.Patterns (trfPattern)
 import Language.Haskell.Tools.AST.FromGHC.Types (trfType)

@@ -1,11 +1,11 @@ module Language.Haskell.Tools.AST.FromGHC.TH where
 
-import HsExpr as GHC (HsSplice(..), HsBracket(..))
-import Language.Haskell.Tools.AST (Ann(), Dom, RangeStage)
+import HsExpr as GHC (HsSplice, HsBracket)
+import Language.Haskell.Tools.AST (Ann, Dom, RangeStage)
 import qualified Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.FromGHC.Monad (Trf(..))
+import Language.Haskell.Tools.AST.FromGHC.Monad (Trf)
 import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..))
-import SrcLoc as GHC (Located(..))
+import SrcLoc as GHC (Located)
 
 trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.UQuasiQuote (Dom r) RangeStage)
 trfSplice :: TransformName n r => Located (HsSplice n) -> Trf (Ann AST.USplice (Dom r) RangeStage)

@@ -11,7 +11,7 @@            #-}
 module Language.Haskell.Tools.AST.FromGHC.Utils where
 
-import ApiAnnotation (AnnKeywordId(..))
+import ApiAnnotation (AnnKeywordId)
 import Avail (availNamesWithSelectors, availNames)
 import BasicTypes (StringLiteral(..))
 import CoAxiom as GHC (CoAxiom(..))
@@ -75,8 +75,9 @@ -- | Creates a semantic information for an implicit name
 createImplicitFldInfo :: (GHCName n, HsHasName n) => (a -> n) -> [HsRecField n a] -> Trf ImplicitFieldInfo
 createImplicitFldInfo select flds = return (mkImplicitFieldInfo (map getLabelAndExpr flds))
-  where getLabelAndExpr fld = ( head $ hsGetNames $ unLoc (getFieldOccName (hsRecFieldLbl fld))
-                              , head $ hsGetNames $ select (hsRecFieldArg fld) )
+  where getLabelAndExpr fld = ( getTheName $ unLoc (getFieldOccName (hsRecFieldLbl fld))
+                              , getTheName $ select (hsRecFieldArg fld) )
+        getTheName = (\case e:_ -> e; [] -> error "createImplicitFldInfo: missing names") . hsGetNames
 
 -- | Adds semantic information to an impord declaration. See ImportInfo.
 createImportData :: (GHCName r, HsHasName n) => GHC.ImportDecl n -> Trf (ImportInfo r)
@@ -253,6 +254,16 @@ -- | Focuses the transformation to go between tokens. The tokens must be found inside the current range.
 between :: AnnKeywordId -> AnnKeywordId -> Trf a -> Trf a
 between firstTok lastTok = focusAfter firstTok . focusBefore lastTok
+
+betweenIncluding :: AnnKeywordId -> AnnKeywordId -> Trf a -> Trf a
+betweenIncluding firstTok lastTok trf
+  = do start <- tokenLoc firstTok
+       end <- tokenLocBack lastTok
+       if isGoodSrcSpan start && isGoodSrcSpan end
+          then local (\s -> s { contRange = mkSrcSpan (srcSpanStart start) (srcSpanEnd end)}) trf
+          else do rng <- asks contRange 
+                  error $ "betweenIncluding: tokens not found in " ++ show rng ++ ": " 
+                            ++ show firstTok ++ " or " ++ show lastTok
 
 -- | Focuses the transformation to go between tokens if they are present
 betweenIfPresent :: AnnKeywordId -> AnnKeywordId -> Trf a -> Trf a

@@ -1,5 +1,5 @@ name:                haskell-tools-backend-ghc
-version:             0.4.1.3
+version:             0.5.0.0
 synopsis:            Creating the Haskell-Tools AST from GHC's representations
 description:         This package collects information from various representations of a Haskell program in GHC. Basically GHC provides us with the parsed, the renamed and the type checked representation of the program, if it was type correct. Each version contains different information. For example, the renamed AST contains the unique names of the definitions, however, template haskell splices are already resolved and thus missing from that version of the AST. To get the final representation we perform a transformation on the parsed and renamed representation, and then use the type checked one to look up the types of the names. The whole transformation is defined in the `Modules` module. Other modules define the functions that convert elements of the GHC AST to our AST.
 homepage:            https://github.com/nboldi/haskell-tools
@@ -41,5 +41,5 @@                      , split             >= 0.2  && < 0.3
                      , template-haskell  >= 2.11 && < 2.12
                      , ghc               >= 8.0  && < 8.1
-                     , haskell-tools-ast >= 0.4  && < 0.5
+                     , haskell-tools-ast >= 0.5  && < 0.6
   default-language:    Haskell2010