haskell-tools-backend-ghc 0.8.1.0 → 0.9.0.0

raw patch · 43 files changed

+2983/−2975 lines, 43 filesdep ~ghcdep ~ghc-boot-thdep ~haskell-tools-astPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc, ghc-boot-th, haskell-tools-ast

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/AST/FromGHC.hs +0/−9
• Language/Haskell/Tools/AST/FromGHC/AddTypeInfo.hs +0/−96
• Language/Haskell/Tools/AST/FromGHC/Binds.hs +0/−193
• Language/Haskell/Tools/AST/FromGHC/Binds.hs-boot +0/−15
• Language/Haskell/Tools/AST/FromGHC/Decls.hs +0/−598
• Language/Haskell/Tools/AST/FromGHC/Exprs.hs +0/−266
• Language/Haskell/Tools/AST/FromGHC/Exprs.hs-boot +0/−12
• Language/Haskell/Tools/AST/FromGHC/GHCUtils.hs +0/−259
• Language/Haskell/Tools/AST/FromGHC/Kinds.hs +0/−63
• Language/Haskell/Tools/AST/FromGHC/Literals.hs +0/−32
• Language/Haskell/Tools/AST/FromGHC/Modules.hs +0/−210
• Language/Haskell/Tools/AST/FromGHC/Monad.hs +0/−165
• Language/Haskell/Tools/AST/FromGHC/Names.hs +0/−149
• Language/Haskell/Tools/AST/FromGHC/Patterns.hs +0/−72
• Language/Haskell/Tools/AST/FromGHC/SourceMap.hs +0/−57
• Language/Haskell/Tools/AST/FromGHC/Stmts.hs +0/−81
• Language/Haskell/Tools/AST/FromGHC/TH.hs +0/−73
• Language/Haskell/Tools/AST/FromGHC/TH.hs-boot +0/−12
• Language/Haskell/Tools/AST/FromGHC/Types.hs +0/−123
• Language/Haskell/Tools/AST/FromGHC/Types.hs-boot +0/−9
• Language/Haskell/Tools/AST/FromGHC/Utils.hs +0/−460
• Language/Haskell/Tools/BackendGHC.hs +9/−0
• Language/Haskell/Tools/BackendGHC/AddTypeInfo.hs +97/−0
• Language/Haskell/Tools/BackendGHC/Binds.hs +193/−0
• Language/Haskell/Tools/BackendGHC/Binds.hs-boot +15/−0
• Language/Haskell/Tools/BackendGHC/Decls.hs +601/−0
• Language/Haskell/Tools/BackendGHC/Exprs.hs +266/−0
• Language/Haskell/Tools/BackendGHC/Exprs.hs-boot +12/−0
• Language/Haskell/Tools/BackendGHC/GHCUtils.hs +274/−0
• Language/Haskell/Tools/BackendGHC/Kinds.hs +61/−0
• Language/Haskell/Tools/BackendGHC/Literals.hs +32/−0
• Language/Haskell/Tools/BackendGHC/Modules.hs +197/−0
• Language/Haskell/Tools/BackendGHC/Monad.hs +168/−0
• Language/Haskell/Tools/BackendGHC/Names.hs +149/−0
• Language/Haskell/Tools/BackendGHC/Patterns.hs +72/−0
• Language/Haskell/Tools/BackendGHC/SourceMap.hs +57/−0
• Language/Haskell/Tools/BackendGHC/Stmts.hs +81/−0
• Language/Haskell/Tools/BackendGHC/TH.hs +70/−0
• Language/Haskell/Tools/BackendGHC/TH.hs-boot +12/−0
• Language/Haskell/Tools/BackendGHC/Types.hs +121/−0
• Language/Haskell/Tools/BackendGHC/Types.hs-boot +9/−0
• Language/Haskell/Tools/BackendGHC/Utils.hs +466/−0
• haskell-tools-backend-ghc.cabal +21/−21

@@ -1,9 +0,0 @@--- | The FromGHC module provides a way to transform the GHC AST into our AST. This transformation is done in 
--- 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
-
-import Language.Haskell.Tools.AST.FromGHC.AddTypeInfo (addTypeInfos)
-import Language.Haskell.Tools.AST.FromGHC.Modules (trfModule, trfModuleRename)
-import Language.Haskell.Tools.AST.FromGHC.Monad (runTrf)

@@ -1,96 +0,0 @@-{-# LANGUAGE TupleSections
-           , LambdaCase
-           , ScopedTypeVariables
-           #-}
-module Language.Haskell.Tools.AST.FromGHC.AddTypeInfo (addTypeInfos) where
-
-import Bag as GHC (bagToList)
-import GHC
-import HscTypes as GHC
-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 SrcLoc as GHC
-import TcEvidence as GHC (EvBind(..), TcEvBinds(..))
-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 Control.Applicative (Applicative(..), (<$>), Alternative(..))
-import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.State
-import Control.Monad.Trans.Class (MonadTrans(..))
-import Data.Generics.Uniplate.Data ()
-import Data.Generics.Uniplate.Operations (universeBi)
-import Data.List as List
-import qualified Data.Map as Map (fromList, lookup)
-import Data.Maybe (Maybe(..), fromMaybe, catMaybes)
-
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils (getTopLevelId)
-import Language.Haskell.Tools.AST.SemaInfoTypes as AST (mkCNameInfo)
-
-addTypeInfos :: LHsBinds Id -> Ann AST.UModule (Dom GHC.Name) RangeStage -> Ghc (Ann AST.UModule IdDom RangeStage)
-addTypeInfos bnds mod = do
-  ut <- liftIO mkUnknownType
-  let getType = getType' ut
-  fixities <- getFixities
-  let createCName sc def id = mkCNameInfo sc def id fixity
-        where fixity = if any (any ((getOccName id ==) . getOccName . fst)) (init sc) 
-                          then Nothing
-                          else fmap (snd . snd) $ List.find (\(mod,(occ,_)) -> Just mod == (nameModule_maybe $ varName id) && occ == getOccName id) fixities
-  evalStateT (semaTraverse
-    (AST.SemaTrf
-      (\ni -> case (AST.semanticsSourceInfo ni, AST.semanticsName ni) of
-                (_, Just name) -> lift $ createCName (AST.semanticsScope ni) (AST.semanticsDefining ni) <$> getType name
-                (Just l@(RealSrcSpan loc), _)
-                  -> case Map.lookup l locMapping of
-                            Just id -> return $ createCName (AST.semanticsScope ni) (AST.semanticsDefining ni) id
-                            _ -> do (none,rest) <- gets (break ((\(RealSrcSpan sp) -> sp `containsSpan` loc) . fst))
-                                    case rest of [] -> error $ "Ambiguous or implicit name missing, at: " ++ show loc
-                                                 ((_,id):more) -> do put (none ++ more)
-                                                                     return $ createCName (AST.semanticsScope ni) (AST.semanticsDefining ni) id
-                _ -> error "addTypeInfos: Cannot access a the semantics of a name.")
-      pure (traverse (lift . getType)) (traverse (lift . getType)) pure
-        pure) mod) (extractSigIds bnds ++ extractSigBindIds bnds)
-  where locMapping = Map.fromList $ map (\(L l id) -> (l, id)) $ extractExprIds bnds
-        getType' ut name = fromMaybe (mkVanillaGlobal name ut) <$> ((<|> Map.lookup name ids) <$> getTopLevelId name)
-        ids = Map.fromList $ map (\id -> (getName id, id)) $ extractTypes bnds
-        extractTypes :: LHsBinds Id -> [Id]
-        extractTypes = concatMap universeBi . bagToList
-
-        mkUnknownType :: IO Type
-        mkUnknownType = do
-          tUnique <- mkSplitUniqSupply 'x'
-          return $ mkTyVarTy $ mkVanillaGlobal (mkSystemName (uniqFromSupply tUnique) (mkDataOcc "TypeNotFound")) (mkTyConTy starKindTyCon)
-
-        getFixities :: Ghc [(Module, (OccName, GHC.Fixity))]
-        getFixities = do env <- getSession
-                         pit <- liftIO $ eps_PIT <$> hscEPS env
-                         let hpt = hsc_HPT env
-                             ifaces = moduleEnvElts pit ++ map hm_iface (eltsUFM hpt)
-                         return $ concatMap (\mi -> map (mi_module mi, ) $ mi_fixities mi) ifaces
-
-extractExprIds :: LHsBinds Id -> [Located Id]
-        -- expressions like HsRecFld are removed from the typechecked representation, they are replaced by HsVar
-extractExprIds = catMaybes . map (\case L l (HsVar (L _ n)) -> Just (L l n)
-                                        L l (HsWrap _ (HsVar (L _ n))) -> Just (L l n)
-                                        _ -> Nothing
-                                 ) . concatMap universeBi . bagToList
-
-extractSigIds :: LHsBinds Id -> [(SrcSpan,Id)]
-extractSigIds = concat . map (\case L l bs@(AbsBindsSig {} :: HsBind Id) -> map (l,) $ getImplVars (abs_sig_ev_bind bs)
-                                    _                                    -> []
-                             ) . concatMap universeBi . bagToList
-  where getImplVars (EvBinds evbnds) = catMaybes $ map getEvVar $ bagToList evbnds
-        getImplVars _                = []
-        getEvVar (EvBind lhs _ False) = Just lhs
-        getEvVar _                    = Nothing
-
-extractSigBindIds :: LHsBinds Id -> [(SrcSpan,Id)]
-extractSigBindIds = catMaybes . map (\case L l (IPBind (Right id) _) -> Just (l,id)
-                                           _                         -> Nothing
-                                    ) . concatMap universeBi . bagToList

@@ -1,193 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ViewPatterns
-           #-}
--- | Functions that convert the value and function definitions of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Binds where
-
-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 HsTypes as GHC (HsWildCardBndrs(..), HsImplicitBndrs(..))
-import Name as GHC (isSymOcc)
-import SrcLoc as GHC
-
-import Control.Monad.Reader (Monad(..), mapM, asks)
-import Data.List
-
-import Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr)
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils (occName)
-import Language.Haskell.Tools.AST.FromGHC.Monad
-import Language.Haskell.Tools.AST.FromGHC.Names
-import Language.Haskell.Tools.AST.FromGHC.Patterns (trfPattern)
-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 qualified Language.Haskell.Tools.AST as AST
-
-trfBind :: TransformName n r => Located (HsBind n) -> Trf (Ann AST.UValueBind (Dom r) RangeStage)
-trfBind = trfLocNoSema trfBind'
-
-trfBind' :: TransformName n r => HsBind n -> Trf (AST.UValueBind (Dom r) RangeStage)
--- 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)
-                    <*> 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' b = unhandledElement "binding" b
-
-trfMatch :: TransformName n r => n -> Located (Match n (LHsExpr n)) -> Trf (Ann AST.UMatch (Dom r) RangeStage)
-trfMatch id = trfLocNoSema (trfMatch' id)
-
-trfMatch' :: TransformName n r => n -> Match n (LHsExpr n) -> Trf (AST.UMatch (Dom r) RangeStage)
-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 (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
-  = do implicitIdLoc <- mkSrcSpan <$> atTheStart <*> atTheStart
-       parenOpLoc <- tokensLoc [AnnOpenP, AnnVal, AnnCloseP]
-       nonFunOpLoc <- tokenLoc AnnVal
-       let infixLoc = case (parenOpLoc, nonFunOpLoc) of
-                        (RealSrcSpan rsp1, RealSrcSpan rsp2)
-                          | srcLocCol (realSrcSpanStart rsp2) == srcLocCol (realSrcSpanStart rsp1) + 1
-                              && srcLocCol (realSrcSpanEnd rsp2) == srcLocCol (realSrcSpanEnd rsp1) - 1 -> parenOpLoc
-                        _ -> nonFunOpLoc -- sometimes parenOpLoc is not an actual operator in parentheses, it just grabs
-                                         -- a paren, so we need to check that it is actually what we seek
-       closeLoc <- srcSpanStart <$> (combineSrcSpans <$> tokenLoc AnnEqual <*> tokenLoc AnnVbar)
-       args <- mapM trfPattern pats
-       let (n, isInfix) = case fb of NonFunBindMatch -> let token = if isSymOcc (occName name) && isGoodSrcSpan infixLoc then infixLoc else implicitIdLoc
-                                                         in (L token name, length pats > 0 && srcSpanStart token >= srcSpanEnd (getLoc (pats !! 0)))
-                                     FunBindMatch n inf -> (n, inf)
-       annLocNoSema (mkSrcSpan <$> atTheStart <*> (pure closeLoc)) $
-        case (args, isInfix) of
-           (left:right:rest, True) -> AST.UInfixLhs left <$> define (trfOperator n) <*> pure right <*> makeList " " (pure closeLoc) (pure rest)
-           _                       -> AST.UNormalLhs <$> define (trfName n) <*> makeList " " (pure closeLoc) (pure args)
-
-trfRhss :: TransformName n r => [Located (GRHS n (LHsExpr n))] -> Trf (Ann AST.URhs (Dom r) RangeStage)
--- the original location on the GRHS misleadingly contains the local bindings
-trfRhss [unLoc -> GRHS [] body] = annLocNoSema (combineSrcSpans (getLoc body) <$> tokenBefore (srcSpanStart $ getLoc body) AnnEqual)
-                                         (AST.UUnguardedRhs <$> trfExpr body)
-trfRhss rhss = annLocNoSema (pure $ collectLocs rhss)
-                      (AST.UGuardedRhss . nonemptyAnnList <$> mapM trfGuardedRhs rhss)
-
-trfGuardedRhs :: TransformName n r => Located (GRHS n (LHsExpr n)) -> Trf (Ann AST.UGuardedRhs (Dom r) RangeStage)
-trfGuardedRhs = trfLocNoSema $ \(GRHS guards body)
-  -> AST.UGuardedRhs . nonemptyAnnList <$> trfScopedSequence trfRhsGuard guards <*> addToScope guards (trfExpr body)
-
-trfRhsGuard :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.URhsGuard (Dom r) RangeStage)
-trfRhsGuard = trfLocNoSema trfRhsGuard'
-
-trfRhsGuard' :: TransformName n r => Stmt n (LHsExpr n) -> Trf (AST.URhsGuard (Dom r) RangeStage)
-trfRhsGuard' (BindStmt pat body _ _ _) = AST.UGuardBind <$> trfPattern pat <*> trfExpr body
-trfRhsGuard' (BodyStmt body _ _ _) = AST.UGuardCheck <$> trfExpr body
-trfRhsGuard' (LetStmt (unLoc -> binds)) = AST.UGuardLet <$> trfLocalBinds AnnLet binds
-trfRhsGuard' d = unhandledElement "guard" d
-
-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 AnnWhere binds))
-
-getBindLocs :: HsLocalBinds n -> SrcSpan
-getBindLocs (HsValBinds (ValBindsIn binds sigs)) = foldLocs $ map getLoc (bagToList binds) ++ map getLoc sigs
-getBindLocs (HsValBinds (ValBindsOut binds sigs)) = foldLocs $ map getLoc (concatMap (bagToList . snd) binds) ++ map getLoc sigs
-getBindLocs (HsIPBinds (IPBinds binds _)) = foldLocs $ map getLoc binds
-getBindLocs EmptyLocalBinds = noSrcSpan
-
-trfLocalBinds :: TransformName n r => AnnKeywordId -> HsLocalBinds n -> Trf (AnnListG AST.ULocalBind (Dom r) RangeStage)
-trfLocalBinds token (HsValBinds (ValBindsIn binds sigs))
-  = makeIndentedListBefore " " (after token)
-      (orderDefs <$> ((++) <$> mapM (copyAnnot AST.ULocalValBind . trfBind) (bagToList binds)
-                           <*> mapM trfLocalSig sigs))
-trfLocalBinds token (HsValBinds (ValBindsOut binds sigs))
-  = makeIndentedListBefore " " (after token)
-      (orderDefs <$> ((++) <$> (concat <$> mapM (mapM (copyAnnot AST.ULocalValBind . trfBind) . bagToList . snd) binds)
-                           <*> mapM trfLocalSig sigs))
-trfLocalBinds token (HsIPBinds (IPBinds binds _))
-  = makeIndentedListBefore " " (after token) (mapM trfIpBind binds)
-trfLocalBinds _ b = unhandledElement "local binds" b
-
-trfIpBind :: TransformName n r => Located (IPBind n) -> Trf (Ann AST.ULocalBind (Dom r) RangeStage)
-trfIpBind = trfLocNoSema $ \case
-  IPBind (Left (L l ipname)) expr
-    -> AST.ULocalValBind
-         <$> (annContNoSema $ AST.USimpleBind <$> focusOn l (annContNoSema (AST.UVarPat <$> define (trfImplicitName ipname)))
-                                              <*> annFromNoSema AnnEqual (AST.UUnguardedRhs <$> trfExpr expr)
-                                              <*> nothing " " "" atTheEnd)
-  IPBind (Right _) _ -> error "trfIpBind: called on typechecked AST"
-
-trfLocalSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.ULocalBind (Dom r) RangeStage)
-trfLocalSig = trfLocNoSema $ \case
-  ts@(TypeSig {}) -> AST.ULocalSignature <$> annContNoSema (trfTypeSig' ts)
-  (FixSig fs) -> AST.ULocalFixity <$> annContNoSema (trfFixitySig fs)
-  (InlineSig name prag) -> AST.ULocalInline <$> trfInlinePragma name prag
-  d -> unhandledElement "local signature" d
-
-trfTypeSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.UTypeSignature (Dom r) RangeStage)
-trfTypeSig = trfLocNoSema trfTypeSig'
-
-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' ts = unhandledElement "type signature" ts
-
-trfFixitySig :: TransformName n r => FixitySig n -> Trf (AST.UFixitySignature (Dom r) RangeStage)
-trfFixitySig (FixitySig names (Fixity _ prec dir))
-  = do precLoc <- tokenLoc AnnVal -- the precedence token or one of the names
-       AST.UFixitySignature <$> transformDir dir
-                            <*> (if isGoodSrcSpan precLoc && all (srcSpanEnd precLoc <) (map (srcSpanStart . getLoc) names)
-                                   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)
-
-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) <*> (makeJust <$> trfPhaseNum pn))
-trfPhase _ (ActiveBefore _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS)
-                                                           (AST.UPhaseControl <$> (makeJust <$> annLocNoSema (tokenLoc AnnTilde) (pure AST.PhaseInvert)) <*> (makeJust <$> trfPhaseNum pn))
-trfPhase _ NeverActive = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS)
-                                                   (AST.UPhaseControl <$> (makeJust <$> annLocNoSema (tokenLoc AnnTilde) (pure AST.PhaseInvert)) <*> nothing " " "" (after AnnTilde))
-
-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 | length parts > 2
-  = makeJust <$> annLocNoSema (pure $ parts !! 2) (pure AST.UConlikeAnnot)
-  | otherwise = error $ "trfConlike: expected 3 parts, got: " ++ show parts
-trfConlike (_:inlTok:_) FunLike = nothing " " "" (pure $ srcSpanEnd inlTok)
-trfConlike (combTok:_) FunLike = nothing " " "" (pure $ srcSpanEnd combTok)

@@ -1,15 +0,0 @@-module Language.Haskell.Tools.AST.FromGHC.Binds where
-
-import ApiAnnotation (AnnKeywordId)
-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.Names (TransformName(..))
-import SrcLoc as GHC (Located, SrcSpan)
-
-trfLocalBinds :: TransformName n r => AnnKeywordId -> HsLocalBinds n -> Trf (AnnListG AST.ULocalBind (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)

@@ -1,598 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ViewPatterns
-           , ScopedTypeVariables
-           #-}
--- | Functions that convert the declarations of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Decls where
-
-import ApiAnnotation as GHC (AnnKeywordId(..))
-import Bag as GHC (bagToList)
-import BasicTypes as GHC
-import BooleanFormula as GHC (BooleanFormula(..))
-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, isSymOcc)
-import Outputable as GHC (Outputable(..), showSDocUnsafe)
-import RdrName as GHC (RdrName, rdrNameOcc)
-import SrcLoc as GHC
-import TyCon as GHC (Role(..))
-
-import Control.Monad.Reader
-import Control.Reference ((.-), (!~), biplateRef)
-import Data.Generics.Uniplate.Data ()
-import Data.List
-import Data.Maybe (Maybe(..), fromMaybe)
-
-import Language.Haskell.Tools.AST.FromGHC.Binds
-import Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr)
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils
-import Language.Haskell.Tools.AST.FromGHC.Kinds
-import Language.Haskell.Tools.AST.FromGHC.Monad
-import Language.Haskell.Tools.AST.FromGHC.Names
-import Language.Haskell.Tools.AST.FromGHC.Patterns (trfPattern)
-import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.TH (trfSplice)
-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 qualified Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.SemaInfoTypes as AST (nameInfo)
-
-import Outputable
-import Debug.Trace
-
-trfDecls :: TransformName n r => [LHsDecl n] -> Trf (AnnListG AST.UDecl (Dom r) RangeStage)
-trfDecls decls = addToCurrentScope decls $ makeIndentedListNewlineBefore atTheEnd (mapM trfDecl decls)
-
-trfDeclsGroup :: forall n r . TransformName n r => HsGroup n -> Trf (AnnListG AST.UDecl (Dom r) RangeStage)
-trfDeclsGroup (HsGroup vals splices tycls insts derivs fixities defaults foreigns warns anns rules vects _)
-  = do rdrSpls <- asks declSplices -- now we don't want to rename the splices, just interested in their locations to
-                                   -- filter out the declarations that are generated from them
-       let (sigs, bagToList -> binds) = getBindsAndSigs vals
-           -- collect the declarations from the group
-           alldecls :: [Located (HsDecl n)]
-           alldecls = (map (fmap SpliceD) splices)
-                        ++ (map (fmap ValD) binds)
-                        ++ (map (fmap SigD) sigs)
-                        ++ (map (fmap TyClD) (concat $ map group_tyclds tycls))
-                        ++ (map (fmap InstD) insts)
-                        ++ (map (fmap DerivD) derivs)
-                        ++ (map (fmap (SigD . FixSig)) (mergeFixityDefs fixities))
-                        ++ (map (fmap DefD) defaults)
-                        ++ (map (fmap ForD) foreigns)
-                        ++ (map (fmap WarningD) warns)
-                        ++ (map (fmap AnnD) anns)
-                        ++ (map (fmap RuleD) rules)
-                        ++ (map (fmap VectD) vects)
-       -- Declarations generated from TH should only be in scope after the splice.
-       let (genNames, sourceNames) = partition (\d -> any (\spl -> getLoc spl `containsRealSpan` getLoc d) rdrSpls) alldecls
-       addToCurrentScope sourceNames $ do
-         -- use the definitions generated by previous splices when renaming one
-         spls <- asks declSplices >>= mapM (\(L l e) -> let namesGeneratedBefore = filter ((srcSpanStart l >) . srcSpanEnd . getLoc) genNames
-                                                         in addToCurrentScope namesGeneratedBefore ((L l) <$> transformSplice e))
-         let actualDefinitions = removeContained $ orderElems $ replaceSpliceDecls spls alldecls
-           in makeIndentedListNewlineBefore atTheEnd
-                (orderDefs <$> ((++) <$> getDeclsToInsert <*> (mapM (trfDeclsWithScope genNames) actualDefinitions)))
-  where
-    -- use the definitions generated by previous splices when transforming a definition
-    trfDeclsWithScope genNames d = local (\s -> s {declSplices = []})
-                                     $ addToCurrentScope namesGeneratedBefore (trfDecl d)
-      where namesGeneratedBefore = filter ((srcSpanStart (getLoc d) >) . srcSpanEnd . getLoc) genNames
-
-    replaceSpliceDecls :: [Located (HsSplice n)] -> [Located (HsDecl n)] -> [Located (HsDecl n)]
-    replaceSpliceDecls splices decls = foldl mergeSplice decls splices
-
-    orderElems :: [Located a] -> [Located a]
-    orderElems = sortOn (srcSpanStart . getLoc)
-
-    removeContained :: [Located (HsDecl n)] -> [Located (HsDecl n)]
-    removeContained (fst:snd:rest) | getLoc fst `containsRealSpan` getLoc snd
-      = removeContained (fst:rest)
-    removeContained (fst:rest) = fst : removeContained rest
-    removeContained [] = []
-
-    (RealSrcSpan sp1) `containsRealSpan` (RealSrcSpan sp2) = sp1 `containsSpan` sp2
-    _ `containsRealSpan` _ = False
-
-    mergeSplice :: [Located (HsDecl n)] -> Located (HsSplice n) -> [Located (HsDecl n)]
-    mergeSplice decls spl@(L spLoc@(RealSrcSpan rss) _)
-      = L spLoc (SpliceD (SpliceDecl spl ExplicitSplice)) : filter (\(L (RealSrcSpan rdsp) _) -> not (rss `containsSpan` rdsp)) decls
-    mergeSplice _ (L (UnhelpfulSpan {}) _) = error "mergeSplice: no real span"
-
-    getDeclsToInsert :: Trf [Ann AST.UDecl (Dom r) RangeStage]
-    getDeclsToInsert = do decls <- asks declsToInsert
-                          allLocals <- asks localsInScope
-                          case allLocals of locals:_ -> liftGhc $ mapM (loadIdsForDecls (map fst 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
-               where findName rdr = pure $ fromGHCName $ fromMaybe (error $ "Data definition name not found: " ++ showSDocUnsafe (ppr rdr)
-                                                                              ++ ", locals: " ++ (concat $ intersperse ", " $ map (showSDocUnsafe . ppr) locals))
-                                                       $ find ((occNameString (rdrNameOcc rdr) ==) . occNameString . nameOccName) locals
-
-trfDecl :: TransformName n r => Located (HsDecl n) -> Trf (Ann AST.UDecl (Dom r) RangeStage)
-trfDecl = trfLocNoSema $ \case
-  TyClD (FamDecl (FamilyDecl (ClosedTypeFamily typeEqs) name tyVars kindSig inj))
-    -> AST.UClosedTypeFamilyDecl <$> focusAfter AnnType (createDeclHead name tyVars)
-                                <*> trfFamilyResultSig kindSig inj
-                                <*> trfTypeEqs typeEqs
-  TyClD (FamDecl fd) -> AST.UTypeFamilyDecl <$> annContNoSema (trfTypeFam' fd)
-  TyClD (SynDecl name vars rhs _)
-    -> AST.UTypeDecl <$> between AnnType AnnEqual (createDeclHead name vars) <*> trfType rhs
-  TyClD (DataDecl name vars (HsDataDefn nd ctx _ kind cons derivs) _ _)
-    -> do let ctxTok = case nd of DataType -> AnnData
-                                  NewType -> AnnNewtype
-              consLoc = focusBeforeIfPresent AnnDeriving atTheEnd
-          whereLoc <- tokenLoc AnnWhere
-          if isGoodSrcSpan whereLoc then trfGADT nd name vars ctx kind cons derivs ctxTok consLoc
-                                    else trfDataDef nd name vars ctx cons derivs ctxTok consLoc
-  TyClD (ClassDecl ctx name vars funDeps sigs defs typeFuns typeFunDefs _ _)
-    -> AST.UClassDecl <$> trfCtx (after AnnClass) ctx
-                     <*> betweenIfPresent AnnClass AnnWhere (createDeclHead name vars)
-                     <*> trfFunDeps funDeps
-                     <*> createClassBody sigs defs typeFuns typeFunDefs
-  InstD (ClsInstD (ClsInstDecl typ binds sigs typefam datafam overlap))
-    -> AST.UInstDecl <$> trfMaybeDefault " " "" trfOverlap (after AnnInstance) overlap
-                    <*> trfInstanceRule (hsib_body typ)
-                    <*> trfInstBody binds sigs typefam datafam
-  InstD (DataFamInstD (DataFamInstDecl con pats (HsDataDefn nd _ _ _ cons derivs) _))
-    -> AST.UDataInstDecl <$> trfDataKeyword nd
-                        <*> (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)
-  RuleD (HsRules _ rules) -> AST.UPragmaDecl <$> annContNoSema (AST.URulePragma <$> makeIndentedList (before AnnClose) (mapM trfRewriteRule rules))
-  RoleAnnotD (RoleAnnotDecl name roles) -> AST.URoleDecl <$> trfQualifiedName False name <*> makeList " " atTheEnd (mapM trfRole roles)
-  DefD (DefaultDecl types) -> AST.UDefaultDecl <$> makeList "," (after AnnOpenP) (mapM trfType types)
-  ForD (ForeignImport name (hsib_body -> typ) _ (CImport ccall safe _ _ _))
-    -> AST.UForeignImport <$> trfCallConv ccall <*> trfSafety (getLoc ccall) safe <*> define (trfName name) <*> trfType typ
-  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 <$> trfSplice spl
-  WarningD (Warnings src [])
-    -> AST.UPragmaDecl <$> annContNoSema (AST.UDeprPragma <$> (makeList " " (after AnnOpen) (pure []))
-                                                          <*> makeList ", " (before AnnClose) (pure []))
-  WarningD (Warnings src [L _ (Warning names (DeprecatedTxt _ stringLits))])
-    -> AST.UPragmaDecl <$> annContNoSema (AST.UDeprPragma <$> (makeList " " (after AnnOpen) $ mapM trfName names)
-                                                          <*> makeList ", " (before AnnClose) (mapM (\(L l (StringLiteral _ fs)) -> trfFastString (L l fs)) stringLits))
-  WarningD (Warnings src [L _ (Warning names (WarningTxt _ stringLits))])
-    -> AST.UPragmaDecl <$> annContNoSema (AST.UWarningPragma <$> (makeNonemptyList " " $ mapM trfName names)
-                                                             <*> makeList ", " (before AnnClose) (mapM (\(L l (StringLiteral _ fs)) -> trfFastString (L l fs)) stringLits))
-  AnnD (HsAnnotation stxt subject expr)
-    -> AST.UPragmaDecl <$> annContNoSema (AST.UAnnPragma <$> trfAnnotationSubject stxt subject (srcSpanStart $ getLoc expr) <*> trfExpr expr)
-  d -> unhandledElement "declaration" d
-
-trfGADT :: TransformName n r => NewOrData -> Located n -> LHsQTyVars n -> Located (HsContext n)
-                                 -> Maybe (Located (HsKind n)) -> [Located (ConDecl n)]
-                                 -> Maybe (Located [LHsSigType n]) -> AnnKeywordId -> Trf SrcLoc -> Trf (AST.UDecl (Dom r) RangeStage)
-trfGADT nd name vars ctx kind cons derivs ctxTok consLoc
-  = AST.UGDataDecl <$> trfDataKeyword nd
-                   <*> trfCtx (after ctxTok) ctx
-                   <*> betweenIfPresent ctxTok AnnEqual (createDeclHead name vars)
-                   <*> focusBefore AnnWhere (trfKindSig kind)
-                   <*> makeIndentedListBefore " where " consLoc (mapM trfGADTConDecl cons)
-                   <*> trfMaybe "" "" trfDerivings derivs
-
-trfDataDef :: TransformName n r => NewOrData -> Located n -> LHsQTyVars n -> Located (HsContext n)
-                                     -> [Located (ConDecl n)] -> Maybe (Located [LHsSigType n])
-                                     -> AnnKeywordId -> Trf SrcLoc -> Trf (AST.UDecl (Dom r) RangeStage)
-trfDataDef nd name vars ctx cons derivs ctxTok consLoc
-  = AST.UDataDecl <$> trfDataKeyword nd
-                  <*> trfCtx (after ctxTok) ctx
-                  <*> betweenIfPresent ctxTok AnnEqual (createDeclHead name vars)
-                  <*> makeListBefore "=" " | " consLoc (mapM trfConDecl cons)
-                  <*> trfMaybe "" "" trfDerivings derivs
-
-trfVal :: TransformName n r => HsBindLR n n -> Trf (AST.UDecl (Dom r) RangeStage)
-trfVal (PatSynBind psb) = AST.UPatternSynonymDecl <$> annContNoSema (trfPatternSynonym psb)
-trfVal bind = AST.UValueBinding <$> (annContNoSema $ trfBind' bind)
-
-trfSig :: TransformName n r => Sig n -> Trf (AST.UDecl (Dom r) RangeStage)
-trfSig (ts @ (TypeSig {})) = AST.UTypeSigDecl <$> defineTypeVars (annContNoSema $ trfTypeSig' ts)
-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 prag)
-  = AST.UPragmaDecl <$> annContNoSema (AST.UInlinePragmaDecl <$> trfInlinePragma name prag)
-trfSig (SpecSig name (map hsib_body -> types) (inl_act -> phase))
-  = AST.UPragmaDecl <$> annContNoSema (AST.USpecializeDecl <$> trfSpecializePragma name types phase)
-trfSig s = unhandledElement "signature" s
-
-trfSpecializePragma :: TransformName n r
-                    => Located n -> [Located (HsType n)] -> Activation -> Trf (Ann AST.USpecializePragma (Dom r) RangeStage)
-trfSpecializePragma name types phase
-  = annContNoSema $ AST.USpecializePragma <$> trfPhase (pure $ srcSpanStart (getLoc name)) phase
-                                          <*> trfName name
-                                          <*> (orderAnnList <$> trfAnnList ", " trfType' types)
-
-trfConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.UConDecl (Dom r) RangeStage)
-trfConDecl = trfLocNoSema trfConDecl'
-
-trfConDecl' :: TransformName n r => ConDecl n -> Trf (AST.UConDecl (Dom r) RangeStage)
-trfConDecl' (ConDeclH98 { con_name = name, con_qvars = tyVars, con_cxt = ctx, con_details = PrefixCon args })
-  = AST.UConDecl <$> trfConTyVars tyVars <*> trfConCtx ctx <*> define (trfName name) <*> makeList " " atTheEnd (mapM trfType args)
-trfConDecl' (ConDeclH98 { con_name = name, con_qvars = tyVars, con_cxt = ctx, con_details = RecCon (unLoc -> flds) })
-  = AST.URecordDecl <$> trfConTyVars tyVars <*> trfConCtx ctx <*> define (trfName name) <*> (between AnnOpenC AnnCloseC $ trfAnnList ", " trfFieldDecl' flds)
-trfConDecl' (ConDeclH98 { con_name = name, con_qvars = tyVars, con_cxt = ctx, con_details = InfixCon t1 t2 })
-  = AST.UInfixConDecl <$> trfConTyVars tyVars <*> trfConCtx ctx <*> trfType t1 <*> define (trfOperator name) <*> trfType t2
-trfConDecl' gadt@(ConDeclGADT {}) = unhandledElement "normal constructor declaration" gadt
-
-trfConTyVars :: TransformName n r => Maybe (LHsQTyVars n) -> Trf (AnnListG AST.UTyVar (Dom r) RangeStage)
-trfConTyVars Nothing = makeListAfter "." " " atTheStart (return [])
-trfConTyVars (Just vars) = trfBindings $ hsq_explicit vars
-
-trfConCtx :: TransformName n r => Maybe (LHsContext n) -> Trf (AnnMaybeG AST.UContext (Dom r) RangeStage)
-trfConCtx Nothing = nothing "" " => " atTheStart
-trfConCtx (Just ctx) = trfCtx atTheStart ctx
-
-trfGADTConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.UGadtConDecl (Dom r) RangeStage)
-trfGADTConDecl = trfLocNoSema trfGADTConDecl'
-
-trfGADTConDecl' :: TransformName n r => ConDecl n -> Trf (AST.UGadtConDecl (Dom r) RangeStage)
-trfGADTConDecl' (ConDeclGADT { con_names = names, con_type = hsib_body -> typ })
-  = let nameLoc = collectLocs names
-        typLoc = getLoc typ
-        (vars, ctx, t) = getTypeVarsAndCtx typ
-     in AST.UGadtConDecl <$> define (trfAnnList ", " trfName' names)
-                         <*> focusOn (mkSrcSpan (srcSpanEnd nameLoc) (srcSpanStart typLoc)) (trfBindings vars)
-                         <*> updateFocus (return . updateEnd (\_ -> srcSpanStart typLoc)) (focusAfterIfPresent AnnDot (trfCtx atTheStart ctx))
-                         <*> trfGadtConType t
-  where getTypeVarsAndCtx :: LHsType n -> ([LHsTyVarBndr n], LHsContext n, LHsType n)
-        getTypeVarsAndCtx (L _ (HsForAllTy [] typ)) = getTypeVarsAndCtx typ
-        getTypeVarsAndCtx (L _ (HsForAllTy bndrs typ)) = let (_,ctx,t) = getTypeVarsAndCtx typ in (bndrs, ctx, t)
-        getTypeVarsAndCtx (L _ (HsQualTy ctx typ)) = let (vars,_,t) = getTypeVarsAndCtx typ in (vars, ctx, t)
-        getTypeVarsAndCtx t = ([], L noSrcSpan [], t)
-
-trfGadtConType :: TransformName n r => Located (HsType n) -> Trf (Ann AST.UGadtConType (Dom r) RangeStage)
-trfGadtConType = trfLocNoSema $ \case
-  HsFunTy (cleanHsType . unLoc -> HsRecTy flds) resType
-    -> AST.UGadtRecordType <$> between AnnOpenC AnnCloseC (trfAnnList ", " trfFieldDecl' flds)
-                           <*> trfType resType
-  typ -> AST.UGadtNormalType <$> annContNoSema (trfType' typ)
-
-trfFieldDecl :: TransformName n r => Located (ConDeclField n) -> Trf (Ann AST.UFieldDecl (Dom r) RangeStage)
-trfFieldDecl = trfLocNoSema trfFieldDecl'
-
-trfFieldDecl' :: TransformName n r => ConDeclField n -> Trf (AST.UFieldDecl (Dom r) RangeStage)
-trfFieldDecl' (ConDeclField names typ _) = AST.UFieldDecl <$> (define $ nonemptyAnnList <$> mapM (trfName . getFieldOccName) names) <*> trfType typ
-
-trfDerivings :: TransformName n r => Located [LHsSigType n] -> Trf (Ann AST.UDeriving (Dom r) RangeStage)
-trfDerivings = trfLocNoSema $ \case
-  [hsib_body -> typ@(unLoc -> HsTyVar {})] -> AST.UDerivingOne <$> trfInstanceHead typ
-  derivs -> AST.UDerivings <$> trfAnnList ", " trfInstanceHead' (map hsib_body derivs)
-
-trfInstanceRule :: TransformName n r => Located (HsType n) -> Trf (Ann AST.UInstanceRule (Dom r) RangeStage)
-trfInstanceRule = trfLocNoSema (trfInstanceRule' . cleanHsType)
-
-trfInstanceRule' :: TransformName n r => HsType n -> Trf (AST.UInstanceRule (Dom r) RangeStage)
-trfInstanceRule' (HsForAllTy bndrs (unLoc -> HsQualTy ctx typ))
-  = AST.UInstanceRule <$> (makeJust <$> annLocNoSema (pure $ collectLocs bndrs) (trfBindings bndrs))
-                      <*> trfCtx (after AnnDot) ctx
-                      <*> trfInstanceHead typ
-trfInstanceRule' (HsQualTy ctx typ) = AST.UInstanceRule <$> nothing "" " . " atTheStart
-                                                        <*> trfCtx atTheStart ctx
-                                                        <*> trfInstanceHead typ
-trfInstanceRule' (HsParTy typ) = instanceHead $ annContNoSema (AST.UInstanceHeadParen <$> trfInstanceHead typ)
-trfInstanceRule' (HsTyVar tv) = instanceHead $ annContNoSema (AST.UInstanceHeadCon <$> trfName tv)
-trfInstanceRule' (HsAppTy t1 t2) = instanceHead $ annContNoSema (AST.UInstanceHeadApp <$> trfInstanceHead t1 <*> trfType t2)
-trfInstanceRule' (HsOpTy t1 op t2) = instanceHead $ annContNoSema (AST.UInstanceHeadApp <$> annLocNoSema (pure $ getLoc t1 `combineSrcSpans` getLoc op) (AST.UInstanceHeadInfix <$> trfType t1 <*> trfOperator op) <*> trfType t2)
-trfInstanceRule' t = unhandledElement "instance rule" t
-
-instanceHead :: Trf (Ann AST.UInstanceHead (Dom r) RangeStage) -> Trf (AST.UInstanceRule (Dom r) RangeStage)
-instanceHead hd = AST.UInstanceRule <$> (nothing "" " . " atTheStart) <*> (nothing " " "" atTheStart) <*> hd
-
-makeInstanceRuleTyVars :: TransformName n r => Located n -> HsImplicitBndrs n [LHsType n] -> Trf (Ann AST.UInstanceRule (Dom r) RangeStage)
-makeInstanceRuleTyVars n vars
-  | isSymOcc (occName (unLoc n))
-  , leftOp:rest <- hsib_body vars
-  , srcSpanStart (getLoc n) > srcSpanEnd (getLoc leftOp)
-  = annContNoSema
-      $ AST.UInstanceRule <$> nothing "" " . " atTheStart
-                          <*> nothing " " "" atTheStart
-                          <*> foldl foldTypeArgs
-                                    (annLocNoSema (pure $ combineSrcSpans (getLoc leftOp) (getLoc n))
-                                      (AST.UInstanceHeadInfix <$> trfType leftOp <*> trfOperator n)) rest
-  | otherwise
-  = annContNoSema
-      $ AST.UInstanceRule <$> nothing "" " . " atTheStart
-                          <*> nothing " " "" atTheStart
-                          <*> foldl foldTypeArgs (copyAnnot AST.UInstanceHeadCon (trfName n)) (hsib_body vars)
-  where foldTypeArgs base typ = annLocNoSema (pure $ combineSrcSpans (getLoc n) (getLoc typ)) $ AST.UInstanceHeadApp <$> base <*> (trfType typ)
-
-
-trfInstanceHead :: TransformName n r => Located (HsType n) -> Trf (Ann AST.UInstanceHead (Dom r) RangeStage)
-trfInstanceHead = trfLocNoSema trfInstanceHead'
-
-trfInstanceHead' :: TransformName n r => HsType n -> Trf (AST.UInstanceHead (Dom r) RangeStage)
-trfInstanceHead' = trfInstanceHead'' . cleanHsType where
-  trfInstanceHead'' (HsForAllTy [] (unLoc -> t)) = trfInstanceHead' t
-  trfInstanceHead'' (HsTyVar tv) = AST.UInstanceHeadCon <$> trfName tv
-  trfInstanceHead'' (HsAppTy t1 t2) = AST.UInstanceHeadApp <$> trfInstanceHead t1 <*> trfType t2
-  trfInstanceHead'' (HsParTy typ) = AST.UInstanceHeadParen <$> trfInstanceHead typ
-  trfInstanceHead'' (HsOpTy t1 op t2)
-    = AST.UInstanceHeadApp <$> (annLocNoSema (pure $ combineSrcSpans (getLoc t1) (getLoc op))
-                                             (AST.UInstanceHeadInfix <$> trfType t1 <*> trfOperator op))
-                          <*> trfType t2
-  trfInstanceHead'' t = unhandledElement "instance head" t
-
-trfTypeEqs :: TransformName n r => Maybe [Located (TyFamInstEqn n)] -> Trf (AnnListG AST.UTypeEqn (Dom r) RangeStage)
-trfTypeEqs eqs =
-  do toks <- tokensAfter AnnWhere
-     case toks of [] -> error "trfTypeEqs: no where found after closed type family"
-                  loc:_ -> makeList "\n" (pure $ srcSpanStart loc) (mapM trfTypeEq (fromMaybe [] eqs))
-
-trfTypeEq :: TransformName n r => Located (TyFamInstEqn n) -> Trf (Ann AST.UTypeEqn (Dom r) RangeStage)
-trfTypeEq = trfLocNoSema $ \(TyFamEqn name pats rhs)
-  -> AST.UTypeEqn <$> defineTypeVars (focusBefore AnnEqual (combineTypes name (hsib_body pats))) <*> trfType rhs
-  where combineTypes :: TransformName n r => Located n -> [LHsType n] -> Trf (Ann AST.UType (Dom r) RangeStage)
-        combineTypes name [lhs, rhs] | srcSpanStart (getLoc name) > srcSpanEnd (getLoc lhs)
-          = annContNoSema $ AST.UTyInfix <$> trfType lhs <*> trfOperator name <*> trfType rhs
-        combineTypes name pats = wrapTypes (annLocNoSema (pure $ getLoc name) (AST.UTyVar <$> trfName name)) pats
-
-        wrapTypes :: TransformName n r => Trf (Ann AST.UType (Dom r) RangeStage) -> [LHsType n] -> Trf (Ann AST.UType (Dom r) RangeStage)
-        wrapTypes base pats
-          = foldl (\t p -> do typ <- t
-                              annLocNoSema (pure $ combineSrcSpans (getRange typ) (getLoc p))
-                                     (AST.UTyApp <$> pure typ <*> trfType p)) base pats
-
-trfFunDeps :: TransformName n r => [Located (FunDep (Located n))] -> Trf (AnnMaybeG AST.UFunDeps (Dom r) RangeStage)
-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)
-
-trfFunDep' :: TransformName n r => FunDep (Located n) -> Trf (AST.UFunDep (Dom r) RangeStage)
-trfFunDep' (lhs, rhs) = AST.UFunDep <$> trfAnnList ", " trfName' lhs <*> trfAnnList ", " trfName' rhs
-
-createDeclHead :: TransformName n r => Located n -> LHsQTyVars n -> Trf (Ann AST.UDeclHead (Dom r) RangeStage)
-createDeclHead name (hsq_explicit -> lhs : rhs : rest)
-  | srcSpanStart (getLoc name) > srcSpanEnd (getLoc lhs)
-  -- infix declaration
-  = wrapDeclHead rest
-      $ annLocNoSema (addParenLocs $ getLoc lhs `combineSrcSpans` getLoc rhs)
-                     (AST.UDHInfix <$> defineTypeVars (trfTyVar lhs) <*> define (trfOperator name) <*> defineTypeVars (trfTyVar rhs))
-createDeclHead name vars = defineTypeVars $ wrapDeclHead (hsq_explicit vars) (define $ copyAnnot AST.UDeclHead (trfName name))
-
-wrapDeclHead :: TransformName n r => [LHsTyVarBndr n] -> Trf (Ann AST.UDeclHead (Dom r) RangeStage) -> Trf (Ann AST.UDeclHead (Dom r) RangeStage)
-wrapDeclHead vars base
-  = foldl (\t p -> do typ <- t
-                      annLocNoSema (addParenLocs $ combineSrcSpans (getRange typ) (getLoc p))
-                             (AST.UDHApp typ <$> trfTyVar p)
-          ) base vars
-
--- | Get the parentheses directly before and after (for parenthesized application)
-addParenLocs :: SrcSpan -> Trf SrcSpan
-addParenLocs sp
-  = let possibleSpan = mkSrcSpan (updateCol (subtract 1) (srcSpanStart sp)) (updateCol (+1) (srcSpanEnd sp))
-     in local (\s -> s { contRange = possibleSpan })
-              (combineSrcSpans <$> (combineSrcSpans sp <$> tokenLoc AnnOpenP) <*> tokenLocBack AnnCloseP)
-
-
-createClassBody :: TransformName n r => [LSig n] -> LHsBinds n -> [LFamilyDecl n]
-                               -> [LTyFamDefltEqn n] -> Trf (AnnMaybeG AST.UClassBody (Dom r) RangeStage)
-createClassBody sigs binds typeFams typeFamDefs
-  = do isThereWhere <- isGoodSrcSpan <$> (tokenLoc AnnWhere)
-       if isThereWhere
-         then makeJust <$> annLocNoSema (combinedLoc <$> tokenLoc AnnWhere)
-                                        (AST.UClassBody <$> makeList "" (after AnnWhere)
-                                                                       (orderDefs . concat <$> sequenceA allDefs))
-         else nothing " where " "" atTheEnd
-  where combinedLoc wh = foldl combineSrcSpans wh allLocs
-        allLocs = map getLoc sigs ++ map getLoc (bagToList binds) ++ map getLoc typeFams ++ map getLoc typeFamDefs
-        allDefs = [getSigs, getBinds, getFams, getFamDefs]
-        getSigs = mapM trfClassElemSig sigs
-        getBinds = mapM (copyAnnot AST.UClsDef . trfBind) (bagToList binds)
-        getFams = mapM (copyAnnot AST.UClsTypeFam . trfTypeFam) typeFams
-        getFamDefs = mapM trfTypeFamDef typeFamDefs
-
-trfClassElemSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.UClassElement (Dom r) RangeStage)
-trfClassElemSig = trfLocNoSema $ \case
-  TypeSig names typ -> AST.UClsSig <$> (annContNoSema $ AST.UTypeSignature <$> define (makeNonemptyList ", " (mapM trfName names))
-                                  <*> trfType (hswc_body $ hsib_body typ))
-  ClassOpSig True [name] typ -> AST.UClsDefSig <$> trfName name <*> trfType (hsib_body typ)
-  ClassOpSig False names typ -> AST.UClsSig <$> (annContNoSema $ AST.UTypeSignature <$> define (makeNonemptyList ", " (mapM trfName names))
-                                           <*> trfType (hsib_body typ))
-  MinimalSig _ formula -> AST.UClsMinimal <$> trfMinimalFormula formula
-  InlineSig name prag -> AST.UClsInline <$> trfInlinePragma name prag
-  FixSig fixity -> AST.UClsFixity <$> annContNoSema (trfFixitySig fixity)
-  s -> unhandledElement "signature in class" s
-
-trfTypeFam :: TransformName n r => Located (FamilyDecl n) -> Trf (Ann AST.UTypeFamily (Dom r) RangeStage)
-trfTypeFam = trfLocNoSema trfTypeFam'
-
-trfTypeFam' :: TransformName n r => FamilyDecl n -> Trf (AST.UTypeFamily (Dom r) RangeStage)
-trfTypeFam' (FamilyDecl DataFamily name tyVars kindSig _)
-  = AST.UDataFamily <$> (case unLoc kindSig of KindSig _ -> between AnnData AnnDcolon; _ -> id) (createDeclHead name tyVars)
-                   <*> trfFamilyKind kindSig
-trfTypeFam' (FamilyDecl OpenTypeFamily name tyVars kindSig injectivity)
-  = AST.UTypeFamily <$> (case unLoc kindSig of KindSig _ -> between AnnType AnnDcolon; _ -> id) (createDeclHead name tyVars)
-                   <*> trfFamilyResultSig kindSig injectivity
-trfTypeFam' (FamilyDecl (ClosedTypeFamily {}) _ _ _ _) = error "trfTypeFam': closed type family received"
-
-trfTypeFamDef :: TransformName n r => Located (TyFamDefltEqn n) -> Trf (Ann AST.UClassElement (Dom r) RangeStage)
-trfTypeFamDef = trfLocNoSema $ \(TyFamEqn con pats rhs)
-  -> AST.UClsTypeDef <$> between AnnType AnnEqual (createDeclHead con pats) <*> trfType rhs
-
-trfInstBody :: TransformName n r => LHsBinds n -> [LSig n] -> [LTyFamInstDecl n] -> [LDataFamInstDecl n] -> Trf (AnnMaybeG AST.UInstBody (Dom r) RangeStage)
-trfInstBody binds sigs fams dats = do
-    wh <- tokenLoc AnnWhere
-    if isGoodSrcSpan wh then
-      makeJust <$> annLocNoSema (combinedLoc <$> tokenLoc AnnWhere)
-                                (AST.UInstBody <$> (makeList "" (after AnnWhere)
-                                                      (orderDefs . concat <$> sequenceA allDefs)))
-    else nothing " where " "" atTheEnd
-  where combinedLoc wh = foldl combineSrcSpans wh allLocs
-        allLocs = map getLoc sigs ++ map getLoc (bagToList binds) ++ map getLoc fams ++ map getLoc dats
-        allDefs = [getSigs, getBinds, getFams, getDats]
-        getSigs = mapM trfClassInstSig sigs
-        getBinds = mapM (copyAnnot AST.UInstBodyNormalDecl . trfBind) (bagToList binds)
-        getFams = mapM trfInstTypeFam fams
-        getDats = mapM trfInstDataFam dats
-
-trfClassInstSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.UInstBodyDecl (Dom r) RangeStage)
-trfClassInstSig = trfLocNoSema $ \case
-  TypeSig names typ -> AST.UInstBodyTypeSig <$> (annContNoSema $ AST.UTypeSignature <$> makeNonemptyList ", " (mapM trfName names)
-                                           <*> trfType (hswc_body $ hsib_body typ))
-  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)
-  SpecSig name (map hsib_body -> tys) (inl_act -> phase) -> AST.UInstanceSpecialize <$> trfSpecializePragma name tys phase
-  InlineSig name prag -> AST.UInlineInstance <$> trfInlinePragma name prag
-  s -> unhandledElement "class instance signature" s
-
-trfInstTypeFam :: TransformName n r => Located (TyFamInstDecl n) -> Trf (Ann AST.UInstBodyDecl (Dom r) RangeStage)
-trfInstTypeFam (unLoc -> TyFamInstDecl eqn _) = copyAnnot AST.UInstBodyTypeDecl (trfTypeEq eqn)
-
-trfInstDataFam :: TransformName n r => Located (DataFamInstDecl n) -> Trf (Ann AST.UInstBodyDecl (Dom r) RangeStage)
-trfInstDataFam = trfLocNoSema $ \case
-  (DataFamInstDecl tc (hsib_body -> pats) (HsDataDefn dn ctx _ ks cons derivs) _)
-    | all ((\case ConDeclH98{} -> True; _ -> False) . unLoc) cons
-    -> AST.UInstBodyDataDecl
-         <$> trfDataKeyword dn
-         <*> annLocNoSema (pure $ collectLocs pats `combineSrcSpans` getLoc tc `combineSrcSpans` getLoc ctx)
-                          (AST.UInstanceRule <$> nothing "" " . " atTheStart
-                                             <*> trfCtx atTheStart ctx
-                                             <*> transformNameAndPats tc pats)
-         <*> trfAnnList "" trfConDecl' cons
-         <*> trfMaybe " deriving " "" trfDerivings derivs
-    | otherwise
-    -> AST.UInstBodyGadtDataDecl
-        <$> trfDataKeyword dn
-        <*> annLocNoSema (pure $ collectLocs pats `combineSrcSpans` getLoc tc `combineSrcSpans` getLoc ctx)
-                         (AST.UInstanceRule <$> nothing "" " . " atTheStart
-                                            <*> trfCtx atTheStart ctx
-                                            <*> transformNameAndPats tc pats)
-        <*> trfKindSig ks
-        <*> trfAnnList "" trfGADTConDecl' cons
-        <*> trfMaybe " deriving " "" trfDerivings derivs
-  where transformNameAndPats tc pats
-          | all (\p -> srcSpanEnd (getLoc tc) < srcSpanStart (getLoc p)) pats -- prefix instance head application
-          = foldl (\r t -> annLocNoSema (combineSrcSpans (getLoc t) . getRange <$> r)
-                                          (AST.UInstanceHeadApp <$> r <*> (trfType t)))
-                  (copyAnnot AST.UInstanceHeadCon (trfName tc)) pats
-        transformNameAndPats tc (p:rest)
-          | otherwise -- infix instance head application
-          = foldl (\r t -> annLocNoSema (combineSrcSpans (getLoc t) . getRange <$> r)
-                                          (AST.UInstanceHeadApp <$> r <*> (trfType t)))
-                  (annLocNoSema (pure $ getLoc p `combineSrcSpans` getLoc tc)
-                          (AST.UInstanceHeadInfix <$> trfType p <*> trfOperator tc)) rest
-
-trfPatternSynonym :: forall n r . TransformName n r => PatSynBind n n -> Trf (AST.UPatternSynonym (Dom r) RangeStage)
-trfPatternSynonym (PSB id _ lhs def dir)
-  = let sep = case dir of ImplicitBidirectional -> AnnEqual
-                          _                     -> AnnLarrow
-        rhsLoc = combineSrcSpans (getLoc def) <$> tokenLoc sep
-        -- we use the selector name instead of the pattern variable name
-        rewrites = case lhs of RecordPatSyn flds -> map (\r -> (unLoc (recordPatSynPatVar r), unLoc (recordPatSynSelectorId r))) flds
-                               _                 -> []
-        changedRhs = biplateRef .- (\n -> case lookup n rewrites of Just x -> x; Nothing -> n) $ def
-     in AST.UPatternSynonym <$> trfPatSynLhs id lhs
-                            <*> annLocNoSema rhsLoc (trfPatSynRhs dir changedRhs)
-
-  where trfPatSynLhs :: Located n -> HsPatSynDetails (Located n) -> Trf (Ann AST.UPatSynLhs (Dom r) RangeStage)
-        trfPatSynLhs id (PrefixPatSyn args)
-          = annLocNoSema (pure $ foldLocs (getLoc id : map getLoc args)) $ AST.UNormalPatSyn <$> trfName id <*> trfAnnList " " trfName' args
-        trfPatSynLhs op (InfixPatSyn lhs rhs)
-          = annLocNoSema (pure $ getLoc lhs `combineSrcSpans` getLoc rhs) $ AST.UInfixPatSyn <$> trfName lhs <*> trfOperator op <*> trfName rhs
-        trfPatSynLhs id (RecordPatSyn flds)
-          = annLocNoSema (mkSrcSpan (srcSpanStart (getLoc id)) <$> before AnnEqual)
-              $ AST.URecordPatSyn <$> trfName id <*> trfAnnList ", " trfName' (map recordPatSynSelectorId flds)
-
-        trfPatSynRhs :: HsPatSynDir n -> Located (Pat n) -> Trf (AST.UPatSynRhs (Dom r) RangeStage)
-        trfPatSynRhs ImplicitBidirectional pat = AST.UBidirectionalPatSyn <$> trfPattern pat <*> nothing " where " "" atTheEnd
-        trfPatSynRhs (ExplicitBidirectional mg) pat = AST.UBidirectionalPatSyn <$> trfPattern pat <*> (makeJust <$> trfPatSynWhere mg)
-        trfPatSynRhs Unidirectional pat = AST.UOneDirectionalPatSyn <$> trfPattern pat
-
-        trfPatSynWhere :: MatchGroup n (LHsExpr n) -> Trf (Ann AST.UPatSynWhere (Dom r) RangeStage)
-        trfPatSynWhere (MG { mg_alts = alts }) = annLocNoSema (pure $ getLoc alts) (AST.UPatSynWhere <$> makeIndentedList (after AnnWhere) (mapM (trfMatch (unLoc id)) (unLoc alts)))
-
-trfFamilyKind :: TransformName n r => Located (FamilyResultSig n) -> Trf (AnnMaybeG AST.UKindConstraint (Dom r) RangeStage)
-trfFamilyKind (unLoc -> fr) = case fr of
-  NoSig -> nothing "" " " atTheEnd
-  KindSig k -> trfKindSig (Just k)
-  TyVarSig tv -> error "trfFamilyKind: TyVarSig not supported"
-
-trfFamilyResultSig :: TransformName n r => Located (FamilyResultSig n) -> Maybe (LInjectivityAnn n) -> Trf (AnnMaybeG AST.UTypeFamilySpec (Dom r) RangeStage)
-trfFamilyResultSig (L l fr) Nothing = case fr of
-  NoSig -> nothing "" " " atTheEnd
-  KindSig k -> makeJust <$> (annLocNoSema (pure l) $ AST.UTypeFamilyKind <$> trfKindSig' k)
-  TyVarSig {} -> error "trfFamilyResultSig: TyVarSig not supported" {- makeJust <$> (annLocNoSema (combineSrcSpans (getLoc tv) <$> (tokenBefore (srcSpanStart (getLoc tv)) AnnDcolon))
-                              (AST.UKindConstraint <$> trfKindVar tv)) -}
-trfFamilyResultSig (L _ sig) (Just (L l (InjectivityAnn n deps)))
-  = makeJust <$> (annLocNoSema (pure l) $ AST.UTypeFamilyInjectivity <$> (annContNoSema $ AST.UInjectivityAnn <$> tv <*> trfAnnList ", " trfName' deps))
-    where tv = case sig of TyVarSig tv -> trfTyVar tv
-                           _ -> annLocNoSema (pure $ getLoc n) (AST.UTyVarDecl <$> trfName n <*> nothing "" "" (pure $ srcSpanEnd (getLoc n)))
-
-trfAnnotationSubject :: TransformName n r => SourceText -> AnnProvenance n -> SrcLoc -> Trf (Ann AST.UAnnotationSubject (Dom r) RangeStage)
-trfAnnotationSubject stxt subject payloadEnd
-  = do payloadStart <- advanceStr stxt <$> atTheStart
-       case subject of ValueAnnProvenance name@(L l _) -> annLocNoSema (pure l) (AST.UNameAnnotation <$> trfName name)
-                       TypeAnnProvenance name@(L l _) -> annLocNoSema (pure $ mkSrcSpan payloadStart (srcSpanEnd l))
-                                                                      (AST.UTypeAnnotation <$> trfName name)
-                       ModuleAnnProvenance -> annLocNoSema (pure $ mkSrcSpan payloadStart payloadEnd) (pure AST.UModuleAnnotation)
-
-trfDataKeyword ::  NewOrData -> Trf (Ann AST.UDataOrNewtypeKeyword (Dom r) RangeStage)
-trfDataKeyword NewType = annLocNoSema (tokenLoc AnnNewtype) (pure AST.UNewtypeKeyword)
-trfDataKeyword DataType = annLocNoSema (tokenLoc AnnData) (pure AST.UDataKeyword)
-
-trfCallConv :: Located CCallConv -> Trf (Ann AST.UCallConv (Dom r) RangeStage)
-trfCallConv = trfLocNoSema trfCallConv'
-
-trfCallConv' :: CCallConv -> Trf (AST.UCallConv (Dom r) RangeStage)
-trfCallConv' CCallConv = pure AST.UCCall
-trfCallConv' CApiConv = pure AST.UCApi
-trfCallConv' StdCallConv = pure AST.UStdCall
-trfCallConv' JavaScriptCallConv = pure AST.UJavaScript
-trfCallConv' PrimCallConv = error "trfCallConv: PrimCallConv not supported"
-
-trfSafety :: SrcSpan -> Located Safety -> Trf (AnnMaybeG AST.USafety (Dom r) RangeStage)
-trfSafety ccLoc lsaf@(L l _) | isGoodSrcSpan l
-  = makeJust <$> trfLocNoSema (pure . \case
-      PlaySafe -> AST.USafe
-      PlayInterruptible -> AST.UInterruptible
-      PlayRisky -> AST.UUnsafe) lsaf
-  | otherwise = nothing " " "" (pure $ srcSpanEnd ccLoc)
-
-trfOverlap :: Located OverlapMode -> Trf (Ann AST.UOverlapPragma (Dom r) RangeStage)
-trfOverlap = trfLocNoSema $ pure . \case
-  NoOverlap _ -> AST.UDisableOverlap
-  Overlappable _ -> AST.UOverlappable
-  Overlapping _ -> AST.UOverlapping
-  Overlaps _ -> AST.UOverlaps
-  Incoherent _ -> AST.UIncoherentOverlap
-
-trfRole :: Located (Maybe Role) -> Trf (Ann AST.URole (Dom r) RangeStage)
-trfRole = trfLocNoSema $ \case Just Nominal -> pure AST.UNominal
-                               Just Representational -> pure AST.URepresentational
-                               Just GHC.Phantom -> pure AST.UPhantom
-                               Nothing -> error "trfRole: no role"
-
-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 (pure $ srcSpanEnd nameLoc) act
-            <*> makeListAfter " " " " (pure $ srcSpanStart $ getLoc left) (mapM trfRuleBndr bndrs)
-            <*> trfExpr left
-            <*> trfExpr right
-
-trfRuleBndr :: TransformName n r => Located (RuleBndr n) -> Trf (Ann AST.URuleVar (Dom r) RangeStage)
-trfRuleBndr = trfLocNoSema $ \case (RuleBndr n) -> AST.URuleVar <$> trfName n
-                                   (RuleBndrSig n k) -> AST.USigRuleVar <$> trfName n <*> trfType (hswc_body $ hsib_body k)
-
-trfMinimalFormula :: TransformName n r => Located (BooleanFormula (Located n)) -> Trf (Ann AST.UMinimalFormula (Dom r) RangeStage)
-trfMinimalFormula = trfLocNoSema trfMinimalFormula'
-
-trfMinimalFormula' :: TransformName n r => BooleanFormula (Located n) -> Trf (AST.UMinimalFormula (Dom r) RangeStage)
-trfMinimalFormula' (Var name) = AST.UMinimalName <$> trfName name
-trfMinimalFormula' (And formulas) = AST.UMinimalAnd <$> trfAnnList " & " trfMinimalFormula' formulas
-trfMinimalFormula' (Or formulas) = AST.UMinimalOr <$> trfAnnList " | " trfMinimalFormula' formulas
-trfMinimalFormula' (Parens formula) = AST.UMinimalParen <$> trfMinimalFormula formula

@@ -1,266 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ViewPatterns
-           , ScopedTypeVariables
-           , TypeApplications
-           , AllowAmbiguousTypes
-           #-}
--- | Functions that convert the expression-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Exprs where
-
-import Control.Monad.Reader
-import Data.List
-import Data.Function (on)
-import Data.Maybe (Maybe(..), isJust, fromMaybe, catMaybes)
-
-import BasicTypes as GHC (Boxity(..), StringLiteral(..))
-import FastString (unpackFS)
-import GHC
-import OccName as GHC (occNameString)
-import PrelNames as GHC (negateName)
-import SrcLoc as GHC
-
-import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.Binds (trfRhsGuard', trfWhereLocalBinds, trfLocalBinds)
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils (GHCName(..), getFieldOccName)
-import Language.Haskell.Tools.AST.FromGHC.Literals (trfLiteral', trfOverloadedLit)
-import Language.Haskell.Tools.AST.FromGHC.Monad
-import Language.Haskell.Tools.AST.FromGHC.Names
-import Language.Haskell.Tools.AST.FromGHC.Patterns (trfPattern)
-import Language.Haskell.Tools.AST.FromGHC.Stmts
-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 (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)
--- correction for empty cases
-trfExpr (L l cs@(HsCase expr (unLoc . mg_alts -> [])))
-  = do let realSpan = combineSrcSpans l (getLoc expr)
-       tokensAfter <- allTokensAfter (srcSpanEnd realSpan)
-       let actualSpan = case take 3 tokensAfter of
-                          [(_, AnnOf), (_, AnnOpenC), (endSpan, AnnCloseC)] -> realSpan `combineSrcSpans` endSpan
-                          ((endSpan, AnnOf) : _) -> realSpan `combineSrcSpans` endSpan
-                          _ -> error "trfExpr: case without 'of' '{' or '}' token"
-       annLoc createScopeInfo (pure actualSpan) (trfExpr' cs)
-trfExpr e | RealSrcSpan loce <- getLoc e
-  = do exprSpls <- asks exprSplices
-       let contSplice = filter (\sp -> case getLoc sp of (RealSrcSpan spLoc) -> spLoc `containsSpan` loce; _ -> False) exprSpls
-       case contSplice of
-         [] -> trfLoc trfExpr' createScopeInfo e
-         _ -> let lsp@(L l sp) = minimumBy (compareSpans `on` getLoc) contSplice
-               in case sp of
-                    (HsQuasiQuote {}) -> do
-                      sp' <- rdrSplice sp
-                      exprSpliceInserted lsp (annLoc createScopeInfo (pure l) (AST.UQuasiQuoteExpr <$> annLocNoSema (pure l) (trfQuasiQuotation' sp')))
-                    _ -> do sp' <- rdrSplice sp
-                            exprSpliceInserted lsp (annLoc createScopeInfo (pure l) (AST.USplice <$> trfSplice sp'))
-  | otherwise = trfLoc trfExpr' createScopeInfo e
-
-createScopeInfo :: Trf ScopeInfo
-createScopeInfo = do scope <- asks localsInScope
-                     return (mkScopeInfo scope)
-
-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)
-trfExpr' (HsLit val) = AST.ULit <$> annContNoSema (trfLiteral' val)
-trfExpr' (HsLam (unLoc . mg_alts -> [unLoc -> Match _ pats _ (GRHSs [unLoc -> GRHS [] expr] (unLoc -> EmptyLocalBinds))]))
-  = AST.ULambda <$> (makeNonemptyList " " $ mapM trfPattern pats) <*> addToScope pats (trfExpr expr)
-trfExpr' (HsLamCase _ (unLoc . mg_alts -> matches)) = AST.ULamCase <$> trfAnnList " " trfAlt' matches
-trfExpr' (HsApp e1 e2) = AST.UApp <$> trfExpr e1 <*> trfExpr e2
-trfExpr' (OpApp e1 (unLoc -> HsVar op) _ e2)
-  = AST.UInfixApp <$> trfExpr e1 <*> trfOperator op <*> trfExpr e2
-trfExpr' (OpApp e1 (L nameLoc (HsRecFld fld)) _ e2)
-  = AST.UInfixApp <$> trfExpr e1 <*> trfAmbiguousOperator' nameLoc fld <*> trfExpr e2
-trfExpr' (OpApp e1 (L _ op) _ e2) = unhandledElement "OpApp expression" op
-trfExpr' (NegApp e _) = AST.UPrefixApp <$> annLocNoSema loc (AST.UNormalOp <$> annLoc info loc (AST.nameFromList <$> trfOperatorStr False "-"))
-                                       <*> trfExpr e
-  where loc = mkSrcSpan <$> atTheStart <*> (pure $ srcSpanStart (getLoc e))
-        info = createNameInfo =<< (fromMaybe (error "minus operation is not found") <$> liftGhc negateOpName)
-        negateOpName = getFromNameUsing (\n -> (\case Just (AnId id) -> Just id; _ -> Nothing) <$> lookupName n) negateName
-trfExpr' (HsPar (unLoc -> SectionL expr (unLoc -> HsVar op))) = AST.ULeftSection <$> trfExpr expr <*> trfOperator op
-trfExpr' (HsPar (unLoc -> SectionL expr (L nameLoc (HsRecFld op))))
-  = AST.ULeftSection <$> trfExpr expr <*> trfAmbiguousOperator' nameLoc op
-trfExpr' (HsPar (unLoc -> SectionR (unLoc -> HsVar op) expr)) = AST.URightSection <$> trfOperator op <*> trfExpr expr
-trfExpr' (HsPar (unLoc -> SectionR (L nameLoc (HsRecFld op)) expr))
-  = AST.URightSection <$> trfAmbiguousOperator' nameLoc op <*> trfExpr expr
-trfExpr' (HsPar expr) = AST.UParen <$> trfExpr expr
-trfExpr' (ExplicitTuple tupArgs box) | all tupArgPresent 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 (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
-        trfTupSecElem :: forall n r . TransformName n r => (HsTupArg n, SrcSpan) -> Trf (Ann AST.UTupSecElem (Dom r) RangeStage)
-        trfTupSecElem (Present e, l)
-          = annLocNoSema (pure l) (AST.Present <$> (annCont createScopeInfo (trfExpr' (unLoc e))))
-        trfTupSecElem (Missing _, l) = annLocNoSema (pure l) (pure AST.Missing)
-
-        existingArgs :: [SrcSpan]
-        existingArgs = catMaybes $ map (\case Present p -> Just (getLoc p); _ -> Nothing) $ map unLoc tupArgs
-
-        elemLocs :: Trf [SrcSpan]
-        elemLocs = do r <- asks contRange
-                      commaLocs <- allTokenLoc AnnComma
-                      return $ foldl breakUp [r] (filter freeComma commaLocs)
-          where freeComma (RealSrcSpan s) = not $ any (\case RealSrcSpan e -> e `containsSpan` s; _ -> False) existingArgs
-                freeComma _ = False
-
-        breakUp :: [SrcSpan] -> SrcSpan -> [SrcSpan]
-        breakUp cont sep = concatMap (breakUpOne sep) cont
-
-        breakUpOne :: SrcSpan -> SrcSpan -> [SrcSpan]
-        breakUpOne sep@(RealSrcSpan realSep) sp@(RealSrcSpan realSp)
-          | realSp `containsSpan` realSep = [mkSrcSpan (srcSpanStart sp) (srcSpanStart sep), mkSrcSpan (srcSpanEnd sep) (srcSpanEnd sp)]
-        breakUpOne _ sp = [sp]
-
-trfExpr' (HsCase expr (unLoc . mg_alts -> cases)) = AST.UCase <$> trfExpr expr <*> (makeIndentedList (focusBeforeIfPresent AnnCloseC atTheEnd) (mapM trfAlt cases))
-trfExpr' (HsIf _ expr thenE elseE) = AST.UIf <$> trfExpr expr <*> trfExpr thenE <*> trfExpr elseE
-trfExpr' (HsMultiIf _ parts) = AST.UMultiIf <$> trfAnnList "" trfGuardedCaseRhs' parts
-trfExpr' (HsLet (unLoc -> binds) expr) = addToScope binds (AST.ULet <$> trfLocalBinds AnnLet binds <*> trfExpr expr)
-trfExpr' (HsDo DoExpr (unLoc -> stmts) _) = AST.UDo <$> annLocNoSema (tokenLoc AnnDo) (pure AST.UDoKeyword)
-                                                    <*> makeNonemptyIndentedList (trfScopedSequence trfDoStmt stmts)
-trfExpr' (HsDo MDoExpr (unLoc -> [unLoc -> RecStmt { recS_stmts = stmts }, lastStmt]) _)
-  = AST.UDo <$> annLocNoSema (tokenLoc AnnMdo) (pure AST.UMDoKeyword)
-            <*> addToScope stmts (makeNonemptyIndentedList (mapM trfDoStmt (stmts ++ [lastStmt])))
-trfExpr' (HsDo MDoExpr (unLoc -> stmts) _) = AST.UDo <$> annLocNoSema (tokenLoc AnnMdo) (pure AST.UMDoKeyword)
-                                                     <*> addToScope stmts (makeNonemptyIndentedList (mapM trfDoStmt stmts))
-trfExpr' (HsDo ListComp (unLoc -> stmts) _)
-  = AST.UListComp <$> trfExpr (getLastStmt stmts) <*> trfListCompStmts stmts
-trfExpr' (HsDo MonadComp (unLoc -> stmts) _)
-  = AST.UListComp <$> trfExpr (getLastStmt stmts) <*> trfListCompStmts stmts
-trfExpr' (HsDo PArrComp (unLoc -> stmts) _)
-  = AST.UParArrayComp <$> trfExpr (getLastStmt stmts) <*> trfListCompStmts stmts
-trfExpr' (ExplicitList _ _ exprs) = AST.UList <$> trfAnnList' ", " trfExpr exprs
-trfExpr' (ExplicitPArr _ exprs) = AST.UParArray <$> trfAnnList' ", " trfExpr exprs
-trfExpr' (RecordCon name _ _ fields) = AST.URecCon <$> trfName name <*> trfFieldInits fields
-trfExpr' (RecordUpd expr fields _ _ _ _) = AST.URecUpdate <$> trfExpr expr <*> trfAnnList ", " trfFieldUpdate fields
-trfExpr' (ExprWithTySig expr typ) = AST.UTypeSig <$> trfExpr expr <*> trfType (hswc_body $ hsib_body typ)
-trfExpr' (ArithSeq _ _ (From from)) = AST.UEnum <$> trfExpr from <*> nothing "," "" (before AnnDotdot)
-                                                                <*> nothing "" "" (before AnnCloseS)
-trfExpr' (ArithSeq _ _ (FromThen from step))
-  = AST.UEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> nothing "" "" (before AnnCloseS)
-trfExpr' (ArithSeq _ _ (FromTo from to))
-  = AST.UEnum <$> trfExpr from <*> nothing "," "" (before AnnDotdot)
-                               <*> (makeJust <$> trfExpr to)
-trfExpr' (ArithSeq _ _ (FromThenTo from step to))
-  = AST.UEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> (makeJust <$> trfExpr to)
-trfExpr' (PArrSeq _ (FromTo from to))
-  = AST.UParArrayEnum <$> trfExpr from <*> nothing "," "" (before AnnDotdot) <*> trfExpr to
-trfExpr' (PArrSeq _ (FromThenTo from step to))
-  = AST.UParArrayEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> trfExpr to
-trfExpr' (HsBracket brack) = AST.UBracketExpr <$> annContNoSema (trfBracket' brack)
-trfExpr' (HsSpliceE qq@(HsQuasiQuote {})) = AST.UQuasiQuoteExpr <$> annContNoSema (trfQuasiQuotation' qq)
-trfExpr' (HsSpliceE splice) = AST.USplice <$> trfSplice splice
-trfExpr' (HsRnBracketOut br _) = AST.UBracketExpr <$> annContNoSema (trfBracket' br)
-trfExpr' (HsProc pat cmdTop) = AST.UProc <$> trfPattern pat <*> trfCmdTop cmdTop
-trfExpr' (HsStatic expr) = AST.UStaticPtr <$> trfExpr expr
-trfExpr' (HsAppType expr typ) = AST.UExplTypeApp <$> trfExpr expr <*> trfType (hswc_body typ)
-trfExpr' (HsSCC _ lit expr) = AST.UExprPragma <$> pragma <*> trfExpr expr
-  where pragma = do pragLoc <- tokensLoc [AnnOpen, AnnClose]
-                    focusOn pragLoc $ annContNoSema (AST.USccPragma <$> annLocNoSema (mappend <$> tokenLoc AnnValStr <*> tokenLocBack AnnVal) (trfText' lit))
-trfExpr' (HsCoreAnn _ lit expr) = AST.UExprPragma <$> pragma <*> trfExpr expr
-  where pragma = do pragLoc <- tokensLoc [AnnOpen, AnnClose]
-                    focusOn pragLoc $ annContNoSema (AST.UCorePragma <$> annLocNoSema (mappend <$> tokenLoc AnnValStr <*> tokenLocBack AnnVal) (trfText' lit))
-trfExpr' (HsTickPragma _ source _ expr) = AST.UExprPragma <$> pragma <*> trfExpr expr
-  where pragma = do pragLoc <- tokensLoc [AnnOpen, AnnClose]
-                    focusOn pragLoc $ annContNoSema (AST.UGeneratedPragma <$> (trfSourceRange source))
-trfExpr' t = unhandledElement "expression" t
-
-trfFieldInits :: TransformName n r => HsRecFields n (LHsExpr n) -> Trf (AnnListG AST.UFieldUpdate (Dom r) RangeStage)
-trfFieldInits (HsRecFields fields dotdot)
-  = do cont <- asks contRange
-       let (normalFlds, implicitFlds) = partition ((cont /=) . getLoc) fields
-       makeList ", " (before AnnCloseC)
-         $ ((++) <$> mapM trfFieldInit normalFlds
-                  <*> (if isJust dotdot then (:[]) <$> annLocNoSema (tokenLoc AnnDotdot)
-                                                                    (AST.UFieldWildcard <$> (annCont (createImplicitFldInfo (unLoc . (\(HsVar n) -> n) . unLoc) (map unLoc implicitFlds)) (pure AST.FldWildcard)))
-                                        else pure []))
-
-trfFieldInit :: TransformName n r => Located (HsRecField n (LHsExpr n)) -> Trf (Ann AST.UFieldUpdate (Dom r) RangeStage)
-trfFieldInit = trfLocNoSema $ \case
-  HsRecField id _ True -> AST.UFieldPun <$> trfName (getFieldOccName id)
-  HsRecField id val False -> AST.UNormalFieldUpdate <$> trfName (getFieldOccName id) <*> trfExpr val
-
-trfFieldUpdate :: TransformName n r => HsRecField' (AmbiguousFieldOcc n) (LHsExpr n) -> Trf (AST.UFieldUpdate (Dom r) RangeStage)
-trfFieldUpdate (HsRecField id _ True) = AST.UFieldPun <$> trfAmbiguousFieldName id
-trfFieldUpdate (HsRecField id val False) = AST.UNormalFieldUpdate <$> trfAmbiguousFieldName id <*> trfExpr val
-
-trfAlt :: TransformName n r => Located (Match n (LHsExpr n)) -> Trf (Ann AST.UAlt (Dom r) RangeStage)
-trfAlt = trfLocNoSema trfAlt'
-
-trfAlt' :: TransformName n r => Match n (LHsExpr n) -> Trf (AST.UAlt (Dom r) RangeStage)
-trfAlt' = gTrfAlt' trfExpr
-
-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 (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)
-trfCaseRhss = gTrfCaseRhss trfExpr
-
-gTrfCaseRhss :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> [Located (GRHS n (Located (ge n)))] -> Trf (Ann (AST.UCaseRhs' ae) (Dom r) RangeStage)
-gTrfCaseRhss te [unLoc -> GRHS [] body] = annLocNoSema (combineSrcSpans (getLoc body) <$> updateFocus (pure . updateEnd (const $ srcSpanStart $ getLoc body))
-                                                                                                      (tokenLocBack AnnRarrow))
-                                                 (AST.UUnguardedCaseRhs <$> te body)
-gTrfCaseRhss te rhss = annLocNoSema (pure $ collectLocs rhss)
-                              (AST.UGuardedCaseRhss <$> trfAnnList ";" (gTrfGuardedCaseRhs' te) rhss)
-
-trfGuardedCaseRhs :: TransformName n r => Located (GRHS n (LHsExpr n)) -> Trf (Ann AST.UGuardedCaseRhs (Dom r) RangeStage)
-trfGuardedCaseRhs = trfLocNoSema trfGuardedCaseRhs'
-
-trfGuardedCaseRhs' :: TransformName n r => GRHS n (LHsExpr n) -> Trf (AST.UGuardedCaseRhs (Dom r) RangeStage)
-trfGuardedCaseRhs' = gTrfGuardedCaseRhs' trfExpr
-
-gTrfGuardedCaseRhs' :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> GRHS n (Located (ge n)) -> Trf (AST.UGuardedCaseRhs' ae (Dom r) RangeStage)
-gTrfGuardedCaseRhs' te (GRHS guards body) = AST.UGuardedCaseRhs <$> trfAnnList " " trfRhsGuard' guards <*> te body
-
-trfCmdTop :: TransformName n r => Located (HsCmdTop n) -> Trf (Ann AST.UCmd (Dom r) RangeStage)
-trfCmdTop (L _ (HsCmdTop cmd _ _ _)) = trfCmd cmd
-
-trfCmd :: TransformName n r => Located (HsCmd n) -> Trf (Ann AST.UCmd (Dom r) RangeStage)
-trfCmd = trfLocNoSema trfCmd'
-
-trfCmd' :: TransformName n r => HsCmd n -> Trf (AST.UCmd (Dom r) RangeStage)
-trfCmd' (HsCmdArrApp left right _ typ dir) = AST.UArrowAppCmd <$> trfExpr left <*> op <*> trfExpr right
-  where op = case (typ, dir) of (HsFirstOrderApp, False) -> annLocNoSema (tokenLoc Annrarrowtail) (pure AST.URightAppl)
-                                (HsFirstOrderApp, True) -> annLocNoSema (tokenLoc Annlarrowtail) (pure AST.ULeftAppl)
-                                (HsHigherOrderApp, False) -> annLocNoSema (tokenLoc AnnRarrowtail) (pure AST.URightHighApp)
-                                (HsHigherOrderApp, True) -> annLocNoSema (tokenLoc AnnLarrowtail) (pure AST.ULeftHighApp)
-                                                                       -- FIXME: needs a before
-trfCmd' (HsCmdArrForm expr _ cmds) = AST.UArrowFormCmd <$> trfExpr expr <*> makeList " " (before AnnClose) (mapM trfCmdTop cmds)
-trfCmd' (HsCmdApp cmd expr) = AST.UAppCmd <$> trfCmd cmd <*> trfExpr expr
-trfCmd' (HsCmdLam (MG (unLoc -> [unLoc -> Match _ pats _ (GRHSs [unLoc -> GRHS [] body] _)]) _ _ _))
-  = AST.ULambdaCmd <$> (makeNonemptyList " " $ mapM trfPattern pats) <*> trfCmd body
-trfCmd' (HsCmdPar cmd) = AST.UParenCmd <$> trfCmd cmd
-trfCmd' (HsCmdCase expr (MG (unLoc -> alts) _ _ _))
-  = AST.UCaseCmd <$> trfExpr expr <*> makeNonemptyIndentedList (mapM (trfLocNoSema (gTrfAlt' trfCmd)) alts)
-trfCmd' (HsCmdIf _ pred thenExpr elseExpr) = AST.UIfCmd <$> trfExpr pred <*> trfCmd thenExpr <*> trfCmd elseExpr
-trfCmd' (HsCmdLet (unLoc -> binds) cmd) = addToScope binds (AST.ULetCmd <$> trfLocalBinds AnnLet binds <*> trfCmd cmd)
-trfCmd' (HsCmdDo (unLoc -> stmts) _) = AST.UDoCmd <$> makeNonemptyIndentedList (mapM (trfLocNoSema (gTrfDoStmt' trfCmd)) stmts)
--- | TODO: implement
-trfCmd' (HsCmdLam {}) = error "trfCmd': cmd lambda not supported yet"
-trfCmd' (HsCmdWrap {}) = error "trfCmd': cmd wrap not supported yet"
-
-trfText' :: StringLiteral -> Trf (AST.UStringNode (Dom r) RangeStage)
-trfText' = pure . AST.UStringNode . unpackFS . sl_fs
-
-trfSourceRange :: (StringLiteral, (Int, Int), (Int, Int)) -> Trf (Ann AST.USourceRange (Dom r) RangeStage)
-trfSourceRange (fileName, (startRow, startCol), (endRow, endCol))
-  = do fnLoc <- tokenLoc AnnValStr
-       [srLoc, scLoc, erLoc, ecLoc] <- allTokenLoc AnnVal
-       annLocNoSema (pure (fnLoc `combineSrcSpans` ecLoc))
-         (AST.USourceRange <$> annLocNoSema (pure fnLoc) (trfText' fileName)
-                           <*> annLocNoSema (pure srLoc) (pure $ AST.Number $ fromIntegral startRow)
-                           <*> annLocNoSema (pure scLoc) (pure $ AST.Number $ fromIntegral startCol)
-                           <*> annLocNoSema (pure erLoc) (pure $ AST.Number $ fromIntegral endRow)
-                           <*> annLocNoSema (pure ecLoc) (pure $ AST.Number $ fromIntegral endCol))

@@ -1,12 +0,0 @@-module Language.Haskell.Tools.AST.FromGHC.Exprs where
-
-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.Names (TransformName(..))
-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)
-trfCmd' :: TransformName n r => HsCmd n -> Trf (AST.UCmd (Dom r) RangeStage)

@@ -1,259 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses
-           , TypeSynonymInstances
-           , FlexibleInstances
-           , ScopedTypeVariables
-           , ViewPatterns
-           , LambdaCase
-           , RecordWildCards
-           #-}
--- | Utility functions defined on the GHC AST representation.
-module Language.Haskell.Tools.AST.FromGHC.GHCUtils where
-
-import Data.Generics.Uniplate.Data ()
-import Data.List
-
-import Bag (Bag, bagToList, unionManyBags)
-import ConLike (ConLike(..))
-import GHC
-import Id (Id, mkVanillaGlobal)
-import OccName (OccName)
-import Outputable (Outputable(..), OutputableBndr(..), showSDocUnsafe)
-import PatSyn (patSynSig)
-import RdrName (RdrName, rdrNameOcc, nameRdrName)
-import SrcLoc
-import Type (TyThing(..), mkFunTys)
-
-class OutputableBndr name => GHCName name where
-  rdrName :: name -> RdrName
-  getFromNameUsing :: Applicative f => (Name -> Ghc (f Id)) -> Name -> Ghc (f name)
-  getBindsAndSigs :: HsValBinds name -> ([LSig name], LHsBinds name)
-  nameFromId :: Id -> name
-  unpackPostRn :: RdrName -> PostRn name name -> name
-
-  gunpackPostRn :: a -> (name -> a) -> PostRn name name -> a
-
-instance GHCName RdrName where
-  rdrName = id
-  getFromNameUsing _ n = return $ pure (nameRdrName n)
-  getBindsAndSigs (ValBindsIn binds sigs) = (sigs, binds)
-  getBindsAndSigs _ = error "ValBindsOut: ValBindsOut in parsed source"
-  nameFromId = nameRdrName . getName
-  unpackPostRn rdr _ = rdr
-
-  gunpackPostRn a _ _ = a
-
-occName :: GHCName n => n -> OccName
-occName = rdrNameOcc . rdrName
-
-instance GHCName GHC.Name where
-  rdrName = nameRdrName
-  getFromNameUsing f n = fmap nameFromId <$> f n
-  getBindsAndSigs (ValBindsOut bindGroups sigs) = (sigs, unionManyBags (map snd bindGroups))
-  getBindsAndSigs _ = error "getBindsAndSigs: ValBindsIn in renamed source"
-  nameFromId = getName
-  unpackPostRn _ a = a
-
-  gunpackPostRn _ f pr = f pr
-
-getFieldOccName :: GHCName n => Located (FieldOcc n) -> Located n
-getFieldOccName (L l (FieldOcc (L _ rdr) postRn)) = L l (unpackPostRn rdr postRn)
-
-getFieldOccName' :: GHCName n => FieldOcc n -> n
-getFieldOccName' (FieldOcc (L _ rdr) postRn) = unpackPostRn rdr postRn
-
-
-
--- | Loading ids for top-level ghc names
-getTopLevelId :: GHC.Name -> Ghc (Maybe GHC.Id)
-getTopLevelId name =
-    lookupName name >>= \case
-      Just (AnId id) -> return (Just id)
-      Just (AConLike (RealDataCon dc)) -> return $ Just $ mkVanillaGlobal name (dataConUserType dc)
-      Just (AConLike (PatSynCon ps)) -> return $ Just $ mkVanillaGlobal name (createPatSynType ps)
-      Just (ATyCon tc) -> return $ Just $ mkVanillaGlobal name (tyConKind tc)
-      _ -> return Nothing
-  where createPatSynType patSyn = case patSynSig patSyn of (_, _, _, _, args, res) -> mkFunTys args res
-
--- | Get names from the GHC AST
-class HsHasName a where
-  hsGetNames :: a -> [GHC.Name]
-
-instance HsHasName RdrName where
-  hsGetNames _ = []
-
-instance HsHasName Name where
-  hsGetNames n = [n]
-
-instance HsHasName Id where
-  hsGetNames n = [getName n]
-
-instance HsHasName e => HsHasName [e] where
-  hsGetNames es = concatMap hsGetNames es
-
-instance HsHasName e => HsHasName (Located e) where
-  hsGetNames (L _ e) = hsGetNames e
-
-instance HsHasName n => HsHasName (HsLocalBinds n) where
-  hsGetNames (HsValBinds bnds) = hsGetNames bnds
-  hsGetNames _ = []
-
-instance (GHCName n, HsHasName n) => HsHasName (HsDecl n) where
-  hsGetNames (TyClD tycl) = hsGetNames tycl
-  hsGetNames (ValD vald) = hsGetNames vald
-  hsGetNames (ForD ford) = hsGetNames ford
-  hsGetNames (InstD inst) = hsGetNames inst
-  hsGetNames _ = []
-
-instance (GHCName n, HsHasName n) => HsHasName (InstDecl n) where
-  hsGetNames (ClsInstD clsInst) = hsGetNames (cid_datafam_insts clsInst)
-  hsGetNames (DataFamInstD dataFamInst) = hsGetNames dataFamInst
-  hsGetNames _ = []
-
-instance (GHCName n, HsHasName n) => HsHasName (DataFamInstDecl n) where
-  hsGetNames dfid = hsGetNames (dfid_defn dfid)
-
-instance (GHCName n, HsHasName n) => HsHasName (TyClGroup n) where
-  hsGetNames (TyClGroup tycls _) = hsGetNames tycls
-
-instance (GHCName n, HsHasName n) => HsHasName (TyClDecl n) where
-  hsGetNames (FamDecl (FamilyDecl {fdLName = name})) = hsGetNames name
-  hsGetNames (SynDecl {tcdLName = name}) = hsGetNames name
-  hsGetNames (DataDecl {tcdLName = name, tcdDataDefn = datadef}) = hsGetNames name ++ hsGetNames datadef
-  hsGetNames (ClassDecl {tcdLName = name, tcdSigs = sigs}) = hsGetNames name ++ hsGetNames sigs
-
-instance (GHCName n, HsHasName n) => HsHasName (HsDataDefn n) where
-  hsGetNames (HsDataDefn {dd_cons = ctors}) = hsGetNames ctors
-
-instance (GHCName n, HsHasName n) => HsHasName (ConDecl n) where
-  hsGetNames (ConDeclGADT {con_names = names, con_type = (HsIB _ (L _ (HsRecTy flds)))})
-    = hsGetNames names ++ hsGetNames flds
-  hsGetNames (ConDeclGADT {con_names = names}) = hsGetNames names
-  hsGetNames (ConDeclH98 {con_name = name, con_details = details}) = hsGetNames name ++ hsGetNames details
-
-instance (GHCName n, HsHasName n) => HsHasName (HsConDeclDetails n) where
-  hsGetNames (RecCon rec) = hsGetNames rec
-  hsGetNames _ = []
-
-instance (GHCName n, HsHasName n) => HsHasName (ConDeclField n) where
-  hsGetNames (ConDeclField name _ _) = hsGetNames name
-
-instance (GHCName n, HsHasName n) => HsHasName (FieldOcc n) where
-  hsGetNames (FieldOcc _ pr) = gunpackPostRn [] (hsGetNames :: n -> [Name]) pr
-
-instance (HsHasName n) => HsHasName (Sig n) where
-  hsGetNames (TypeSig n _) = hsGetNames n
-  hsGetNames (PatSynSig n _) = hsGetNames n
-  hsGetNames _ = []
-
-instance HsHasName n => HsHasName (ForeignDecl n) where
-  hsGetNames (ForeignImport n _ _ _) = hsGetNames n
-  hsGetNames _ = []
-
-instance HsHasName n => HsHasName (HsValBinds n) where
-  hsGetNames (ValBindsIn bnds _) = hsGetNames bnds
-  hsGetNames (ValBindsOut bnds _) = hsGetNames $ map snd bnds
-
-instance HsHasName n => HsHasName (Bag n) where
-  hsGetNames = hsGetNames . bagToList
-
-instance HsHasName n => HsHasName (HsBind n) where
-  hsGetNames (FunBind {fun_id = lname}) = hsGetNames lname
-  hsGetNames (PatBind {pat_lhs = pat}) = hsGetNames pat
-  hsGetNames (VarBind {var_id = id}) = hsGetNames id
-  hsGetNames (PatSynBind (PSB {psb_id = id})) = hsGetNames id
-  hsGetNames _ = error "hsGetNames: called on compiler-generated binding"
-
-instance HsHasName n => HsHasName (ParStmtBlock l n) where
-  hsGetNames (ParStmtBlock _ binds _) = hsGetNames binds
-
---instance HsHasName n => HsHasName (LHsTyVarBndrs n) where
---  hsGetNames (HsQTvs kvs tvs) = hsGetNames kvs ++ hsGetNames tvs
-
-instance HsHasName n => HsHasName (HsTyVarBndr n) where
-  hsGetNames (UserTyVar n) = hsGetNames n
-  hsGetNames (KindedTyVar n _) = hsGetNames n
-
-instance HsHasName n => HsHasName (Stmt n b) where
-  hsGetNames (LetStmt binds) = hsGetNames binds
-  hsGetNames (BindStmt pat _ _ _ _) = hsGetNames pat
-  hsGetNames (RecStmt {recS_rec_ids = ids}) = hsGetNames ids
-  hsGetNames _ = []
-
-instance HsHasName n => HsHasName (Pat n) where
-  hsGetNames (VarPat id) = hsGetNames id
-  hsGetNames (LazyPat p) = hsGetNames p
-  hsGetNames (AsPat lname p) = hsGetNames lname ++ hsGetNames p
-  hsGetNames (ParPat p) = hsGetNames p
-  hsGetNames (BangPat p) = hsGetNames p
-  hsGetNames (ListPat pats _ _) = concatMap hsGetNames pats
-  hsGetNames (TuplePat pats _ _) = concatMap hsGetNames pats
-  hsGetNames (PArrPat pats _) = concatMap hsGetNames pats
-  hsGetNames (ConPatIn _ details) = concatMap hsGetNames (hsConPatArgs details)
-  hsGetNames (ConPatOut {pat_args = details}) = concatMap hsGetNames (hsConPatArgs details)
-  hsGetNames (ViewPat _ p _) = hsGetNames p
-  hsGetNames (NPlusKPat lname _ _ _ _ _) = hsGetNames lname
-  hsGetNames (SigPatIn p _) = hsGetNames p
-  hsGetNames (SigPatOut p _) = hsGetNames p
-  hsGetNames _ = []
-
-instance (GHCName n, HsHasName n) => HsHasName (HsGroup n) where
-  hsGetNames (HsGroup vals _ clds insts _ _ _ foreigns _ _ _ _ _) = hsGetNames vals ++ hsGetNames clds ++ hsGetNames insts ++ hsGetNames foreigns
-
--- | Get the original form of a name
-rdrNameStr :: RdrName -> String
-rdrNameStr name = showSDocUnsafe $ ppr name
-
-
-class FromGHCName n where
-  fromGHCName :: GHC.Name -> n
-
-instance FromGHCName RdrName where
-  fromGHCName = rdrName
-
-instance FromGHCName GHC.Name where
-  fromGHCName = id
-
--- | Tries to simplify the type that has HsAppsTy before renaming. Does not always provide the correct form.
--- Treats each operator as if they are of equivalent precedence and always left-associative.
-cleanHsType :: forall n . (OutputableBndr n) => HsType n -> HsType n
--- for some reason * is considered infix
-cleanHsType (HsAppsTy apps) = unLoc $ guessType apps
-  where guessType :: OutputableBndr n => [LHsAppType n] -> LHsType n
-        guessType (L l (HsAppInfix n) : rest) -- must be a prefix actually
-          = guessType' (L l (HsTyVar n)) rest
-        guessType (L _ (HsAppPrefix t) : rest) = guessType' t rest
-        guessType [] = error $ "guessType: empty: " ++ showSDocUnsafe (ppr apps)
-
-        guessType' :: LHsType n -> [LHsAppType n] -> LHsType n
-        guessType' fun (L l (HsAppPrefix t) : rest) = guessType' (hsAppTy fun t) rest
-        guessType' fun (L l (HsAppInfix n) : rest)
-          -- TODO: find a better check
-          | showSDocUnsafe (ppr n) == "*" = guessType' (hsAppTy fun (L l (HsTyVar n))) rest
-        guessType' left (L l (HsAppInfix n) : right) = hsOpTy left n (guessType right)
-        guessType' t [] = t
-
-        hsAppTy :: LHsType n -> LHsType n -> LHsType n
-        hsAppTy t1 t2 = L (getLoc t1 `combineSrcSpans` getLoc t2) $ HsAppTy t1 t2
-
-        hsOpTy :: LHsType n -> Located n -> LHsType n -> LHsType n
-        hsOpTy t1 n t2 = L (getLoc t1 `combineSrcSpans` getLoc t2) $ HsOpTy t1 n t2
-cleanHsType t = t
-
-mergeFixityDefs :: [Located (FixitySig n)] -> [Located (FixitySig n)]
-mergeFixityDefs (s@(L l _) : rest)
-  = let (same, different) = partition ((== l) . getLoc) rest
-     in foldl mergeWith s (map unLoc same) : mergeFixityDefs different
-  where mergeWith (L l (FixitySig names fixity)) (FixitySig otherNames _) = L l (FixitySig (names ++ otherNames) fixity)
-mergeFixityDefs [] = []
-
-getGroupRange :: HsGroup n -> SrcSpan
-getGroupRange (HsGroup {..})
-  = foldr combineSrcSpans noSrcSpan locs
-  where locs = [getHsValRange hs_valds] ++ map getLoc hs_splcds ++ map getLoc (concatMap group_tyclds hs_tyclds) ++ map getLoc (concatMap group_roles hs_tyclds)
-                 ++ map getLoc hs_instds ++ map getLoc hs_derivds ++ map getLoc hs_fixds ++ map getLoc hs_defds
-                 ++ map getLoc hs_fords ++ map getLoc hs_warnds ++ map getLoc hs_annds ++ map getLoc hs_ruleds ++ map getLoc hs_vects
-                 ++ map getLoc hs_docs
-
-getHsValRange :: HsValBinds n -> SrcSpan
-getHsValRange (ValBindsIn vals sig) = foldr combineSrcSpans noSrcSpan $ map getLoc (bagToList vals) ++ map getLoc sig
-getHsValRange (ValBindsOut vals sig) = foldr combineSrcSpans noSrcSpan $ concatMap (map getLoc . bagToList . snd) vals ++ map getLoc sig

@@ -1,63 +0,0 @@-{-# LANGUAGE ViewPatterns
-           , TypeFamilies
-           #-}
--- | Functions that convert the kind-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Kinds where
-
-import ApiAnnotation as GHC (AnnKeywordId(..))
-import FastString as GHC (unpackFS)
-import HsTypes as GHC
-import Name as GHC (occNameString, nameOccName, isWiredInName)
-import OccName as GHC (occNameString)
-import RdrName as GHC (RdrName(..))
-import SrcLoc as GHC
-
-import Control.Monad.Reader (Monad(..))
-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.Names (TransformName, trfOperator, trfName)
-import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.Types (trfType')
-import Language.Haskell.Tools.AST.FromGHC.Utils
-
-
-trfKindSig :: TransformName n r => Maybe (LHsKind n) -> Trf (AnnMaybeG AST.UKindConstraint (Dom r) RangeStage)
-trfKindSig = trfMaybe "" "" trfKindSig'
-
-trfKindSig' :: TransformName n r => Located (HsKind n) -> Trf (Ann AST.UKindConstraint (Dom r) RangeStage)
-trfKindSig' k = annLocNoSema (combineSrcSpans (getLoc k) <$> (tokenBefore (srcSpanStart (getLoc k)) AnnDcolon))
-                             (AST.UKindConstraint <$> trfLocNoSema trfKind' k)
-
-trfKind :: TransformName n r => Located (HsKind n) -> Trf (Ann AST.UKind (Dom r) RangeStage)
-trfKind = trfLocNoSema (trfKind' . cleanHsType)
-
-trfKind' ::TransformName n r => HsKind n -> Trf (AST.UKind (Dom r) RangeStage)
-trfKind' = trfKind'' . cleanHsType where
-  trfKind'' (HsTyVar (rdrName . unLoc -> Exact n))
-    | isWiredInName n && occNameString (nameOccName n) == "*"
-    = pure AST.UStarKind
-    | isWiredInName n && occNameString (nameOccName n) == "#"
-    = pure AST.UUnboxKind
-  trfKind'' (HsParTy kind) = AST.UParenKind <$> trfKind kind
-  trfKind'' (HsFunTy k1 k2) = AST.UFunKind <$> trfKind k1 <*> trfKind k2
-  trfKind'' (HsAppTy k1 k2) = AST.UAppKind <$> trfKind k1 <*> trfKind k2
-  trfKind'' (HsOpTy k1 op k2) = AST.UInfixAppKind <$> trfKind k1 <*> trfOperator op <*> trfKind k2
-  trfKind'' (HsTyVar kv) = transformingPossibleVar kv (AST.UVarKind <$> trfName kv)
-  trfKind'' (HsListTy kind) = AST.UListKind <$> trfKind kind
-  trfKind'' (HsTupleTy _ kinds) = AST.UTupleKind <$> makeList ", " atTheStart (mapM trfKind kinds)
-  trfKind'' (HsAppsTy [unLoc -> HsAppPrefix t]) = trfKind' (unLoc t)
-  trfKind'' (HsAppsTy [unLoc -> HsAppInfix n]) = AST.UVarKind <$> trfName n
-  trfKind'' pt@(HsExplicitListTy {}) = AST.UPromotedKind <$> annContNoSema (trfPromoted' trfKind' pt)
-  trfKind'' pt@(HsExplicitTupleTy {}) = AST.UPromotedKind <$> annContNoSema (trfPromoted' trfKind' pt)
-  trfKind'' pt@(HsTyLit {}) = AST.UPromotedKind <$> annContNoSema (trfPromoted' trfKind' pt)
-  trfKind'' t = AST.UTypeKind <$> annContNoSema (trfType' t)
-
-trfPromoted' :: (TransformName n r, HasNoSemanticInfo (Dom r) a)
-                  => (HsType n -> Trf (a (Dom r) RangeStage)) -> HsType n -> Trf (AST.UPromoted a (Dom r) RangeStage)
-trfPromoted' _ (HsTyLit (HsNumTy _ int)) = pure $ AST.UPromotedInt int
-trfPromoted' _ (HsTyLit (HsStrTy _ str)) = pure $ AST.UPromotedString (unpackFS str)
-trfPromoted' _ (HsTyVar name) = AST.UPromotedCon <$> trfName name
-trfPromoted' f (HsExplicitListTy _ elems) = AST.UPromotedList <$> between AnnOpenS AnnCloseS (trfAnnList ", " f elems)
-trfPromoted' f (HsExplicitTupleTy _ elems) = AST.UPromotedTuple <$> between AnnOpenP AnnCloseP (trfAnnList ", " f elems)
-trfPromoted' _ t = unhandledElement "promoted type/kind" t

@@ -1,32 +0,0 @@--- | Functions that convert the literals of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Literals where
-
-import qualified Data.ByteString.Char8 as BS (foldr)
-
-import BasicTypes as GHC (FractionalLit(..))
-import FastString as GHC (unpackFS)
-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)
-
-trfLiteral' :: HsLit -> Trf (AST.ULiteral (Dom r) RangeStage)
-trfLiteral' (HsChar _ ch) = pure $ AST.UCharLit ch
-trfLiteral' (HsCharPrim _ ch) = pure $ AST.UPrimCharLit ch
-trfLiteral' (HsString _ str) = pure $ AST.UStringLit (unpackFS str)
-trfLiteral' (HsStringPrim _ str) = pure $ AST.UPrimStringLit (BS.foldr (:) "" str)
-trfLiteral' (HsInt _ i) = pure $ AST.UIntLit i
-trfLiteral' (HsIntPrim _ i) = pure $ AST.UPrimIntLit i
-trfLiteral' (HsWordPrim _ i) = pure $ AST.UPrimWordLit i
-trfLiteral' (HsInt64Prim _ i) = pure $ AST.UPrimIntLit i
-trfLiteral' (HsWord64Prim _ i) = pure $ AST.UPrimWordLit i
-trfLiteral' (HsInteger _ i _) = pure $ AST.UPrimIntLit i
-trfLiteral' (HsRat frac _) = pure $ AST.UFracLit (fl_value frac)
-trfLiteral' (HsFloatPrim frac) = pure $ AST.UPrimFloatLit (fl_value frac)
-trfLiteral' (HsDoublePrim frac) = pure $ AST.UPrimDoubleLit (fl_value frac)
-  
-trfOverloadedLit :: OverLitVal -> Trf (AST.ULiteral (Dom r) RangeStage)
-trfOverloadedLit (HsIntegral _ i) = pure $ AST.UIntLit i
-trfOverloadedLit (HsFractional frac) = pure $ AST.UFracLit (fl_value frac)
-trfOverloadedLit (HsIsString _ str) = pure $ AST.UStringLit (unpackFS str)

@@ -1,210 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ViewPatterns
-           , FlexibleContexts
-           , ScopedTypeVariables
-           , TypeApplications
-           , TupleSections
-           , TypeFamilies
-           #-}
--- | Functions that convert the module-related elements (modules, imports, exports) of the GHC AST to corresponding elements in the Haskell-tools AST representation
--- Also contains the entry point of the transformation that collects the information from different GHC AST representations.
-module Language.Haskell.Tools.AST.FromGHC.Modules where
-
-import Control.Monad.Reader
-import Control.Reference hiding (element)
-import Data.Function (on)
-import Data.Generics.Uniplate.Data ()
-import Data.List as List
-import Data.Map as Map (fromList, lookup)
-import Data.Maybe
-
-import BasicTypes as GHC (WarningTxt(..), StringLiteral(..))
-import DynFlags as GHC (xopt_set)
-import ErrUtils as GHC (pprErrMsgBagWithLoc)
-import FastString as GHC (unpackFS)
-import FieldLabel as GHC (FieldLbl(..))
-import GHC
-import HscMain as GHC (hscRnImportDecls)
-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, (<+>))
-import RdrName as GHC (RdrName, Parent(..), GlobalRdrElt(..))
-import RnEnv as GHC (mkUnboundNameRdr)
-import RnExpr as GHC (rnLExpr)
-import SrcLoc as GHC
-import TcRnMonad as GHC
-import Outputable
-
-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)
-import Language.Haskell.Tools.AST.FromGHC.Exprs (trfText')
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils
-import Language.Haskell.Tools.AST.FromGHC.Monad
-import Language.Haskell.Tools.AST.FromGHC.Names (TransformName, trfName)
-import Language.Haskell.Tools.AST.FromGHC.Utils
-import Language.Haskell.Tools.AST.SemaInfoTypes as AST (nameInfo, implicitNames, importedNames)
-
-trfModule :: ModSummary -> Located (HsModule RdrName) -> Trf (Ann AST.UModule (Dom RdrName) RangeStage)
-trfModule mod hsMod = trfLocCorrect (createModuleInfo mod (maybe noSrcSpan getLoc $ hsmodName $ unLoc hsMod) (hsmodImports $ unLoc hsMod))
-                                    (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos))
-                  (\(HsModule name exports imports decls deprec _) ->
-                     AST.UModule <$> trfFilePragmas
-                                 <*> trfModuleHead name (srcSpanStart (foldLocs (map getLoc imports ++ map getLoc decls))) exports deprec
-                                 <*> trfImports imports
-                                 <*> trfDecls decls) $ hsMod
-
-trfModuleRename :: ModSummary -> Ann AST.UModule (Dom RdrName) RangeStage
-                              -> (HsGroup Name, [LImportDecl Name], Maybe [LIE Name], Maybe LHsDocString)
-                              -> Located (HsModule RdrName)
-                              -> Trf (Ann AST.UModule (Dom GHC.Name) RangeStage)
-trfModuleRename mod rangeMod (gr,imports,exps,_) hsMod
-    = do info <- createModuleInfo mod (maybe noSrcSpan getLoc $ hsmodName $ unLoc hsMod) imports
-         trfLocCorrect (pure info) (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) (trfModuleRename' (info ^. implicitNames)) hsMod
-  where roleAnnots = rangeMod ^? AST.modDecl&AST.annList&filtered ((\case Ann _ (AST.URoleDecl {}) -> True; _ -> False))
-        originalNames = Map.fromList $ catMaybes $ map getSourceAndInfo (rangeMod ^? biplateRef)
-        getSourceAndInfo :: Ann AST.UQualifiedName (Dom RdrName) RangeStage -> Maybe (SrcSpan, RdrName)
-        getSourceAndInfo n = (,) <$> (n ^? annotation&sourceInfo&nodeSpan) <*> (n ^? semantics&nameInfo)
-
-        trfModuleRename' preludeImports hsMod@(HsModule name exports _ _ deprec _) = do
-          transformedImports <- orderAnnList <$> (trfImports imports)
-
-          let importNames impd = ( impd ^. AST.importModule & AST.moduleNameString
-                                 , impd ^? AST.importAs & AST.annJust & AST.importRename & AST.moduleNameString
-                                 , AST.isAnnJust (impd ^. AST.importQualified)
-                                 , impd ^. semantics&importedNames )
-              -- if there is a qualified form of the import Prelude, the names should be empty
-              importPrelude names = ( "Prelude", Nothing, False, names)
-
-          addToScopeImported (map importNames (transformedImports ^? AST.annList) ++ [importPrelude preludeImports])
-            $ loadSplices mod hsMod transformedImports preludeImports gr $ setOriginalNames originalNames . setDeclsToInsert roleAnnots
-              $ do filePrags <- trfFilePragmas
-                   AST.UModule filePrags
-                    <$> trfModuleHead name
-                         (srcSpanEnd (AST.getRange filePrags))
-                         (case (exports, exps) of (Just (L l _), Just ie) -> Just (L l ie)
-                                                  _                       -> Nothing)
-                         deprec
-                    <*> return transformedImports
-                    <*> trfDeclsGroup gr
-
-loadSplices :: ModSummary -> HsModule RdrName -> AnnListG AST.UImportDecl (Dom GHC.Name) RangeStage -> [GHC.Name] -> HsGroup Name -> Trf a -> Trf a
-loadSplices modSum hsMod imports preludeImports group trf = do
-    let declSpls = map (\(SpliceDecl sp _) -> sp) $ hsMod ^? biplateRef :: [Located (HsSplice RdrName)]
-        exprSpls = catMaybes $ map (\case L l (HsSpliceE sp) -> Just (L l sp); _ -> Nothing) $ hsMod ^? biplateRef :: [Located (HsSplice RdrName)]
-        typeSpls = catMaybes $ map (\case L l (HsSpliceTy sp _) -> Just (L l sp); _ -> Nothing) $ hsMod ^? biplateRef :: [Located (HsSplice RdrName)]
-    setSplices declSpls typeSpls exprSpls trf
-
-trfModuleHead :: TransformName n r => Maybe (Located ModuleName) -> SrcLoc -> Maybe (Located [LIE n]) -> Maybe (Located WarningTxt) -> Trf (AnnMaybeG AST.UModuleHead (Dom r) RangeStage)
-trfModuleHead (Just mn) _ exports modPrag
-  = makeJust <$> (annLocNoSema (tokensLoc [AnnModule, AnnWhere])
-                               (AST.UModuleHead <$> trfModuleName mn
-                                                <*> trfModulePragma (srcSpanEnd $ getLoc mn) modPrag
-                                                <*> trfExportList (before AnnWhere) exports))
-trfModuleHead _ rng Nothing _ = nothing "" "" (pure rng)
-trfModuleHead Nothing _ (Just _) _ = error "trfModuleHead: no head but has exports"
-
-trfFilePragmas :: Trf (AnnListG AST.UFilePragma (Dom r) RangeStage)
-trfFilePragmas = do pragmas <- asks pragmaComms
-                    languagePragmas <- mapM trfLanguagePragma (fromMaybe [] $ (Map.lookup "LANGUAGE") pragmas)
-                    optionsPragmas <- mapM trfOptionsPragma (fromMaybe [] $ (Map.lookup "OPTIONS_GHC") pragmas)
-                    makeList "" atTheStart $ pure $ orderDefs $ languagePragmas ++ optionsPragmas
-
-trfLanguagePragma :: Located String -> Trf (Ann AST.UFilePragma (Dom r) RangeStage)
-trfLanguagePragma lstr@(L l _) = annLocNoSema (pure l) (AST.ULanguagePragma <$> makeList ", " (pure $ srcSpanStart $ getLoc $ last pragmaElems)
-                                                                                              (mapM (trfLocNoSema (pure . AST.ULanguageExtension)) extensions))
-  where pragmaElems = splitLocated lstr
-        extensions = filter ((\sp -> srcSpanStart sp /= srcSpanEnd sp) . getLoc)
-                       $ map (removeEnd . removeLang . removeStart) pragmaElems
-        removeStart pr@(L l txt) = if "{-#" `isPrefixOf` txt then L (updateStart (updateCol (+3)) l) (drop 3 txt) else pr
-        removeLang pr@(L l txt) = if "LANGUAGE" `isPrefixOf` txt then L (updateStart (updateCol (+8)) l) (drop 8 txt) else pr
-        removeEnd pr@(L l txt) = if "#-}" `isSuffixOf` txt then L (updateEnd (updateCol (subtract 3)) l) (reverse $ drop 3 $ reverse $ txt) else pr
-
-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 :: 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)
-
-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)))
-
-trfExport :: TransformName n r => LIE n -> Trf (Maybe (Ann AST.UExportSpec (Dom r) RangeStage))
-trfExport = trfMaybeLocNoSema $ \case
-  IEModuleContents n -> Just . AST.UModuleExport <$> (trfModuleName n)
-  other -> do trf <- trfIESpec' other
-              fmap AST.UDeclExport <$> (sequence $ fmap (annContNoSema . return) trf)
-
-trfImports :: TransformName n r => [LImportDecl n] -> Trf (AnnListG AST.UImportDecl (Dom r) RangeStage)
-trfImports (filter (not . ideclImplicit . unLoc) -> imps)
-  = AnnListG <$> importDefaultLoc <*> mapM trfImport imps
-  where importDefaultLoc = noSemaInfo . AST.ListPos (if List.null imps then "\n" else "") "" "\n" (Just []) . srcSpanEnd
-                             <$> (combineSrcSpans <$> asks (srcLocSpan . srcSpanStart . contRange)
-                                                  <*> (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 _ isQual _ declAs declHiding)) = focusOn l $
-  do range <- asks contRange
-     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 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
-       <*> maybe (nothing " " "" (pure $ srcSpanEnd (getLoc name))) (\mn -> makeJust <$> (trfRenaming mn)) declAs
-       <*> trfImportSpecs declHiding
-  where trfRenaming mn
-          = annLocNoSema (tokensLoc [AnnAs,AnnVal])
-                         (AST.UImportRenaming <$> (annLocNoSema (tokenLoc AnnVal)
-                                                  (trfModuleName' mn)))
-
-trfImportSpecs :: TransformName n r => Maybe (Bool, Located [LIE n]) -> Trf (AnnMaybeG AST.UImportSpec (Dom r) RangeStage)
-trfImportSpecs (Just (True, l))
-  = makeJust <$> trfLocNoSema (\specs -> AST.UImportSpecHiding <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec (removeDuplicates specs)))) l
-trfImportSpecs (Just (False, l))
-  = makeJust <$> trfLocNoSema (\specs -> AST.UImportSpecList <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec (removeDuplicates specs)))) l
-trfImportSpecs Nothing = nothing " " "" atTheEnd
-
-trfIESpec :: TransformName n r => LIE n -> Trf (Maybe (Ann AST.UIESpec (Dom r) RangeStage))
-trfIESpec = trfMaybeLocNoSema trfIESpec'
-
-trfIESpec' :: TransformName n r => IE n -> Trf (Maybe (AST.UIESpec (Dom r) RangeStage))
-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 <$> subspec))
-  where subspec = annLocNoSema (combineSrcSpans <$> tokenLocBack AnnOpenP <*> tokenLocBack AnnCloseP) (pure AST.USubSpecAll)
-trfIESpec' (IEThingWith n _ ls flds)
-  = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n <*> (makeJust <$> subspec))
-  where subspec = annLocNoSema (combineSrcSpans <$> tokenLocBack AnnOpenP <*> tokenLocBack AnnCloseP)
-                    $ AST.USubSpecList <$> between AnnOpenP AnnCloseP (orderAnnList <$> makeList ", " atTheStart ((++) <$> mapM trfName ls <*> mapM trfName (map (fmap flSelector) flds)))
-trfIESpec' _ = pure Nothing
-
-trfImportModifier :: Trf (AnnMaybeG AST.UImportModifier (Dom r) RangeStage)
-trfImportModifier = do
-  patLoc <- tokenLoc AnnPattern
-  if isGoodSrcSpan patLoc then makeJust <$> annLocNoSema (return patLoc) (return AST.UImportPattern)
-                          else nothing " " "" atTheStart
-
-trfModuleName :: Located ModuleName -> Trf (Ann AST.UModuleName (Dom r) RangeStage)
-trfModuleName = trfLocNoSema trfModuleName'
-
-trfModuleName' :: ModuleName -> Trf (AST.UModuleName (Dom r) RangeStage)
-trfModuleName' = pure . AST.UModuleName . moduleNameString

@@ -1,165 +0,0 @@-{-# LANGUAGE TupleSections #-}
--- | The transformation monad carries the necessary information that is passed top-down
--- during the conversion from GHC AST to our representation.
-module Language.Haskell.Tools.AST.FromGHC.Monad where
-
-import Control.Monad.Reader
-import Data.Function (on)
-import Data.List
-import Data.Maybe
-import Data.Monoid
-import Data.Map as Map (Map, lookup, empty)
-import Data.Maybe (fromMaybe)
-import qualified Data.Set as Set
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils (HsHasName(..), rdrNameStr)
-import Language.Haskell.Tools.AST.FromGHC.SourceMap (SourceMap, annotationsToSrcMap)
-
-import ApiAnnotation (ApiAnnKey)
-import GHC
-import Name (Name, isVarName, isTyVarName)
-import HscTypes
-import SrcLoc
-import TcRnTypes
-import OccName as GHC
-import RdrName
-import RnEnv
-import DynFlags
-import RnExpr
-import ErrUtils
-import Outputable hiding (empty)
-import TcRnMonad
-import GHC.LanguageExtensions.Type
-
--- | The transformation monad type
-type Trf = ReaderT TrfInput Ghc
-
--- | The (immutable) data for the transformation
-data TrfInput
-  = TrfInput { srcMap :: SourceMap -- ^ The lexical tokens of the source file
-             , pragmaComms :: Map String [Located String] -- ^ Pragma comments
-             , declsToInsert :: [Ann UDecl (Dom RdrName) RangeStage] -- ^ Declarations that are from the parsed AST
-             , contRange :: SrcSpan -- ^ The focus of the transformation
-             , localsInScope :: [[(GHC.Name, Maybe [UsageSpec])]] -- ^ Local names visible
-             , defining :: Bool -- ^ True, if names are defined in the transformed AST element.
-             , definingTypeVars :: Bool -- ^ True, if type variable names are defined in the transformed AST element.
-             , originalNames :: Map SrcSpan RdrName -- ^ Stores the original format of names.
-             , declSplices :: [Located (HsSplice GHC.RdrName)] -- ^ Location of the TH splices for extracting declarations from the renamed AST.
-                 -- ^ It is possible that multiple declarations stand in the place of the declaration splice or none at all.
-             , typeSplices :: [Located (HsSplice GHC.RdrName)] -- ^ Type splices
-             , exprSplices :: [Located (HsSplice GHC.RdrName)] -- ^ Expression splices
-             }
-
-trfInit :: Map ApiAnnKey [SrcSpan] -> Map String [Located String] -> TrfInput
-trfInit annots comments
-  = TrfInput { srcMap = annotationsToSrcMap annots
-             , pragmaComms = comments
-             , declsToInsert = []
-             , contRange = noSrcSpan
-             , localsInScope = []
-             , defining = False
-             , definingTypeVars = False
-             , originalNames = empty
-             , declSplices = []
-             , typeSplices = []
-             , exprSplices = []
-             }
-
-liftGhc :: Ghc a -> Trf a
-liftGhc = lift
-
--- | Perform the transformation taking names as defined.
-define :: Trf a -> Trf a
-define = local (\s -> s { defining = True })
-
--- | Perform the transformation taking type variable names as defined.
-defineTypeVars :: Trf a -> Trf a
-defineTypeVars = local (\s -> s { definingTypeVars = True })
-
--- | Transform as type variables
-typeVarTransform :: Trf a -> Trf a
-typeVarTransform = local (\s -> s { defining = defining s || definingTypeVars s })
-
--- | Transform a name as a type variable if it is one.
-transformingPossibleVar :: HsHasName n => n -> Trf a -> Trf a
-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.
-addToScopeImported :: [(String, Maybe String, Bool, [GHC.Name])] -> Trf a -> Trf a
-addToScopeImported ls = local (\s -> s { localsInScope = concatMap (\(mn, asName, q, e) -> map (, Just [UsageSpec q mn (fromMaybe mn asName)]) e) ls : localsInScope s })
-
-
--- | Perform the transformation putting the given definition in a new local scope.
-addToScope :: HsHasName e => e -> Trf a -> Trf a
-addToScope e = local (\s -> s { localsInScope = map (, Nothing) (hsGetNames e) : localsInScope s })
-
--- | Perform the transformation putting the given definitions in the current scope.
-addToCurrentScope :: HsHasName e => e -> Trf a -> Trf a
-addToCurrentScope e = local (\s -> s { localsInScope = case localsInScope s of lastScope:rest -> (map (, Nothing) (hsGetNames e) ++ lastScope):rest
-                                                                               []             -> [map (, Nothing) (hsGetNames e)] })
-
--- | Performs the transformation given the tokens of the source file
-runTrf :: Map ApiAnnKey [SrcSpan] -> Map String [Located String] -> Trf a -> Ghc a
-runTrf annots comments trf = runReaderT trf (trfInit annots comments)
-
-setOriginalNames :: Map SrcSpan RdrName -> Trf a -> Trf a
-setOriginalNames names = local (\s -> s { originalNames = names })
-
--- | Get the original format of a name (before scoping).
-getOriginalName :: RdrName -> Trf String
-getOriginalName n = do sp <- asks contRange
-                       asks (rdrNameStr . fromMaybe n . (Map.lookup sp) . originalNames)
-
--- | Set splices that must replace the elements that are generated into the AST representation.
-setSplices :: [Located (HsSplice GHC.RdrName)] -> [Located (HsSplice GHC.RdrName)] -> [Located (HsSplice GHC.RdrName)] -> Trf a -> Trf a
-setSplices declSpls typeSpls exprSpls
-  = local (\s -> s { typeSplices = typeSpls, exprSplices = exprSpls, declSplices = declSpls })
-
--- | Set the list of declarations that will be missing from AST
-setDeclsToInsert :: [Ann UDecl (Dom RdrName) RangeStage] -> Trf a -> Trf a
-setDeclsToInsert decls = local (\s -> s {declsToInsert = decls})
-
--- Remove the splice that has already been added
-exprSpliceInserted :: Located (HsSplice n) -> Trf a -> Trf a
-exprSpliceInserted spl = local (\s -> s { exprSplices = Prelude.filter (\sp -> getLoc sp /= getLoc spl) (exprSplices s) })
-
--- Remove the splice that has already been added
-typeSpliceInserted :: Located (HsSplice n) -> Trf a -> Trf a
-typeSpliceInserted spl = local (\s -> s { typeSplices = Prelude.filter (\sp -> getLoc sp /= getLoc spl) (typeSplices s) })
-
-rdrSplice :: HsSplice RdrName -> Trf (HsSplice GHC.Name)
-rdrSplice spl = do
-    env <- liftGhc getSession
-    locals <- unifyScopes [] <$> asks localsInScope
-    let createLocalGRE (n,imp) = [GRE n NoParent (isNothing imp) (maybe [] (map createGREImport) imp) ]
-        createGREImport (UsageSpec q useQ asQ) = ImpSpec (ImpDeclSpec (mkModuleName useQ) (mkModuleName asQ) q noSrcSpan) ImpAll
-    let readEnv = mkOccEnv $ map (foldl1 (\e1 e2 -> (fst e1, snd e1 ++ snd e2))) $ groupBy ((==) `on` fst) $ sortOn fst
-                   $ map (\n -> (GHC.occName (fst n), createLocalGRE n))
-                   $ map (foldl1 (\e1 e2 -> (fst e1, snd e1 `mappend` snd e2))) $ groupBy ((==) `on` fst) $ sortBy (compare `on` fst) locals
-    tcSpl <- liftIO $ runTcInteractive env { hsc_dflags = xopt_set (hsc_dflags env) TemplateHaskellQuotes }
-      $ updGblEnv (\gbl -> gbl { tcg_rdr_env = readEnv })
-      $ tcHsSplice' spl
-    let typecheckErrors = showSDocUnsafe (vcat (pprErrMsgBagWithLoc (fst (fst tcSpl)))
-                                            <+> vcat (pprErrMsgBagWithLoc (snd (fst tcSpl))))
-    when (not (null typecheckErrors)) $ liftIO $ putStrLn ("Typechecking of splice expressions: " ++ typecheckErrors)
-    return $ fromMaybe (error $ "Splice expression could not be typechecked.")
-                       (snd tcSpl)
-  where
-    tcHsSplice' (HsTypedSplice id e)
-      = HsTypedSplice (mkUnboundNameRdr id) <$> (fst <$> rnLExpr e)
-    tcHsSplice' (HsUntypedSplice id e)
-      = HsUntypedSplice (mkUnboundNameRdr id) <$> (fst <$> rnLExpr e)
-    tcHsSplice' (HsQuasiQuote id1 id2 sp fs)
-      = pure $ HsQuasiQuote (mkUnboundNameRdr id1) (mkUnboundNameRdr id2) sp fs
-
-
-    unifyScopes :: [GHC.Name] -> [[(GHC.Name, Maybe [UsageSpec])]] -> [(GHC.Name, Maybe [UsageSpec])]
-    unifyScopes _ [] = []
-    unifyScopes ex (sc:scs) = filteredSc ++ unifyScopes (ex ++ map fst filteredSc) scs
-      where filteredSc = filter ((\s -> isNothing $ find (\e -> occName e == occName s) ex) . fst) sc

@@ -1,149 +0,0 @@-{-# LANGUAGE LambdaCase
-           , TupleSections
-           , TypeFamilies
-           , FlexibleInstances
-           , FlexibleContexts
-           , TypeSynonymInstances
-           , ScopedTypeVariables
-           , MultiParamTypeClasses
-           , UndecidableInstances
-           , AllowAmbiguousTypes
-           , TypeApplications
-           #-}
--- | Functions that convert the basic elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Names where
-
-import Control.Monad.Reader ((=<<), asks)
-import Data.Char (isAlphaNum)
-import Data.List.Split (splitOn)
-
-import FastString as GHC (FastString, unpackFS)
-import HsSyn as GHC
-import Name as GHC (isSymOcc, occNameString)
-import qualified Name as GHC (Name)
-import RdrName as GHC (RdrName)
-import SrcLoc as GHC
-
-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
-import Language.Haskell.Tools.AST.FromGHC.Utils
-
-trfOperator :: TransformName n r => Located n -> Trf (Ann AST.UOperator (Dom r) RangeStage)
-trfOperator = trfLocNoSema trfOperator'
-
-trfOperator' :: TransformName n r => n -> Trf (AST.UOperator (Dom r) RangeStage)
-trfOperator' n
-  | isSymOcc (occName n) = AST.UNormalOp <$> trfQualifiedNameFocus True n
-  | otherwise = AST.UBacktickOp <$> trfQualifiedNameFocus True n
-
-trfName :: TransformName n r => Located n -> Trf (Ann AST.UName (Dom r) RangeStage)
-trfName = trfLocNoSema trfName'
-
-trfName' :: TransformName n r => n -> Trf (AST.UName (Dom r) RangeStage)
-trfName' n
-  | isSymOcc (occName n) = (if isSpecKind then AST.UNormalName else AST.UParenName) <$> trfQualifiedNameFocus isSpecKind n
-  | otherwise = AST.UNormalName <$> trfQualifiedNameFocus False n
-  where -- special names that are operators, but appear in name context
-    isSpecKind = occNameString (occName n) `elem` ["*", "#", "?", "??"]
-
-trfAmbiguousFieldName :: TransformName n r => Located (AmbiguousFieldOcc n) -> Trf (Ann AST.UName (Dom r) RangeStage)
-trfAmbiguousFieldName (L l af) = trfAmbiguousFieldName' l af
-
-trfAmbiguousFieldName' :: forall n r . TransformName n r => SrcSpan -> AmbiguousFieldOcc n -> Trf (Ann AST.UName (Dom r) RangeStage)
-trfAmbiguousFieldName' l (Unambiguous (L _ rdr) pr) = annLocNoSema (pure l) $ trfName' (unpackPostRn @n rdr pr)
--- no Id transformation is done, so we can basically ignore the postTC value
-trfAmbiguousFieldName' _ (Ambiguous (L l rdr) _)
-  = annLocNoSema (pure l)
-      $ (if (isSymOcc (occName rdr)) then AST.UParenName else AST.UNormalName)
-          <$> (annLoc (createAmbigousNameInfo rdr l) (pure l) $ AST.nameFromList <$> trfNameStr (isSymOcc (occName rdr)) (rdrNameStr rdr))
-
-trfAmbiguousOperator' :: forall n r . TransformName n r => SrcSpan -> AmbiguousFieldOcc n -> Trf (Ann AST.UOperator (Dom r) RangeStage)
-trfAmbiguousOperator' l (Unambiguous (L _ rdr) pr) = annLocNoSema (pure l) $ trfOperator' (unpackPostRn @n rdr pr)
--- no Id transformation is done, so we can basically ignore the postTC value
-trfAmbiguousFieldOperator' _ (Ambiguous (L l rdr) _)
-  = annLocNoSema (pure l)
-      $ (if (isSymOcc (occName rdr)) then AST.UNormalOp else AST.UBacktickOp)
-          <$> (annLoc (createAmbigousNameInfo rdr l) (pure l) $ AST.nameFromList <$> trfOperatorStr (not $ isSymOcc (occName rdr)) (rdrNameStr rdr))
-
-
-class (DataId n, Eq n, GHCName n, FromGHCName n) => TransformableName n where
-  correctNameString :: n -> Trf String
-  transformSplice :: HsSplice RdrName -> Trf (HsSplice n)
-
-instance TransformableName RdrName where
-  correctNameString = pure . rdrNameStr
-  transformSplice = pure
-
-instance TransformableName GHC.Name where
-  correctNameString n = getOriginalName (rdrName n)
-  transformSplice = rdrSplice
-
--- | This class allows us to use the same transformation code for multiple variants of the GHC AST.
--- GHC UName annotated with 'name' can be transformed to our representation with semantic annotations of 'res'.
-class (TransformableName name, HsHasName name, TransformableName res, HsHasName res, GHCName res)
-        => TransformName name res where
-  -- | Demote a given name
-  transformName :: name -> res
-
-instance {-# OVERLAPPABLE #-} (n ~ r, TransformableName n, HsHasName n) => TransformName n r where
-  transformName = id
-
-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 (isOperatorStr str) str))
-
-trfImplicitName :: HsIPName -> Trf (Ann AST.UName (Dom r) RangeStage)
-trfImplicitName (HsIPName fs)
-  = let nstr = unpackFS fs
-     in do rng <- asks contRange
-           let rng' = mkSrcSpan (updateCol (+1) (srcSpanStart rng)) (srcSpanEnd rng)
-           annContNoSema (AST.UImplicitName <$> annLoc (createImplicitNameInfo nstr) (pure rng')
-                                                  (AST.nameFromList <$> trfNameStr (isOperatorStr nstr) nstr))
-
-isOperatorStr :: String -> Bool
-isOperatorStr = any (not . isAlphaNum)
-
-trfQualifiedName :: TransformName n r => Bool -> Located n -> Trf (Ann AST.UQualifiedName (Dom r) RangeStage)
-trfQualifiedName isOperator (L l n) = focusOn l $ trfQualifiedNameFocus isOperator n
-
-trfQualifiedNameFocus :: TransformName n r => Bool -> n -> Trf (Ann AST.UQualifiedName (Dom r) RangeStage)
-trfQualifiedNameFocus isOperator n
-  = do rng <- asks contRange
-       let rng' = if isOperator == isSymOcc (occName n) then rng
-                    else mkSrcSpan (updateCol (+1) (srcSpanStart rng)) (updateCol (subtract 1) (srcSpanEnd rng))
-       annLoc (createNameInfo (transformName n)) (pure rng') (trfQualifiedName' n)
-
-trfQualifiedName' :: TransformName n r => n -> Trf (AST.UQualifiedName (Dom r) RangeStage)
-trfQualifiedName' n = AST.nameFromList <$> ((if isSymOcc (occName n) then trfOperatorStr else trfNameStr) False =<< correctNameString n)
-
-trfOperatorStr :: Bool -> String -> Trf (AnnListG AST.UNamePart (Dom r) RangeStage)
-trfOperatorStr isInParen str = do rng <- correctSpan <$> asks contRange
-                                  makeList "." (pure $ srcSpanStart rng)
-                                               (pure [Ann (noSemaInfo $ AST.NodeSpan rng) (AST.UNamePart str)])
-  where correctSpan sp = if isInParen then mkSrcSpan (updateCol (+1) (srcSpanStart sp))
-                                                     (updateCol (subtract 1) (srcSpanEnd sp))
-                                      else sp
-
--- | Creates a qualified name from a name string
-trfNameStr :: Bool -> String -> Trf (AnnListG AST.UNamePart (Dom r) RangeStage)
-trfNameStr isInBackticks str = makeList "." atTheStart (trfNameStr' str . correct <$> atTheStart)
-  where correct = if isInBackticks then updateCol (+1) else id
-
-trfNameStr' :: String -> SrcLoc -> [Ann AST.UNamePart (Dom r) RangeStage]
-trfNameStr' str startLoc = fst $
-  foldl (\(r,loc) np -> let nextLoc = advanceAllSrcLoc loc np
-                         in ( r ++ [Ann (noSemaInfo $ AST.NodeSpan (mkSrcSpan loc nextLoc)) (AST.UNamePart np)], advanceAllSrcLoc nextLoc "." ) )
-  ([], startLoc) (splitOn "." str)
-  where -- | Move the source location according to a string
-        advanceAllSrcLoc :: SrcLoc -> String -> SrcLoc
-        advanceAllSrcLoc (RealSrcLoc rl) str = RealSrcLoc $ foldl advanceSrcLoc rl str
-        advanceAllSrcLoc oth _ = oth
-
-trfFastString :: Located FastString -> Trf (Ann AST.UStringNode (Dom r) RangeStage)
-trfFastString = trfLocNoSema $ pure . AST.UStringNode . unpackFS

@@ -1,72 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ViewPatterns
-           , ScopedTypeVariables
-           , AllowAmbiguousTypes
-           #-}
--- | Functions that convert the pattern-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Patterns where
-
-import ApiAnnotation as GHC (AnnKeywordId(..))
-import BasicTypes as GHC (Boxity(..))
-import Data.List
-import HsExpr (HsSplice(..))
-import HsLit as GHC (HsOverLit(..))
-import HsPat as GHC
-import HsTypes as GHC (HsWildCardBndrs(..), HsImplicitBndrs(..), HsConDetails(..))
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils (getFieldOccName)
-import SrcLoc as GHC
-
-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.Names (TransformName(..), trfOperator, trfName)
-import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.TH (trfSplice, trfQuasiQuotation')
-import Language.Haskell.Tools.AST.FromGHC.Types (trfType)
-import Language.Haskell.Tools.AST.FromGHC.Utils
-
-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
-  = focusOn l $ do
-      let (fromWC, notWC) = partition ((l ==) . getLoc) flds
-      normalFields <- mapM (trfLocNoSema trfPatternField') notWC
-      wildc <- annLocNoSema (tokenLocBack 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)
-correctPatternLoc (L _ p@(ConPatIn _ (InfixCon left right)))
-  = L (getLoc (correctPatternLoc left) `combineSrcSpans` getLoc (correctPatternLoc right)) p
-correctPatternLoc p = p
-
-trfPattern' :: TransformName n r => Pat n -> Trf (AST.UPattern (Dom r) RangeStage)
-trfPattern' (WildPat _) = pure AST.UWildPat
-trfPattern' (VarPat name) = define $ AST.UVarPat <$> trfName name
-trfPattern' (LazyPat pat) = AST.UIrrefutablePat <$> trfPattern pat
-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 <$> 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
-trfPattern' (SplicePat qq@(HsQuasiQuote {})) = AST.UQuasiQuotePat <$> annContNoSema (trfQuasiQuotation' qq)
-trfPattern' (SplicePat splice) = AST.USplicePat <$> trfSplice splice
-trfPattern' (LitPat lit) = AST.ULitPat <$> annContNoSema (trfLiteral' lit)
-trfPattern' (SigPatIn pat (hswc_body . hsib_body -> typ)) = AST.UTypeSigPat <$> trfPattern pat <*> trfType typ
-trfPattern' (NPat (ol_val . unLoc -> lit) _ _ _) = AST.ULitPat <$> annContNoSema (trfOverloadedLit lit)
-trfPattern' (NPlusKPat id (L l lit) _ _ _ _) = AST.UNPlusKPat <$> define (trfName id) <*> annLocNoSema (pure l) (trfOverloadedLit (ol_val lit))
-trfPattern' (CoPat _ pat _) = trfPattern' pat -- coercion pattern introduced by GHC
-trfPattern' p = unhandledElement "pattern" p
-
-trfPatternField' :: TransformName n r => HsRecField n (LPat n) -> Trf (AST.UPatternField (Dom r) RangeStage)
-trfPatternField' (HsRecField id arg False) = AST.UNormalFieldPattern <$> trfName (getFieldOccName id) <*> trfPattern arg
-trfPatternField' (HsRecField id _ True) = AST.UFieldPunPattern <$> trfName (getFieldOccName id)

@@ -1,57 +0,0 @@-{-# LANGUAGE TupleSections #-}
--- | A representation of the tokens that build up the source file.
-module Language.Haskell.Tools.AST.FromGHC.SourceMap where
-
-import ApiAnnotation (AnnKeywordId, ApiAnnKey)
-import Data.List as List
-import Data.Map as Map
-import Data.Maybe (Maybe(..), maybe, fromMaybe)
-import Safe (headMay)
-
-import SrcLoc as GHC
-
--- We store tokens in the source map so it is not a problem that they cannot overlap
-type SourceMap = (Map AnnKeywordId (Map SrcLoc SrcLoc), Map SrcLoc (SrcSpan, AnnKeywordId))
-
--- | Returns the first occurrence of the keyword in the whole source file
-getKeywordAnywhere :: AnnKeywordId -> SourceMap -> Maybe SrcSpan
-getKeywordAnywhere keyw srcmap = return . uncurry mkSrcSpan =<< headMay . assocs =<< (Map.lookup keyw (fst srcmap))
-
--- | Get the source location of a token restricted to a certain source span
-getKeywordInside :: AnnKeywordId -> SrcSpan -> SourceMap -> Maybe SrcSpan
-getKeywordInside keyw sr srcmap = getSourceElementInside True sr =<< Map.lookup keyw (fst srcmap)
-
-getKeywordsInside :: AnnKeywordId -> SrcSpan -> SourceMap -> [SrcSpan]
-getKeywordsInside keyw sr srcmap
-  = let tokensOfType = Map.lookup keyw (fst srcmap)
-        (_, startsAtBegin, startAfterBegin) = Map.splitLookup (srcSpanStart sr) $ fromMaybe empty tokensOfType
-        (startsBeforeEnd, _) = Map.split (srcSpanEnd sr) $ maybe id (Map.insert (srcSpanStart sr)) startsAtBegin startAfterBegin -- tokens are minimum 1 char long
-     in List.map (uncurry mkSrcSpan) $ List.filter (\(_, end) -> end <= srcSpanEnd sr) $ assocs startsBeforeEnd
-
-getKeywordInsideBack :: AnnKeywordId -> SrcSpan -> SourceMap -> Maybe SrcSpan
-getKeywordInsideBack keyw sr srcmap = getSourceElementInside False sr =<< Map.lookup keyw (fst srcmap)
-
-getSourceElementInside :: Bool -> SrcSpan -> Map SrcLoc SrcLoc -> Maybe SrcSpan
-getSourceElementInside b sr srcmap =
-  case (if b then lookupGE (srcSpanStart sr) else lookupLT (srcSpanEnd sr)) srcmap of
-    Just (k, v) -> let sp = mkSrcSpan k v in if sp `isSubspanOf` sr then Just sp else Nothing
-    Nothing -> Nothing
-
--- | Returns the next token on the token stream (including the token that starts on the given location)
-getNextToken :: SrcLoc -> SourceMap -> Maybe (SrcSpan, AnnKeywordId)
-getNextToken loc srcmap = fmap snd $ Map.lookupGE loc $ snd srcmap
-
--- | Returns all subsequent tokens (including the token that starts on the given location)
-getTokensAfter :: SrcLoc -> SourceMap -> [(SrcSpan, AnnKeywordId)]
-getTokensAfter loc srcmap = case Map.splitLookup loc $ snd srcmap of
-    (_, Just elem, after) -> elem : elems after
-    (_, Nothing, after) -> elems after
-
--- | Converts GHC Annotations into a convenient format for looking up tokens
-annotationsToSrcMap :: Map ApiAnnKey [SrcSpan] -> SourceMap
-annotationsToSrcMap anns = (Map.map (List.foldr addToSrcRanges Map.empty) $ mapKeysWith (++) snd anns, tokenMap)
-  where
-    addToSrcRanges :: SrcSpan -> Map SrcLoc SrcLoc -> Map SrcLoc SrcLoc
-    addToSrcRanges span srcmap = Map.insert (srcSpanStart span) (srcSpanEnd span) srcmap
-
-    tokenMap = Map.fromList $ List.map (\(k,v) -> (srcSpanStart k, (k, v))) $ concatMap (\(key,vals) -> List.map ((, snd key)) vals) $ Map.assocs anns

@@ -1,81 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ViewPatterns
-           , TypeFamilies
-           #-}
--- | Functions that convert the statement-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Stmts where
-
-import Control.Monad.Reader (MonadReader(..))
-
-import ApiAnnotation as GHC (AnnKeywordId(..))
-import HsExpr as GHC
-import Outputable (Outputable)
-import SrcLoc as GHC
-
-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.Names (TransformName(..))
-import Language.Haskell.Tools.AST.FromGHC.Patterns (trfPattern)
-import Language.Haskell.Tools.AST.FromGHC.Utils
-
-import Data.Data (Data)
-
-trfDoStmt :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.UStmt (Dom r) RangeStage)
-trfDoStmt = trfLocNoSema trfDoStmt'
-
-trfDoStmt' :: TransformName n r => Stmt n (Located (HsExpr n)) -> Trf (AST.UStmt' AST.UExpr (Dom r) RangeStage)
-trfDoStmt' = gTrfDoStmt' trfExpr
-
-gTrfDoStmt' :: (TransformName n r, Data (ge n), Outputable (ge n))
-            => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> Stmt n (Located (ge n)) -> Trf (AST.UStmt' ae (Dom r) RangeStage)
-gTrfDoStmt' et (BindStmt pat expr _ _ _) = AST.UBindStmt <$> trfPattern pat <*> et expr
-gTrfDoStmt' et (BodyStmt expr _ _ _) = AST.UExprStmt <$> et expr
-gTrfDoStmt' _ (LetStmt (unLoc -> binds)) = AST.ULetStmt <$> addToScope binds (trfLocalBinds AnnLet binds)
-gTrfDoStmt' et (LastStmt body _ _) = AST.UExprStmt <$> et body
-gTrfDoStmt' et (RecStmt { recS_stmts = stmts }) = AST.URecStmt <$> trfAnnList "," (gTrfDoStmt' et) stmts
-gTrfDoStmt' _ stmt = unhandledElement "simple statement" stmt
-
-trfListCompStmts :: TransformName n r => [Located (Stmt n (LHsExpr n))] -> Trf (AnnListG AST.UListCompBody (Dom r) RangeStage)
-trfListCompStmts [unLoc -> ParStmt blocks _ _ _, unLoc -> (LastStmt {})]
-  = nonemptyAnnList
-      <$> trfScopedSequence (\(ParStmtBlock stmts _ _) ->
-                                let ann = collectLocs $ getNormalStmts stmts
-                                 in annLocNoSema (pure ann) (AST.UListCompBody <$> makeList "," (pure $ srcSpanStart ann) (concat <$> trfScopedSequence trfListCompStmt stmts))
-                            ) blocks
-trfListCompStmts others
-  = let ann = (collectLocs $ getNormalStmts others)
-     in makeList "|" (pure $ srcSpanStart ann)
-          ((:[]) <$> annLocNoSema (pure ann)
-                                  (AST.UListCompBody <$> makeList "," (pure $ srcSpanStart ann) (concat <$> trfScopedSequence trfListCompStmt others)))
-
-trfListCompStmt :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf [Ann AST.UCompStmt (Dom r) RangeStage]
-trfListCompStmt (L _ trst@(TransStmt { trS_stmts = stmts }))
-  = (++) <$> (concat <$> local (\s -> s { contRange = mkSrcSpan (srcSpanStart (contRange s)) (srcSpanEnd (getLoc (last stmts))) }) (trfScopedSequence trfListCompStmt stmts))
-         <*> ((:[]) <$> extractActualStmt trst)
--- last statement is extracted
-trfListCompStmt (unLoc -> LastStmt _ _ _) = pure []
-trfListCompStmt other = (:[]) <$> copyAnnot AST.UCompStmt (trfDoStmt other)
-
-extractActualStmt :: TransformName n r => Stmt n (LHsExpr n) -> Trf (Ann AST.UCompStmt (Dom r) RangeStage)
-extractActualStmt = \case
-  TransStmt { trS_form = ThenForm, trS_using = using, trS_by = by }
-    -> addAnnotation by using (AST.UThenStmt <$> trfExpr using <*> trfMaybe "," "" trfExpr by)
-  TransStmt { trS_form = GroupForm, trS_using = using, trS_by = by }
-    -> addAnnotation by using (AST.UGroupStmt <$> trfMaybe "," "" trfExpr by <*> (makeJust <$> trfExpr using))
-  _ -> error "extractActualStmt: called on a statement that is not then or group"
-  where addAnnotation by using
-          = annLocNoSema (combineSrcSpans (getLoc using) . combineSrcSpans (maybe noSrcSpan getLoc by)
-                            <$> tokenLocBack AnnThen)
-
-getNormalStmts :: [Located (Stmt n (LHsExpr n))] -> [Located (Stmt n (LHsExpr n))]
-getNormalStmts (L _ (LastStmt _ _ _) : rest) = getNormalStmts rest
-getNormalStmts (stmt : rest) = stmt : getNormalStmts rest
-getNormalStmts [] = []
-
-getLastStmt :: [Located (Stmt n (LHsExpr n))] -> Located (HsExpr n)
-getLastStmt (L _ (LastStmt body _ _) : _) = body
-getLastStmt (_ : rest) = getLastStmt rest
-getLastStmt [] = error "getLastStmt: empty"

@@ -1,73 +0,0 @@-{-# LANGUAGE LambdaCase #-}
--- | Functions that convert the Template-Haskell-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.TH where
-
-import Control.Monad.Reader (asks)
-
-import ApiAnnotation as GHC (AnnKeywordId(..))
-import FastString as GHC (unpackFS)
-import HsExpr as GHC (HsSplice(..), HsExpr(..), HsBracket(..))
-import SrcLoc as GHC
-
-import Outputable as GHC
-import Control.Monad.IO.Class
-
-import Language.Haskell.Tools.AST.FromGHC.Decls (trfDecls, trfDeclsGroup)
-import Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr, createScopeInfo)
-import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf)
-import Language.Haskell.Tools.AST.FromGHC.Names
-import Language.Haskell.Tools.AST.FromGHC.Patterns (trfPattern)
-import Language.Haskell.Tools.AST.FromGHC.Types (trfType)
-import Language.Haskell.Tools.AST.FromGHC.Utils
-
-import Language.Haskell.Tools.AST (Ann, Dom, RangeStage)
-import qualified Language.Haskell.Tools.AST as AST
-
-trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.UQuasiQuote (Dom r) RangeStage)
- -- the lexer does not provide us with tokens '[', '|' and '|]'
-trfQuasiQuotation' (HsQuasiQuote _ id l str)
-  = AST.UQuasiQuote <$> annLocNoSema quoterLoc (trfName' id)
-                    <*> annLocNoSema (pure strLoc) (pure $ AST.QQString (unpackFS str))
-  where -- assume that there are no white spaces ain the head and the end of the quasi quote
-        quoterLoc = do rng <- asks contRange
-                       return $ mkSrcSpan (updateCol (+1) (srcSpanStart rng)) (updateCol (subtract 1) (srcSpanStart l))
-        strLoc = mkSrcSpan (srcSpanStart l) (updateCol (subtract 2) (srcSpanEnd l))
-trfQuasiQuotation' qq = unhandledElement "quasi quotation" qq
-
-trfSplice :: TransformName n r => HsSplice n -> Trf (Ann AST.USplice (Dom r) RangeStage)
-trfSplice spls = do rng <- asks contRange
-                    annLocNoSema (pure $ getSpliceLoc spls `mappend` rng) (trfSplice' spls)
-
-getSpliceLoc :: HsSplice a -> SrcSpan
-getSpliceLoc (HsTypedSplice _ e) = getLoc e
-getSpliceLoc (HsUntypedSplice _ e) = getLoc e
-getSpliceLoc (HsQuasiQuote _ _ sp _) = sp
-getSpliceLoc (HsSpliced _ _) = noSrcSpan
-
-trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.USplice (Dom r) RangeStage)
-trfSplice' (HsTypedSplice _ expr) = trfSpliceExpr expr
-trfSplice' (HsUntypedSplice _ expr) = trfSpliceExpr expr
-trfSplice' s = unhandledElement "splice" s
-
-trfSpliceExpr :: TransformName n r => Located (HsExpr n) -> Trf (AST.USplice (Dom r) RangeStage)
-trfSpliceExpr expr =
-  do hasDollar <- allTokenLoc AnnThIdSplice
-     hasDoubleDollar <- allTokenLoc AnnThIdTySplice
-     let newSp = case (hasDollar, hasDoubleDollar) of
-                   ([], []) -> getLoc expr
-                   (_, []) -> updateStart (updateCol (+1)) (getLoc expr)
-                   ([], _) -> updateStart (updateCol (+2)) (getLoc expr)
-     case expr of L _ (HsVar (L _ varName)) -> AST.UIdSplice <$> trfName (L newSp varName)
-                  L _ (HsRecFld fldName) -> AST.UIdSplice <$> trfAmbiguousFieldName' newSp fldName
-                  expr -> AST.UParenSplice <$> trfExpr expr
-
-trfBracket' :: TransformName n r => HsBracket n -> Trf (AST.UBracket (Dom r) RangeStage)
-trfBracket' (ExpBr expr) = AST.UExprBracket <$> trfExpr expr
-trfBracket' (TExpBr expr) = AST.UExprBracket <$> trfExpr expr
-trfBracket' (VarBr isSingle expr)
-  = AST.UExprBracket <$> annLoc createScopeInfo (updateStart (updateCol (if isSingle then (+1) else (+2))) <$> asks contRange)
-      (AST.UVar <$> (annContNoSema (trfName' expr)))
-trfBracket' (PatBr pat) = AST.UPatternBracket <$> trfPattern pat
-trfBracket' (DecBrL decls) = AST.UDeclsBracket <$> trfDecls decls
-trfBracket' (DecBrG decls) = AST.UDeclsBracket <$> trfDeclsGroup decls
-trfBracket' (TypBr typ) = AST.UTypeBracket <$> trfType typ

@@ -1,12 +0,0 @@-module Language.Haskell.Tools.AST.FromGHC.TH where
-
-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.Names (TransformName(..))
-
-trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.UQuasiQuote (Dom r) RangeStage)
-trfSplice :: TransformName n r => HsSplice n -> Trf (Ann AST.USplice (Dom r) RangeStage)
-trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.USplice (Dom r) RangeStage)
-trfBracket' :: TransformName n r => HsBracket n -> Trf (AST.UBracket (Dom r) RangeStage)

@@ -1,123 +0,0 @@-{-# LANGUAGE LambdaCase
-           , ViewPatterns
-           , ScopedTypeVariables
-           #-}
--- | Functions that convert the type-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Types where
-
-import ApiAnnotation as GHC (AnnKeywordId(..))
-import HsExpr (HsSplice(..))
-import HsTypes as GHC
-import Id (mkVanillaGlobal)
-import SrcLoc as GHC
-import TyCon as GHC (TyCon(..))
-import TysWiredIn (heqTyCon)
-import Outputable
-
-import Control.Applicative (Applicative(..), (<$>), Alternative(..))
-import Control.Monad.Reader.Class (asks)
-import Control.Reference ((^.))
-import Data.Function (on)
-import Data.List
-import Data.Maybe (Maybe(..), fromJust)
-import Control.Monad.IO.Class
-
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils (GHCName(..), cleanHsType)
-import Language.Haskell.Tools.AST.FromGHC.Kinds (trfKindSig, trfKind, trfPromoted')
-import Language.Haskell.Tools.AST.FromGHC.Monad
-import Language.Haskell.Tools.AST.FromGHC.Names
-import {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.TH (trfSplice, trfQuasiQuotation')
-import Language.Haskell.Tools.AST.FromGHC.Utils
-
-trfType :: TransformName n r => Located (HsType n) -> Trf (Ann AST.UType (Dom r) RangeStage)
-trfType typ | RealSrcSpan loce <- getLoc typ
-  = do othSplices <- asks typeSplices
-       let contSplice = filter (\sp -> case getLoc sp of (RealSrcSpan spLoc) -> spLoc `containsSpan` loce; _ -> False) othSplices
-       case contSplice of [] -> trfLocNoSema trfType' typ
-                          _ -> let lsp@(L l sp) = minimumBy (compareSpans `on` getLoc) contSplice
-                                in typeSpliceInserted lsp (annLocNoSema (pure l) (AST.UTySplice <$> (trfSplice =<< rdrSplice sp)))
-  | otherwise = trfLocNoSema trfType' typ
-
-trfType' :: TransformName n r => HsType n -> Trf (AST.UType (Dom r) RangeStage)
-trfType' = trfType'' . cleanHsType where
-  trfType'' (HsForAllTy [] typ) = trfType' (unLoc typ)
-  trfType'' (HsForAllTy bndrs typ) = AST.UTyForall <$> defineTypeVars (trfBindings bndrs)
-                                                   <*> addToScope bndrs (trfType typ)
-  trfType'' (HsQualTy (L _ []) typ) = trfType' (unLoc typ)
-  trfType'' (HsQualTy ctx typ) = AST.UTyCtx <$> (fromJust . (^. annMaybe) <$> trfCtx atTheStart ctx)
-                                            <*> trfType typ
-  trfType'' (HsTyVar name) = AST.UTyVar <$> transformingPossibleVar name (trfName name)
-  trfType'' (HsAppsTy apps) | Just (head, args) <- getAppsTyHead_maybe apps
-    = foldl (\core t -> AST.UTyApp <$> annLocNoSema (pure $ getLoc head `combineSrcSpans` getLoc t) core <*> trfType t) (trfType' (unLoc head)) args
-  trfType'' (HsAppTy t1 t2) = AST.UTyApp <$> trfType t1 <*> trfType t2
-  trfType'' (HsFunTy t1 t2) = AST.UTyFun <$> trfType t1 <*> trfType t2
-  trfType'' (HsListTy typ) = AST.UTyList <$> trfType typ
-  trfType'' (HsPArrTy typ) = AST.UTyParArray <$> trfType typ
-  trfType'' (HsTupleTy HsBoxedOrConstraintTuple typs) = AST.UTyTuple <$> trfAnnList ", " trfType' typs
-  trfType'' (HsTupleTy HsBoxedTuple typs) = AST.UTyTuple <$> trfAnnList ", " trfType' typs
-  trfType'' (HsTupleTy HsUnboxedTuple typs) = AST.UTyUnbTuple <$> trfAnnList ", " trfType' typs
-  trfType'' (HsOpTy t1 op t2) = AST.UTyInfix <$> trfType t1 <*> trfOperator op <*> trfType t2
-  trfType'' (HsParTy typ) = AST.UTyParen <$> trfType typ
-  trfType'' (HsKindSig typ kind) = AST.UTyKinded <$> trfType typ <*> trfKind kind
-  trfType'' (HsSpliceTy qq@(HsQuasiQuote {}) _) = AST.UTyQuasiQuote <$> annContNoSema (trfQuasiQuotation' qq)
-  trfType'' (HsSpliceTy splice _) = AST.UTySplice <$> trfSplice splice
-  trfType'' (HsBangTy (HsSrcBang _ SrcUnpack _) typ) = AST.UTyUnpack <$> trfType typ
-  trfType'' (HsBangTy (HsSrcBang _ SrcNoUnpack _) typ) = AST.UTyNoUnpack <$> trfType typ
-  trfType'' (HsBangTy (HsSrcBang _ _ SrcStrict) typ) = AST.UTyBang <$> trfType typ
-  trfType'' (HsBangTy (HsSrcBang _ _ SrcLazy) typ) = AST.UTyLazy <$> trfType typ
-  trfType'' pt@(HsExplicitListTy {}) = AST.UTyPromoted <$> annContNoSema (trfPromoted' trfType' pt)
-  trfType'' pt@(HsExplicitTupleTy {}) = AST.UTyPromoted <$> annContNoSema (trfPromoted' trfType' pt)
-  trfType'' pt@(HsTyLit {}) = AST.UTyPromoted <$> annContNoSema (trfPromoted' trfType' pt)
-  trfType'' (HsWildCardTy _) = pure AST.UTyWildcard -- TODO: named wildcards
-  trfType'' t = unhandledElement "type" t
-
-trfBindings :: TransformName n r => [Located (HsTyVarBndr n)] -> Trf (AnnListG AST.UTyVar (Dom r) RangeStage)
-trfBindings vars = trfAnnList " " trfTyVar' vars
-
-trfTyVar :: TransformName n r => Located (HsTyVarBndr n) -> Trf (Ann AST.UTyVar (Dom r) RangeStage)
-trfTyVar = trfLocNoSema trfTyVar'
-
-trfTyVar' :: TransformName n r => HsTyVarBndr n -> Trf (AST.UTyVar (Dom r) RangeStage)
-trfTyVar' (UserTyVar name) = AST.UTyVarDecl <$> typeVarTransform (trfName name)
-                                           <*> (nothing " " "" atTheEnd)
-trfTyVar' (KindedTyVar name kind) = AST.UTyVarDecl <$> typeVarTransform (trfName name)
-                                                  <*> trfKindSig (Just kind)
-
-trfCtx :: TransformName n r => Trf SrcLoc -> Located (HsContext n) -> Trf (AnnMaybeG AST.UContext (Dom r) RangeStage)
-trfCtx sp (L _ []) = nothing " " "" sp
-trfCtx _ (L l [L _ (HsParTy t)])
-  = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow)
-                              (AST.UContext <$> annLocNoSema (pure l) (AST.UTupleAssert <$> (trfAnnList ", " trfAssertion' [t])))
-trfCtx _ (L l [t])
-  = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow)
-                              (AST.UContext <$> trfAssertion t)
-trfCtx _ (L l ctx) = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow)
-                                               (AST.UContext <$> annLocNoSema (pure l) (AST.UTupleAssert <$> (trfAnnList ", " trfAssertion' ctx)))
-
-trfAssertion :: TransformName n r => LHsType n -> Trf (Ann AST.UAssertion (Dom r) RangeStage)
-trfAssertion = trfLocNoSema trfAssertion'
-
-trfAssertion' :: forall n r . TransformName n r => HsType n -> Trf (AST.UAssertion (Dom r) RangeStage)
-trfAssertion' (cleanHsType -> HsParTy t)
-  = trfAssertion' (unLoc t)
-trfAssertion' (cleanHsType -> HsOpTy left op right)
-  = AST.UInfixAssert <$> trfType left <*> trfOperator op <*> trfType right
-trfAssertion' (cleanHsType -> HsTupleTy _ tys)
-  = AST.UTupleAssert <$> makeList ", " (after AnnOpenP) (mapM trfAssertion tys)
-trfAssertion' (cleanHsType -> HsWildCardTy _)
-  = pure AST.UWildcardAssert
-trfAssertion' (cleanHsType -> t) = case cleanHsType base of
-   HsTyVar name -> AST.UClassAssert <$> trfName name <*> trfAnnList " " trfType' args
-   HsEqTy t1 t2 -> AST.UInfixAssert <$> trfType t1 <*> annLocNoSema (tokenLoc AnnTilde) (trfOperator' typeEq) <*> trfType t2
-   HsIParamTy name t -> do loc <- tokenLoc AnnVal
-                           AST.UImplicitAssert <$> define (focusOn loc (trfImplicitName name)) <*> trfType t
-   t -> unhandledElement "assertion" t
-  where (args, _, base) = getArgs t
-
-        getArgs :: HsType n -> ([LHsType n], Maybe SrcSpan, HsType n)
-        getArgs (HsAppTy (L l ft) at) = case getArgs ft of (args, sp, base) -> (args++[at], sp <|> Just l, base)
-        getArgs t = ([], Nothing, t)
-
-        typeEq :: n
-        typeEq = nameFromId (mkVanillaGlobal (tyConName heqTyCon) (tyConKind heqTyCon))

@@ -1,9 +0,0 @@--- | Functions that convert the type-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
-module Language.Haskell.Tools.AST.FromGHC.Types where
-
-import HsTypes as GHC (HsType)
-import Language.Haskell.Tools.AST as AST (UType, Dom, RangeStage)
-import Language.Haskell.Tools.AST.FromGHC.Monad (Trf)
-import Language.Haskell.Tools.AST.FromGHC.Names (TransformName)
-
-trfType' :: TransformName n r => HsType n -> Trf (AST.UType (Dom r) RangeStage)

@@ -1,460 +0,0 @@--- | Utility functions for transforming the GHC AST representation into our own.
-{-# LANGUAGE TypeSynonymInstances
-           , FlexibleInstances
-           , LambdaCase
-           , ViewPatterns
-           , MultiParamTypeClasses
-           , FlexibleContexts
-           , AllowAmbiguousTypes
-           , TypeApplications
-           , TypeFamilies
-           #-}
-module Language.Haskell.Tools.AST.FromGHC.Utils where
-
-import ApiAnnotation (AnnKeywordId)
-import Avail (availNamesWithSelectors, availNames)
-import BasicTypes (StringLiteral(..))
-import CoAxiom as GHC (CoAxiom(..))
-import CoreSyn as GHC (isOrphan)
-import DynFlags (xopt)
-import FamInstEnv as GHC (FamInst(..), famInstEnvElts)
-import FastString (unpackFS, mkFastString)
-import FieldLabel as GHC (FieldLbl(..))
-import GHC
-import HsSyn
-import HscTypes
-import Id (idName)
-import InstEnv as GHC (ClsInst(..), instanceDFunId, instEnvElts)
-import Language.Haskell.TH.LanguageExtensions (Extension(..))
-import Module as GHC
-import Name
-import Outputable (Outputable(..), showSDocUnsafe)
-import SrcLoc
-
-import Control.Monad.Reader
-import Control.Reference ((^.), (&))
-import Data.Char (isSpace)
-import Data.Data (Data(..))
-import Data.Either (Either(..), rights, lefts)
-import Data.Function hiding ((&))
-import Data.IORef (readIORef)
-import Data.List
-import Data.Maybe
-import Language.Haskell.Tools.AST as AST
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils
-import Language.Haskell.Tools.AST.FromGHC.Monad
-import Language.Haskell.Tools.AST.FromGHC.SourceMap
-import Language.Haskell.Tools.AST.SemaInfoTypes as Sema
-
-import Debug.Trace
-
-createModuleInfo :: ModSummary -> SrcSpan -> [LImportDecl n] -> Trf (Sema.ModuleInfo GHC.Name)
-createModuleInfo mod nameLoc (filter (not . ideclImplicit . unLoc) -> imports) = do
-  let prelude = (xopt ImplicitPrelude $ ms_hspp_opts mod)
-                  && all (\idecl -> ("Prelude" /= (GHC.moduleNameString $ unLoc $ ideclName $ unLoc idecl))
-                                      || nameLoc == getLoc idecl) imports
-  (_,preludeImports) <- if prelude then getImportedNames "Prelude" Nothing else return (ms_mod mod, [])
-  (insts, famInsts) <- if prelude then lift $ getOrphanAndFamInstances (Module baseUnitId (GHC.mkModuleName "Prelude"))
-                                  else return ([], [])
-  return $ mkModuleInfo (ms_mod mod) (ms_hspp_opts mod) (case ms_hsc_src mod of HsSrcFile -> False; _ -> True) preludeImports insts famInsts
-
--- | Creates a semantic information for a name
-createNameInfo :: n -> Trf (NameInfo n)
-createNameInfo name = do locals <- asks localsInScope
-                         isDefining <- asks defining
-                         return (mkNameInfo locals isDefining name)
-
-
--- | Creates a semantic information for an ambiguous name (caused by field disambiguation for example)
-createAmbigousNameInfo :: RdrName -> SrcSpan -> Trf (NameInfo n)
-createAmbigousNameInfo name span = do locals <- asks localsInScope
-                                      isDefining <- asks defining
-                                      return (mkAmbiguousNameInfo locals isDefining name span)
-
--- | Creates a semantic information for an implicit name
-createImplicitNameInfo :: String -> Trf (NameInfo n)
-createImplicitNameInfo name = do locals <- asks localsInScope
-                                 isDefining <- asks defining
-                                 rng <- asks contRange
-                                 return (mkImplicitNameInfo locals isDefining name rng)
-
--- | 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 = ( 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)
-createImportData (GHC.ImportDecl _ name pkg _ _ _ _ _ declHiding) =
-  do (mod,importedNames) <- getImportedNames (GHC.moduleNameString $ unLoc name) (fmap (unpackFS . sl_fs) pkg)
-     names <- liftGhc $ filterM (checkImportVisible declHiding) importedNames
-     lookedUpNames <- liftGhc $ mapM (getFromNameUsing getTopLevelId) names
-     lookedUpImported <- liftGhc $ mapM (getFromNameUsing getTopLevelId) importedNames
-     (insts,famInsts) <- lift $ getOrphanAndFamInstances mod
-     return $ mkImportInfo mod (catMaybes lookedUpImported) (catMaybes lookedUpNames) insts famInsts
-
-getOrphanAndFamInstances :: Module -> Ghc ([ClsInst], [FamInst])
-getOrphanAndFamInstances mod = do
-  env <- getSession
-  eps <- liftIO (readIORef (hsc_EPS env))
-  let ifc = lookupIfaceByModule (hsc_dflags env) (hsc_HPT env) (eps_PIT eps) mod
-      hp = lookupHptByModule (hsc_HPT env) mod
-      uses = catMaybes $ map getModule $ maybe [] (\ifc -> dep_orphs (mi_deps ifc) `union` dep_finsts (mi_deps ifc)) ifc
-      getModule mod = if moduleUnitId mod == mainUnitId
-                        then fmap Right $ lookupHptByModule (hsc_HPT env) mod
-                        else fmap Left $ lookupIfaceByModule (hsc_dflags env) (hsc_HPT env) (eps_PIT eps) mod
-      usedMods = lefts uses
-      usedDetails = map hm_details (maybeToList hp ++ rights uses)
-      hptInstances = filter (isOrphan . is_orphan) $ concatMap md_insts usedDetails
-      hptFamilyInstances = concatMap md_fam_insts usedDetails
-      allInstances = instEnvElts (eps_inst_env eps)
-      relevantInstances = hptInstances ++ filter ((\n -> nameModule n `elem` (mod : map mi_module usedMods)) . idName . instanceDFunId) (filter (isOrphan . is_orphan) allInstances)
-      allFamilyInstances = famInstEnvElts (eps_fam_inst_env eps)
-      relevantFamilyInstances = hptFamilyInstances ++ filter ((\n -> nameModule n `elem` (mod : map mi_module usedMods)) . co_ax_name . fi_axiom) allFamilyInstances
-  return (relevantInstances, relevantFamilyInstances)
-
-
--- | Get names that are imported from a given import
-getImportedNames :: String -> Maybe String -> Trf (GHC.Module, [GHC.Name])
-getImportedNames name pkg = liftGhc $ do
-  hpt <- hsc_HPT <$> getSession
-  eps <- getSession >>= liftIO . readIORef . hsc_EPS
-  mod <- findModule (mkModuleName name) (fmap mkFastString pkg)
-  -- load exported names from interface file
-  let ifaceNames = concatMap availNames $ maybe [] mi_exports
-                                        $ flip lookupModuleEnv mod
-                                        $ eps_PIT eps
-  let homeExports = maybe [] (md_exports . hm_details) (lookupHptByModule hpt mod)
-  mi <- getModuleInfo mod
-  return (mod, ifaceNames ++ concatMap availNamesWithSelectors homeExports)
-
--- | Check is a given name is imported from an import with given import specification.
-checkImportVisible :: (HsHasName name, GhcMonad m) => Maybe (Bool, Located [LIE name]) -> GHC.Name -> m Bool
-checkImportVisible (Just (isHiding, specs)) name
-  | isHiding  = not . or @[] <$> mapM (`ieSpecMatches` name) (map unLoc (unLoc specs))
-  | otherwise = or @[] <$> mapM (`ieSpecMatches` name) (map unLoc (unLoc specs))
-checkImportVisible _ _ = return True
-
-ieSpecMatches :: (HsHasName name, GhcMonad m) => IE name -> GHC.Name -> m Bool
-ieSpecMatches (concatMap hsGetNames . HsSyn.ieNames -> ls) name
-  | name `elem` ls = return True
-ieSpecMatches ie@(IEThingAll ln) name | [n] <- hsGetNames (HsSyn.ieName ie), isTyConName n
-  = do entity <- lookupName n
-       return $ case entity of Just (ATyCon tc)
-                                 | Just cls <- tyConClass_maybe tc
-                                     -> name `elem` map getName (classMethods cls)
-                                 | otherwise -> name `elem` concatMap (\dc -> getName dc : map flSelector (dataConFieldLabels dc))
-                                                                      (tyConDataCons tc)
-                               _             -> False
-ieSpecMatches _ _ = return False
-
-noSemaInfo :: src -> NodeInfo NoSemanticInfo src
-noSemaInfo = NodeInfo mkNoSemanticInfo
-
--- | Creates a place for a missing node with a default location
-nothing :: String -> String -> Trf SrcLoc -> Trf (AnnMaybeG e (Dom n) RangeStage)
-nothing bef aft pos = annNothing . noSemaInfo . OptionalPos bef aft <$> pos
-
-emptyList :: String -> Trf SrcLoc -> Trf (AnnListG e (Dom n) RangeStage)
-emptyList sep ann = AnnListG <$> (noSemaInfo . ListPos "" "" sep Nothing <$> ann) <*> pure []
-
--- | Creates a place for a list of nodes with a default place if the list is empty.
-makeList :: String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
-makeList sep ann ls = AnnListG <$> (noSemaInfo . ListPos "" "" sep Nothing <$> ann) <*> ls
-
-makeListBefore :: String -> String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
-makeListBefore bef sep ann ls = do isEmpty <- null <$> ls
-                                   AnnListG <$> (noSemaInfo . ListPos (if isEmpty then bef else "") "" sep Nothing <$> ann) <*> ls
-
-makeListAfter :: String -> String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
-makeListAfter aft sep ann ls = do isEmpty <- null <$> ls
-                                  AnnListG <$> (noSemaInfo . ListPos "" (if isEmpty then aft else "") sep Nothing <$> ann) <*> ls
-
-makeNonemptyList :: String -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
-makeNonemptyList sep ls = AnnListG (noSemaInfo $ ListPos "" "" sep Nothing noSrcLoc) <$> ls
-
--- | Creates a place for an indented list of nodes with a default place if the list is empty.
-makeIndentedList :: Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
-makeIndentedList ann ls = do
-  elems <- ls
-  indent <- elementsWithoutSemi elems
-  AnnListG <$> (noSemaInfo . ListPos  "" "" "\n" (Just indent) <$> ann) <*> pure elems
-
-makeIndentedListNewlineBefore :: Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
-makeIndentedListNewlineBefore ann ls = do elems <- ls
-                                          indent <- elementsWithoutSemi elems
-                                          AnnListG <$> (noSemaInfo . ListPos (if null elems then "\n" else "") "" "\n" (Just indent) <$> ann) <*> pure elems
-
-makeIndentedListBefore :: String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
-makeIndentedListBefore bef sp ls = do elems <- ls
-                                      indent <- elementsWithoutSemi elems
-                                      AnnListG <$> (noSemaInfo . ListPos (if null elems then bef else "") "" "\n" (Just indent) <$> sp) <*> pure elems
-
-makeNonemptyIndentedList :: Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
-makeNonemptyIndentedList ls = do elems <- ls
-                                 indent <- elementsWithoutSemi elems
-                                 AnnListG (noSemaInfo $ ListPos "" "" "\n" (Just indent) noSrcLoc) <$> pure elems
-
--- | Get the elements where there is no ; before
-elementsWithoutSemi :: [Ann e (Dom n) RangeStage] -> Trf [Bool]
-elementsWithoutSemi [] = return []
-elementsWithoutSemi (fst:rest) = indentedElements' (srcSpanEnd $ getRange fst) rest
-  where indentedElements' lastEnd (elem:rest)
-          = let sepRange = mkSrcSpan lastEnd (srcSpanStart $ getRange elem)
-             in (:) <$> (not . (\l -> isGoodSrcSpan l && srcSpanStart l < srcSpanEnd l) <$> focusOn sepRange (tokenLoc AnnSemi))
-                    <*> indentedElements' (srcSpanEnd $ getRange elem) rest
-        indentedElements' _ [] = return []
-
--- | Transform a located part of the AST by automatically transforming the location.
--- Sets the source range for transforming children.
-trfLoc :: (a -> Trf (b (Dom n) RangeStage)) -> Trf (SemanticInfo (Dom n) b) -> Located a -> Trf (Ann b (Dom n) RangeStage)
-trfLoc f sema = trfLocCorrect sema pure f
-
-trfLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => (a -> Trf (b (Dom n) RangeStage)) -> Located a -> Trf (Ann b (Dom n) RangeStage)
-trfLocNoSema f = trfLoc f (pure mkNoSemanticInfo)
-
--- | Transforms a possibly-missing node with the default location of the end of the focus.
-trfMaybe :: String -> String -> (Located a -> Trf (Ann e (Dom n) RangeStage)) -> Maybe (Located a) -> Trf (AnnMaybeG e (Dom n) RangeStage)
-trfMaybe bef aft f = trfMaybeDefault bef aft f atTheEnd
-
--- | Transforms a possibly-missing node with a default location
-trfMaybeDefault :: String -> String -> (Located a -> Trf (Ann e (Dom n) RangeStage)) -> Trf SrcLoc -> Maybe (Located a) -> Trf (AnnMaybeG e (Dom n) RangeStage)
-trfMaybeDefault _   _   f _   (Just e) = makeJust <$> f e
-trfMaybeDefault bef aft _ loc Nothing  = nothing bef aft loc
-
--- | Transform a located part of the AST by automatically transforming the location
--- with correction by applying the given function. Sets the source range for transforming children.
-trfLocCorrect :: Trf (SemanticInfo (Dom n) b) -> (SrcSpan -> Trf SrcSpan) -> (a -> Trf (b (Dom n) RangeStage)) -> Located a -> Trf (Ann b (Dom n) RangeStage)
-trfLocCorrect sema locF f (L l e) = annLoc sema (locF l) (f e)
-
--- | Transform a located part of the AST by automatically transforming the location.
--- Sets the source range for transforming children.
-trfMaybeLoc :: (a -> Trf (Maybe (b (Dom n) RangeStage))) -> SemanticInfo (Dom n) b -> Located a -> Trf (Maybe (Ann b (Dom n) RangeStage))
-trfMaybeLoc f sema (L l e) = do fmap (Ann (NodeInfo sema (NodeSpan l))) <$> local (\s -> s { contRange = l }) (f e)
-
-trfMaybeLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => (a -> Trf (Maybe (b (Dom n) RangeStage))) -> Located a -> Trf (Maybe (Ann b (Dom n) RangeStage))
-trfMaybeLocNoSema f = trfMaybeLoc f mkNoSemanticInfo
-
--- | Creates a place for a list of nodes with the default place at the end of the focus if the list is empty.
-trfAnnList :: SemanticInfo (Dom n) b ~ NoSemanticInfo => String -> (a -> Trf (b (Dom n) RangeStage)) -> [Located a] -> Trf (AnnListG b (Dom n) RangeStage)
-trfAnnList sep _ [] = makeList sep atTheEnd (pure [])
-trfAnnList sep f ls = makeList sep (pure $ noSrcLoc) (mapM (trfLoc f (pure mkNoSemanticInfo)) ls)
-
-trfAnnList' :: String -> (Located a -> Trf (Ann b (Dom n) RangeStage)) -> [Located a] -> Trf (AnnListG b (Dom n) RangeStage)
-trfAnnList' sep _ [] = makeList sep atTheEnd (pure [])
-trfAnnList' sep f ls = makeList sep (pure $ noSrcLoc) (mapM f ls)
-
-
--- | Creates a place for a list of nodes that cannot be empty.
-nonemptyAnnList :: [Ann e (Dom n) RangeStage] -> AnnListG e (Dom n) RangeStage
-nonemptyAnnList = AnnListG (noSemaInfo $ ListPos "" "" "" Nothing noSrcLoc)
-
--- | Creates an optional node from an existing element
-makeJust :: Ann e (Dom n) RangeStage -> AnnMaybeG e (Dom n) RangeStage
-makeJust e = AnnMaybeG (noSemaInfo $ OptionalPos "" "" noSrcLoc) (Just e)
-
--- | Annotates a node with the given location and focuses on the given source span.
-annLoc :: Trf (SemanticInfo (Dom n) b) -> Trf SrcSpan -> Trf (b (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
-annLoc semam locm nodem = do loc <- locm
-                             node <- focusOn loc nodem
-                             sema <- semam
-                             return (Ann (NodeInfo sema (NodeSpan loc)) node)
-
-annLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => Trf SrcSpan -> Trf (b (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
-annLocNoSema = annLoc (pure mkNoSemanticInfo)
-
--- * Focus manipulation
-
-focusOn :: SrcSpan -> Trf a -> Trf a
-focusOn sp = local (\s -> s { contRange = sp })
-
-updateFocus :: (SrcSpan -> Trf SrcSpan) -> Trf a -> Trf a
-updateFocus f trf = do newSpan <- f =<< asks contRange
-                       focusOn newSpan trf
-
--- | 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
-
--- | Focuses the transformation to go between tokens if they are present
-betweenIfPresent :: AnnKeywordId -> AnnKeywordId -> Trf a -> Trf a
-betweenIfPresent firstTok lastTok = focusAfterIfPresent firstTok . focusBeforeIfPresent lastTok
-
--- | Focuses the transformation to be performed after the given token. The token must be found inside the current range.
-focusAfter :: AnnKeywordId -> Trf a -> Trf a
-focusAfter firstTok trf
-  = do firstToken <- tokenLoc firstTok
-       if (isGoodSrcSpan firstToken)
-          then local (\s -> s { contRange = mkSrcSpan (srcSpanEnd firstToken) (srcSpanEnd (contRange s))}) trf
-          else do rng <- asks contRange
-                  error $ "focusAfter: token not found in " ++ show rng ++ ": " ++ show firstTok
-
-focusAfterIfPresent :: AnnKeywordId -> Trf a -> Trf a
-focusAfterIfPresent firstTok trf
-  = do firstToken <- tokenLoc firstTok
-       if (isGoodSrcSpan firstToken)
-          then local (\s -> s { contRange = mkSrcSpan (srcSpanEnd firstToken) (srcSpanEnd (contRange s))}) trf
-          else trf
-
--- | Focuses the transformation to be performed before the given token. The token must be found inside the current range.
-focusBefore :: AnnKeywordId -> Trf a -> Trf a
-focusBefore lastTok trf
-  = do lastToken <- tokenLocBack lastTok
-       if (isGoodSrcSpan lastToken)
-          then local (\s -> s { contRange = mkSrcSpan (srcSpanStart (contRange s)) (srcSpanStart lastToken)}) trf
-          else do rng <- asks contRange
-                  error $ "focusBefore: token not found in " ++ show rng ++ ": " ++ show lastTok
-
-focusBeforeIfPresent :: AnnKeywordId -> Trf a -> Trf a
-focusBeforeIfPresent lastTok trf
-  = do lastToken <- tokenLocBack lastTok
-       if (isGoodSrcSpan lastToken)
-          then local (\s -> s { contRange = mkSrcSpan (srcSpanStart (contRange s)) (srcSpanStart lastToken)}) trf
-          else trf
-
--- | Gets the position before the given token
-before :: AnnKeywordId -> Trf SrcLoc
-before tok = srcSpanStart <$> tokenLoc tok
-
--- | Gets the position after the given token
-after :: AnnKeywordId -> Trf SrcLoc
-after tok = srcSpanEnd <$> tokenLoc tok
-
--- | The element should span from the given token to the end of focus
-annFrom :: AnnKeywordId -> Trf (SemanticInfo (Dom n) e) -> Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
-annFrom kw sema = annLoc sema (combineSrcSpans <$> tokenLoc kw <*> asks (srcLocSpan . srcSpanEnd . contRange))
-
-annFromNoSema :: SemanticInfo (Dom n) e ~ NoSemanticInfo => AnnKeywordId -> Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
-annFromNoSema kw = annFrom kw (pure mkNoSemanticInfo)
-
--- | Gets the position at the beginning of the focus
-atTheStart :: Trf SrcLoc
-atTheStart = asks (srcSpanStart . contRange)
-
--- | Gets the position at the end of the focus
-atTheEnd :: Trf SrcLoc
-atTheEnd = asks (srcSpanEnd . contRange)
-
--- | Searches for a token inside the focus and retrieves its location
-tokenLoc :: AnnKeywordId -> Trf SrcSpan
-tokenLoc keyw = fromMaybe noSrcSpan <$> (getKeywordInside keyw <$> asks contRange <*> asks srcMap)
-
-allTokenLoc :: AnnKeywordId -> Trf [SrcSpan]
-allTokenLoc keyw = getKeywordsInside keyw <$> asks contRange <*> asks srcMap
-
--- | Searches for a token backward inside the focus and retrieves its location
-tokenLocBack :: AnnKeywordId -> Trf SrcSpan
-tokenLocBack keyw = fromMaybe noSrcSpan <$> (getKeywordInsideBack keyw <$> asks contRange <*> asks srcMap)
-
-tokenBefore :: SrcLoc -> AnnKeywordId -> Trf SrcSpan
-tokenBefore loc keyw
-  = fromMaybe noSrcSpan <$> (getKeywordInsideBack keyw <$> (mkSrcSpan <$> (asks (srcSpanStart . contRange)) <*> pure loc) <*> asks srcMap)
-
-allTokensAfter :: SrcLoc -> Trf [(SrcSpan, AnnKeywordId)]
-allTokensAfter loc = getTokensAfter loc <$> asks srcMap
-
-tokensAfter :: AnnKeywordId -> Trf [SrcSpan]
-tokensAfter keyw
-  = map fst . filter ((==keyw) . snd) <$> (asks (srcSpanEnd . contRange) >>= allTokensAfter)
-
-
--- | Searches for tokens in the given order inside the parent element and returns their combined location
-tokensLoc :: [AnnKeywordId] -> Trf SrcSpan
-tokensLoc keys = asks contRange >>= tokensLoc' keys
-  where tokensLoc' :: [AnnKeywordId] -> SrcSpan -> Trf SrcSpan
-        tokensLoc' (keyw:rest) r
-          = do spanFirst <- tokenLoc keyw
-               spanRest <- tokensLoc' rest (mkSrcSpan (srcSpanEnd spanFirst) (srcSpanEnd r))
-               return (combineSrcSpans spanFirst spanRest)
-        tokensLoc' [] _ = pure noSrcSpan
-
--- | Searches for a token and retrieves its location anywhere
-uniqueTokenAnywhere :: AnnKeywordId -> Trf SrcSpan
-uniqueTokenAnywhere keyw = fromMaybe noSrcSpan <$> (getKeywordAnywhere keyw <$> asks srcMap)
-
--- | Annotates the given element with the current focus as a location.
-annCont :: Trf (SemanticInfo (Dom n) e) -> Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
-annCont sema = annLoc sema (asks contRange)
-
-annContNoSema :: SemanticInfo (Dom n) e ~ NoSemanticInfo => Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
-annContNoSema = annCont (pure mkNoSemanticInfo)
-
--- | Annotates the element with the same annotation that is on the other element
-copyAnnot :: SemanticInfo (Dom n) a ~ SemanticInfo (Dom n) b
-               => (Ann a (Dom n) RangeStage -> b (Dom n) RangeStage) -> Trf (Ann a (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
-copyAnnot f at = (\(Ann i a) -> Ann i (f (Ann i a))) <$> at
-
--- | Combine source spans into one that contains them all
-foldLocs :: [SrcSpan] -> SrcSpan
-foldLocs = foldl combineSrcSpans noSrcSpan
-
--- | The location after the given string
-advanceStr :: String -> SrcLoc -> SrcLoc
-advanceStr str (RealSrcLoc l) = RealSrcLoc $ foldl advanceSrcLoc l str
-advanceStr _ l = l
-
--- | Update column information in a source location
-updateCol :: (Int -> Int) -> SrcLoc -> SrcLoc
-updateCol _ loc@(UnhelpfulLoc _) = loc
-updateCol f (RealSrcLoc loc) = mkSrcLoc (srcLocFile loc) (srcLocLine loc) (f $ srcLocCol loc)
-
--- | Update the start of the src span
-updateStart :: (SrcLoc -> SrcLoc) -> SrcSpan -> SrcSpan
-updateStart f sp = mkSrcSpan (f (srcSpanStart sp)) (srcSpanEnd sp)
-
--- | Update the end of the src span
-updateEnd :: (SrcLoc -> SrcLoc) -> SrcSpan -> SrcSpan
-updateEnd f sp = mkSrcSpan (srcSpanStart sp) (f (srcSpanEnd sp))
-
--- | Combine source spans of elements into one that contains them all
-collectLocs :: [Located e] -> SrcSpan
-collectLocs = foldLocs . map getLoc
-
--- | Rearrange definitions to appear in the order they are defined in the source file.
-orderDefs :: [Ann e (Dom n) RangeStage] -> [Ann e (Dom n) RangeStage]
-orderDefs = sortBy (compare `on` srcSpanStart . (^. AST.annotation & AST.sourceInfo & AST.nodeSpan))
-
--- | Orders a list of elements to the order they are defined in the source file.
-orderAnnList :: AnnListG e (Dom n) RangeStage -> AnnListG e (Dom n) RangeStage
-orderAnnList (AnnListG a ls) = AnnListG a (orderDefs ls)
-
--- | Only keeps one of the elements that are on the same source location
-removeDuplicates :: [Located e] -> [Located e]
-removeDuplicates (fst:rest) = fst : removeDuplicates (filter ((/= getLoc fst) . getLoc) rest)
-removeDuplicates [] = []
-
--- | Transform a list of definitions where the defined names are in scope for subsequent definitions
-trfScopedSequence :: HsHasName d => (d -> Trf e) -> [d] -> Trf [e]
-trfScopedSequence f (def:rest) = (:) <$> f def <*> addToScope def (trfScopedSequence f rest)
-trfScopedSequence _ [] = pure []
-
--- | Splits a given string at whitespaces while calculating the source location of the fragments
-splitLocated :: Located String -> [Located String]
-splitLocated (L (RealSrcSpan l) str) = splitLocated' str (realSrcSpanStart l) Nothing
-  where splitLocated' :: String -> RealSrcLoc -> Maybe (RealSrcLoc, String) -> [Located String]
-        splitLocated' (c:rest) currLoc (Just (startLoc, str)) | isSpace c
-          = L (RealSrcSpan $ mkRealSrcSpan startLoc currLoc) (reverse str) : splitLocated' rest (advanceSrcLoc currLoc c) Nothing
-        splitLocated' (c:rest) currLoc Nothing | isSpace c = splitLocated' rest (advanceSrcLoc currLoc c) Nothing
-        splitLocated' (c:rest) currLoc (Just (startLoc, str)) = splitLocated' rest (advanceSrcLoc currLoc c) (Just (startLoc, c:str))
-        splitLocated' (c:rest) currLoc Nothing = splitLocated' rest (advanceSrcLoc currLoc c) (Just (currLoc, [c]))
-        splitLocated' [] currLoc (Just (startLoc, str)) = [L (RealSrcSpan $ mkRealSrcSpan startLoc currLoc) (reverse str)]
-        splitLocated' [] _ Nothing = []
-splitLocated _ = error "splitLocated: unhelpful span given"
-
-compareSpans :: SrcSpan -> SrcSpan -> Ordering
-compareSpans (RealSrcSpan a) (RealSrcSpan b)
-  | a `containsSpan` b = GT
-  | b `containsSpan` a = LT
-compareSpans _ _ = EQ
-
--- | Report errors when cannot convert a type of element
-unhandledElement :: (Data a, Outputable a) => String -> a -> Trf b
-unhandledElement label e = do rng <- asks contRange
-                              error ("Illegal " ++ label ++ ": " ++ showSDocUnsafe (ppr e) ++ " (ctor: " ++ show (toConstr e) ++ ") at: " ++ show rng)
-
-instance Monoid SrcSpan where
-  span1@(RealSrcSpan _) `mappend` span2 = span1
-  span1 `mappend` span2 = span2
-  mempty = noSrcSpan

@@ -0,0 +1,9 @@+-- | The FromGHC module provides a way to transform the GHC AST into our AST. This transformation is done in
+-- 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.BackendGHC 
+  ( trfModule, trfModuleRename, addTypeInfos, runTrf) where
+
+import Language.Haskell.Tools.BackendGHC.AddTypeInfo (addTypeInfos)
+import Language.Haskell.Tools.BackendGHC.Modules (trfModule, trfModuleRename)
+import Language.Haskell.Tools.BackendGHC.Monad (runTrf)

@@ -0,0 +1,97 @@+{-# LANGUAGE TupleSections
+           , LambdaCase
+           , ScopedTypeVariables
+           #-}
+module Language.Haskell.Tools.BackendGHC.AddTypeInfo (addTypeInfos) where
+
+import Bag as GHC (bagToList)
+import GHC
+import HscTypes as GHC
+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 SrcLoc as GHC
+import TcEvidence as GHC (EvBind(..), TcEvBinds(..))
+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(..))
+
+import Control.Applicative (Applicative(..), (<$>), Alternative(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.State
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Reference (Lens_1(..), (^.))
+import Data.Generics.Uniplate.Data ()
+import Data.Generics.Uniplate.Operations (universeBi)
+import Data.List as List
+import qualified Data.Map as Map (fromList, lookup)
+import Data.Maybe (Maybe(..), fromMaybe, catMaybes)
+
+import Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.AST.SemaInfoTypes as AST (mkCNameInfo)
+import Language.Haskell.Tools.BackendGHC.GHCUtils (getTopLevelId)
+
+addTypeInfos :: LHsBinds Id -> Ann AST.UModule (Dom GHC.Name) RangeStage -> Ghc (Ann AST.UModule IdDom RangeStage)
+addTypeInfos bnds mod = do
+  ut <- liftIO mkUnknownType
+  let getType = getType' ut
+  fixities <- getFixities
+  let createCName sc def id = mkCNameInfo sc def id fixity
+        where fixity = if any (any ((getOccName id ==) . getOccName . (^. _1))) (init sc)
+                          then Nothing
+                          else fmap (snd . snd) $ List.find (\(mod,(occ,_)) -> Just mod == (nameModule_maybe $ varName id) && occ == getOccName id) fixities
+  evalStateT (semaTraverse
+    (AST.SemaTrf
+      (\ni -> case (AST.semanticsSourceInfo ni, AST.semanticsName ni) of
+                (_, Just name) -> lift $ createCName (AST.semanticsScope ni) (AST.semanticsDefining ni) <$> getType name
+                (Just l@(RealSrcSpan loc), _)
+                  -> case Map.lookup l locMapping of
+                            Just id -> return $ createCName (AST.semanticsScope ni) (AST.semanticsDefining ni) id
+                            _ -> do (none,rest) <- gets (break ((\(RealSrcSpan sp) -> sp `containsSpan` loc) . fst))
+                                    case rest of [] -> error $ "Ambiguous or implicit name missing, at: " ++ show loc
+                                                 ((_,id):more) -> do put (none ++ more)
+                                                                     return $ createCName (AST.semanticsScope ni) (AST.semanticsDefining ni) id
+                _ -> error "addTypeInfos: Cannot access a the semantics of a name.")
+      pure (traverse (lift . getType)) (traverse (lift . getType)) pure
+        pure) mod) (extractSigIds bnds ++ extractSigBindIds bnds)
+  where locMapping = Map.fromList $ map (\(L l id) -> (l, id)) $ extractExprIds bnds
+        getType' ut name = fromMaybe (mkVanillaGlobal name ut) <$> ((<|> Map.lookup name ids) <$> getTopLevelId name)
+        ids = Map.fromList $ map (\id -> (getName id, id)) $ extractTypes bnds
+        extractTypes :: LHsBinds Id -> [Id]
+        extractTypes = concatMap universeBi . bagToList
+
+        mkUnknownType :: IO Type
+        mkUnknownType = do
+          tUnique <- mkSplitUniqSupply 'x'
+          return $ mkTyVarTy $ mkVanillaGlobal (mkSystemName (uniqFromSupply tUnique) (mkDataOcc "TypeNotFound")) (mkTyConTy starKindTyCon)
+
+        getFixities :: Ghc [(Module, (OccName, GHC.Fixity))]
+        getFixities = do env <- getSession
+                         pit <- liftIO $ eps_PIT <$> hscEPS env
+                         let hpt = hsc_HPT env
+                             ifaces = moduleEnvElts pit ++ map hm_iface (eltsUFM hpt)
+                         return $ concatMap (\mi -> map (mi_module mi, ) $ mi_fixities mi) ifaces
+
+extractExprIds :: LHsBinds Id -> [Located Id]
+        -- expressions like HsRecFld are removed from the typechecked representation, they are replaced by HsVar
+extractExprIds = catMaybes . map (\case L l (HsVar (L _ n)) -> Just (L l n)
+                                        L l (HsWrap _ (HsVar (L _ n))) -> Just (L l n)
+                                        _ -> Nothing
+                                 ) . concatMap universeBi . bagToList
+
+extractSigIds :: LHsBinds Id -> [(SrcSpan,Id)]
+extractSigIds = concat . map (\case L l bs@(AbsBindsSig {} :: HsBind Id) -> map (l,) $ getImplVars (abs_sig_ev_bind bs)
+                                    _                                    -> []
+                             ) . concatMap universeBi . bagToList
+  where getImplVars (EvBinds evbnds) = catMaybes $ map getEvVar $ bagToList evbnds
+        getImplVars _                = []
+        getEvVar (EvBind lhs _ False) = Just lhs
+        getEvVar _                    = Nothing
+
+extractSigBindIds :: LHsBinds Id -> [(SrcSpan,Id)]
+extractSigBindIds = catMaybes . map (\case L l (IPBind (Right id) _) -> Just (l,id)
+                                           _                         -> Nothing
+                                    ) . concatMap universeBi . bagToList

@@ -0,0 +1,193 @@+{-# LANGUAGE LambdaCase
+           , ViewPatterns
+           #-}
+-- | Functions that convert the value and function definitions of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Binds where
+
+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 HsTypes as GHC (HsWildCardBndrs(..), HsImplicitBndrs(..))
+import Name as GHC (isSymOcc)
+import SrcLoc as GHC
+
+import Control.Monad.Reader (Monad(..), mapM, asks)
+import Data.List
+
+import Language.Haskell.Tools.BackendGHC.Exprs (trfExpr)
+import Language.Haskell.Tools.BackendGHC.GHCUtils (occName)
+import Language.Haskell.Tools.BackendGHC.Monad
+import Language.Haskell.Tools.BackendGHC.Names
+import Language.Haskell.Tools.BackendGHC.Patterns (trfPattern)
+import Language.Haskell.Tools.BackendGHC.Types (trfType)
+import Language.Haskell.Tools.BackendGHC.Utils
+
+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)
+trfBind = trfLocNoSema trfBind'
+
+trfBind' :: TransformName n r => HsBind n -> Trf (AST.UValueBind (Dom r) RangeStage)
+-- 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)
+                    <*> 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' b = unhandledElement "binding" b
+
+trfMatch :: TransformName n r => n -> Located (Match n (LHsExpr n)) -> Trf (Ann AST.UMatch (Dom r) RangeStage)
+trfMatch id = trfLocNoSema (trfMatch' id)
+
+trfMatch' :: TransformName n r => n -> Match n (LHsExpr n) -> Trf (AST.UMatch (Dom r) RangeStage)
+trfMatch' name (Match funid pats _ (GRHSs rhss (unLoc -> locBinds)))
+  -- TODO: add the optional typ to pats
+  = AST.UMatch <$> trfMatchLhs name funid pats
+               <*> 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
+  = do implicitIdLoc <- mkSrcSpan <$> atTheStart <*> atTheStart
+       parenOpLoc <- tokensLoc [AnnOpenP, AnnVal, AnnCloseP]
+       nonFunOpLoc <- tokenLoc AnnVal
+       let infixLoc = case (parenOpLoc, nonFunOpLoc) of
+                        (RealSrcSpan rsp1, RealSrcSpan rsp2)
+                          | srcLocCol (realSrcSpanStart rsp2) == srcLocCol (realSrcSpanStart rsp1) + 1
+                              && srcLocCol (realSrcSpanEnd rsp2) == srcLocCol (realSrcSpanEnd rsp1) - 1 -> parenOpLoc
+                        _ -> nonFunOpLoc -- sometimes parenOpLoc is not an actual operator in parentheses, it just grabs
+                                         -- a paren, so we need to check that it is actually what we seek
+       closeLoc <- srcSpanStart <$> (combineSrcSpans <$> tokenLoc AnnEqual <*> tokenLoc AnnVbar)
+       args <- mapM trfPattern pats
+       let (n, isInfix) = case fb of NonFunBindMatch -> let token = if isSymOcc (occName name) && isGoodSrcSpan infixLoc then infixLoc else implicitIdLoc
+                                                         in (L token name, length pats > 0 && srcSpanStart token >= srcSpanEnd (getLoc (pats !! 0)))
+                                     FunBindMatch n inf -> (n, inf)
+       annLocNoSema (mkSrcSpan <$> atTheStart <*> (pure closeLoc)) $
+        case (args, isInfix) of
+           (left:right:rest, True) -> AST.UInfixLhs left <$> define (trfOperator n) <*> pure right <*> makeList " " (pure closeLoc) (pure rest)
+           _                       -> AST.UNormalLhs <$> define (trfName n) <*> makeList " " (pure closeLoc) (pure args)
+
+trfRhss :: TransformName n r => [Located (GRHS n (LHsExpr n))] -> Trf (Ann AST.URhs (Dom r) RangeStage)
+-- the original location on the GRHS misleadingly contains the local bindings
+trfRhss [unLoc -> GRHS [] body] = annLocNoSema (combineSrcSpans (getLoc body) <$> tokenBefore (srcSpanStart $ getLoc body) AnnEqual)
+                                         (AST.UUnguardedRhs <$> trfExpr body)
+trfRhss rhss = annLocNoSema (pure $ collectLocs rhss)
+                      (AST.UGuardedRhss . nonemptyAnnList <$> mapM trfGuardedRhs rhss)
+
+trfGuardedRhs :: TransformName n r => Located (GRHS n (LHsExpr n)) -> Trf (Ann AST.UGuardedRhs (Dom r) RangeStage)
+trfGuardedRhs = trfLocNoSema $ \(GRHS guards body)
+  -> AST.UGuardedRhs . nonemptyAnnList <$> trfScopedSequence trfRhsGuard guards <*> addToScope guards (trfExpr body)
+
+trfRhsGuard :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.URhsGuard (Dom r) RangeStage)
+trfRhsGuard = trfLocNoSema trfRhsGuard'
+
+trfRhsGuard' :: TransformName n r => Stmt n (LHsExpr n) -> Trf (AST.URhsGuard (Dom r) RangeStage)
+trfRhsGuard' (BindStmt pat body _ _ _) = AST.UGuardBind <$> trfPattern pat <*> trfExpr body
+trfRhsGuard' (BodyStmt body _ _ _) = AST.UGuardCheck <$> trfExpr body
+trfRhsGuard' (LetStmt (unLoc -> binds)) = AST.UGuardLet <$> trfLocalBinds AnnLet binds
+trfRhsGuard' d = unhandledElement "guard" d
+
+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 AnnWhere binds))
+
+getBindLocs :: HsLocalBinds n -> SrcSpan
+getBindLocs (HsValBinds (ValBindsIn binds sigs)) = foldLocs $ map getLoc (bagToList binds) ++ map getLoc sigs
+getBindLocs (HsValBinds (ValBindsOut binds sigs)) = foldLocs $ map getLoc (concatMap (bagToList . snd) binds) ++ map getLoc sigs
+getBindLocs (HsIPBinds (IPBinds binds _)) = foldLocs $ map getLoc binds
+getBindLocs EmptyLocalBinds = noSrcSpan
+
+trfLocalBinds :: TransformName n r => AnnKeywordId -> HsLocalBinds n -> Trf (AnnListG AST.ULocalBind (Dom r) RangeStage)
+trfLocalBinds token (HsValBinds (ValBindsIn binds sigs))
+  = makeIndentedListBefore " " (after token)
+      (orderDefs <$> ((++) <$> mapM (copyAnnot AST.ULocalValBind . trfBind) (bagToList binds)
+                           <*> mapM trfLocalSig sigs))
+trfLocalBinds token (HsValBinds (ValBindsOut binds sigs))
+  = makeIndentedListBefore " " (after token)
+      (orderDefs <$> ((++) <$> (concat <$> mapM (mapM (copyAnnot AST.ULocalValBind . trfBind) . bagToList . snd) binds)
+                           <*> mapM trfLocalSig sigs))
+trfLocalBinds token (HsIPBinds (IPBinds binds _))
+  = makeIndentedListBefore " " (after token) (mapM trfIpBind binds)
+trfLocalBinds _ b = unhandledElement "local binds" b
+
+trfIpBind :: TransformName n r => Located (IPBind n) -> Trf (Ann AST.ULocalBind (Dom r) RangeStage)
+trfIpBind = trfLocNoSema $ \case
+  IPBind (Left (L l ipname)) expr
+    -> AST.ULocalValBind
+         <$> (annContNoSema $ AST.USimpleBind <$> focusOn l (annContNoSema (AST.UVarPat <$> define (trfImplicitName ipname)))
+                                              <*> annFromNoSema AnnEqual (AST.UUnguardedRhs <$> trfExpr expr)
+                                              <*> nothing " " "" atTheEnd)
+  IPBind (Right _) _ -> error "trfIpBind: called on typechecked AST"
+
+trfLocalSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.ULocalBind (Dom r) RangeStage)
+trfLocalSig = trfLocNoSema $ \case
+  ts@(TypeSig {}) -> AST.ULocalSignature <$> annContNoSema (trfTypeSig' ts)
+  (FixSig fs) -> AST.ULocalFixity <$> annContNoSema (trfFixitySig fs)
+  (InlineSig name prag) -> AST.ULocalInline <$> trfInlinePragma name prag
+  d -> unhandledElement "local signature" d
+
+trfTypeSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.UTypeSignature (Dom r) RangeStage)
+trfTypeSig = trfLocNoSema trfTypeSig'
+
+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' ts = unhandledElement "type signature" ts
+
+trfFixitySig :: TransformName n r => FixitySig n -> Trf (AST.UFixitySignature (Dom r) RangeStage)
+trfFixitySig (FixitySig names (Fixity _ prec dir))
+  = do precLoc <- tokenLoc AnnVal -- the precedence token or one of the names
+       AST.UFixitySignature <$> transformDir dir
+                            <*> (if isGoodSrcSpan precLoc && all (srcSpanEnd precLoc <) (map (srcSpanStart . getLoc) names)
+                                   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)
+
+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 _ NoInline _ _ _) = 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) <*> (makeJust <$> trfPhaseNum pn))
+trfPhase _ (ActiveBefore _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS)
+                                                           (AST.UPhaseControl <$> (makeJust <$> annLocNoSema (tokenLoc AnnTilde) (pure AST.PhaseInvert)) <*> (makeJust <$> trfPhaseNum pn))
+trfPhase _ NeverActive = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS)
+                                                   (AST.UPhaseControl <$> (makeJust <$> annLocNoSema (tokenLoc AnnTilde) (pure AST.PhaseInvert)) <*> nothing " " "" (after AnnTilde))
+
+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 | length parts > 2
+  = makeJust <$> annLocNoSema (pure $ parts !! 2) (pure AST.UConlikeAnnot)
+  | otherwise = error $ "trfConlike: expected 3 parts, got: " ++ show parts
+trfConlike (_:inlTok:_) FunLike = nothing " " "" (pure $ srcSpanEnd inlTok)
+trfConlike (combTok:_) FunLike = nothing " " "" (pure $ srcSpanEnd combTok)

@@ -0,0 +1,15 @@+module Language.Haskell.Tools.BackendGHC.Binds where
+
+import ApiAnnotation (AnnKeywordId)
+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.BackendGHC.Monad (Trf)
+import Language.Haskell.Tools.BackendGHC.Names (TransformName(..))
+import SrcLoc as GHC (Located, SrcSpan)
+
+trfLocalBinds :: TransformName n r => AnnKeywordId -> HsLocalBinds n -> Trf (AnnListG AST.ULocalBind (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)

@@ -0,0 +1,601 @@+{-# LANGUAGE LambdaCase
+           , ViewPatterns
+           , ScopedTypeVariables
+           #-}
+-- | Functions that convert the declarations of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Decls where
+
+import ApiAnnotation as GHC (AnnKeywordId(..))
+import Bag as GHC (bagToList)
+import BasicTypes as GHC
+import BooleanFormula as GHC (BooleanFormula(..))
+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, isSymOcc)
+import Outputable as GHC (Outputable(..), showSDocUnsafe)
+import RdrName as GHC (RdrName, rdrNameOcc)
+import SrcLoc as GHC
+import TyCon as GHC (Role(..))
+
+import Control.Monad.Reader
+import Control.Reference
+import Data.Generics.Uniplate.Data ()
+import Data.List
+import Data.Maybe (Maybe(..), fromMaybe)
+
+import Language.Haskell.Tools.BackendGHC.Binds
+import Language.Haskell.Tools.BackendGHC.Exprs (trfExpr)
+import Language.Haskell.Tools.BackendGHC.GHCUtils
+import Language.Haskell.Tools.BackendGHC.Kinds (trfKindSig, trfKindSig')
+import Language.Haskell.Tools.BackendGHC.Monad
+import Language.Haskell.Tools.BackendGHC.Names
+import Language.Haskell.Tools.BackendGHC.Patterns (trfPattern)
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.TH (trfSplice)
+import Language.Haskell.Tools.BackendGHC.Types
+import Language.Haskell.Tools.BackendGHC.Utils
+
+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)
+
+trfDecls :: TransformName n r => [LHsDecl n] -> Trf (AnnListG AST.UDecl (Dom r) RangeStage)
+trfDecls decls = addToCurrentScope decls $ makeIndentedListNewlineBefore atTheEnd (mapM trfDecl decls)
+
+trfDeclsGroup :: forall n r . TransformName n r => HsGroup n -> Trf (AnnListG AST.UDecl (Dom r) RangeStage)
+trfDeclsGroup (HsGroup vals splices tycls insts derivs fixities defaults foreigns warns anns rules vects _)
+  = do rdrSpls <- asks declSplices -- now we don't want to rename the splices, just interested in their locations to
+                                   -- filter out the declarations that are generated from them
+       let (sigs, bagToList -> binds) = getBindsAndSigs vals
+           -- collect the declarations from the group
+           alldecls :: [Located (HsDecl n)]
+           alldecls = (map (fmap SpliceD) splices)
+                        ++ (map (fmap ValD) binds)
+                        ++ (map (fmap SigD) sigs)
+                        ++ (map (fmap TyClD) (concat $ map group_tyclds tycls))
+                        ++ (map (fmap InstD) insts)
+                        ++ (map (fmap DerivD) derivs)
+                        ++ (map (fmap (SigD . FixSig)) (mergeFixityDefs fixities))
+                        ++ (map (fmap DefD) defaults)
+                        ++ (map (fmap ForD) foreigns)
+                        ++ (map (fmap WarningD) warns)
+                        ++ (map (fmap AnnD) anns)
+                        ++ (map (fmap RuleD) rules)
+                        ++ (map (fmap VectD) vects)
+       -- Declarations generated from TH should only be in scope after the splice.
+       let (genNames, sourceNames) = partition (\d -> any (\spl -> getLoc spl `containsRealSpan` getLoc d) rdrSpls) alldecls
+       addToCurrentScope sourceNames $ do
+         -- use the definitions generated by previous splices when renaming one
+         spls <- asks declSplices >>= mapM (\(L l e) -> let namesGeneratedBefore = filter ((srcSpanStart l >) . srcSpanEnd . getLoc) genNames
+                                                         in addToCurrentScope namesGeneratedBefore ((L l) <$> transformSplice e))
+         let actualDefinitions = removeContained $ orderElems $ replaceSpliceDecls spls alldecls
+           in makeIndentedListNewlineBefore atTheEnd
+                (orderDefs <$> ((++) <$> getDeclsToInsert <*> (mapM (trfDeclsWithScope genNames) actualDefinitions)))
+  where
+    -- use the definitions generated by previous splices when transforming a definition
+    trfDeclsWithScope genNames d = local (\s -> s {declSplices = []})
+                                     $ addToCurrentScope namesGeneratedBefore (trfDecl d)
+      where namesGeneratedBefore = filter ((srcSpanStart (getLoc d) >) . srcSpanEnd . getLoc) genNames
+
+    replaceSpliceDecls :: [Located (HsSplice n)] -> [Located (HsDecl n)] -> [Located (HsDecl n)]
+    replaceSpliceDecls splices decls = foldl mergeSplice decls splices
+
+    orderElems :: [Located a] -> [Located a]
+    orderElems = sortOn (srcSpanStart . getLoc)
+
+    removeContained :: [Located (HsDecl n)] -> [Located (HsDecl n)]
+    removeContained (fst:snd:rest) | getLoc fst `containsRealSpan` getLoc snd
+      = removeContained (fst:rest)
+    removeContained (fst:rest) = fst : removeContained rest
+    removeContained [] = []
+
+    (RealSrcSpan sp1) `containsRealSpan` (RealSrcSpan sp2) = sp1 `containsSpan` sp2
+    _ `containsRealSpan` _ = False
+
+    mergeSplice :: [Located (HsDecl n)] -> Located (HsSplice n) -> [Located (HsDecl n)]
+    mergeSplice decls spl@(L spLoc@(RealSrcSpan rss) _)
+      = L spLoc (SpliceD (SpliceDecl spl ExplicitSplice)) : filter (\(L (RealSrcSpan rdsp) _) -> not (rss `containsSpan` rdsp)) decls
+    mergeSplice _ (L (UnhelpfulSpan {}) _) = error "mergeSplice: no real span"
+
+    getDeclsToInsert :: Trf [Ann AST.UDecl (Dom r) RangeStage]
+    getDeclsToInsert = do decls <- asks declsToInsert
+                          allLocals <- asks localsInScope
+                          case allLocals of locals:_ -> liftGhc $ mapM (loadIdsForDecls (map (^. _1) 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
+               where findName rdr = pure $ fromGHCName $ fromMaybe (error $ "Data definition name not found: " ++ showSDocUnsafe (ppr rdr)
+                                                                              ++ ", locals: " ++ (concat $ intersperse ", " $ map (showSDocUnsafe . ppr) locals))
+                                                       $ find ((occNameString (rdrNameOcc rdr) ==) . occNameString . nameOccName) locals
+
+trfDecl :: TransformName n r => Located (HsDecl n) -> Trf (Ann AST.UDecl (Dom r) RangeStage)
+trfDecl = trfLocNoSema $ \case
+  TyClD (FamDecl (FamilyDecl (ClosedTypeFamily typeEqs) name tyVars kindSig inj))
+    -> AST.UClosedTypeFamilyDecl <$> focusAfter AnnType (createDeclHead name tyVars)
+                                <*> trfFamilyResultSig kindSig inj
+                                <*> trfTypeEqs typeEqs
+  TyClD (FamDecl fd) -> AST.UTypeFamilyDecl <$> annContNoSema (trfTypeFam' fd)
+  TyClD (SynDecl name vars rhs _)
+    -> AST.UTypeDecl <$> between AnnType AnnEqual (createDeclHead name vars) <*> trfType rhs
+  TyClD (DataDecl name vars (HsDataDefn nd ctx _ kind cons derivs) _ _)
+    -> do let ctxTok = case nd of DataType -> AnnData
+                                  NewType -> AnnNewtype
+              consLoc = focusBeforeIfPresent AnnDeriving atTheEnd
+          whereLoc <- tokenLoc AnnWhere
+          if isGoodSrcSpan whereLoc then trfGADT nd name vars ctx kind cons derivs ctxTok consLoc
+                                    else trfDataDef nd name vars ctx cons derivs ctxTok consLoc
+  TyClD (ClassDecl ctx name vars funDeps sigs defs typeFuns typeFunDefs _ _)
+    -> AST.UClassDecl <$> trfCtx (after AnnClass) ctx
+                     <*> betweenIfPresent AnnClass AnnWhere (createDeclHead name vars)
+                     <*> trfFunDeps funDeps
+                     <*> createClassBody sigs defs typeFuns typeFunDefs
+  InstD (ClsInstD (ClsInstDecl typ binds sigs typefam datafam overlap))
+    -> AST.UInstDecl <$> trfMaybeDefault " " "" trfOverlap (after AnnInstance) overlap
+                    <*> trfInstanceRule (hsib_body typ)
+                    <*> trfInstBody binds sigs typefam datafam
+  InstD (DataFamInstD (DataFamInstDecl con pats (HsDataDefn nd _ _ _ cons derivs) _))
+    | all ((\case ConDeclH98{} -> True; _ -> False) . unLoc) cons
+    -> AST.UDataInstDecl <$> trfDataKeyword nd
+                        <*> (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 (DataFamInstD (DataFamInstDecl con pats (HsDataDefn nd _ _ kind cons _) _))
+    -> AST.UGDataInstDecl <$> trfDataKeyword nd
+                        <*> (focusAfter AnnInstance . focusBeforeIfPresent AnnWhere)
+                              (makeInstanceRuleTyVars con pats)
+                        <*> focusBefore AnnWhere (trfKindSig kind)
+                        <*> makeIndentedListBefore " where " atTheEnd (mapM trfGADTConDecl cons)
+  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)
+  RuleD (HsRules _ rules) -> AST.UPragmaDecl <$> annContNoSema (AST.URulePragma <$> makeIndentedList (before AnnClose) (mapM trfRewriteRule rules))
+  RoleAnnotD (RoleAnnotDecl name roles) -> AST.URoleDecl <$> trfQualifiedName False name <*> makeList " " atTheEnd (mapM trfRole roles)
+  DefD (DefaultDecl types) -> AST.UDefaultDecl <$> makeList "," (after AnnOpenP) (mapM trfType types)
+  ForD (ForeignImport name (hsib_body -> typ) _ (CImport ccall safe _ _ _))
+    -> AST.UForeignImport <$> trfCallConv ccall <*> trfSafety (getLoc ccall) safe <*> define (trfName name) <*> trfType typ
+  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 <$> trfSplice spl
+  WarningD (Warnings _ [])
+    -> AST.UPragmaDecl <$> annContNoSema (AST.UDeprPragma <$> (makeList " " (after AnnOpen) (pure []))
+                                                          <*> makeList ", " (before AnnClose) (pure []))
+  WarningD (Warnings _ [L _ (Warning names (DeprecatedTxt _ stringLits))])
+    -> AST.UPragmaDecl <$> annContNoSema (AST.UDeprPragma <$> (makeList " " (after AnnOpen) $ mapM trfName names)
+                                                          <*> makeList ", " (before AnnClose) (mapM (\(L l (StringLiteral _ fs)) -> trfFastString (L l fs)) stringLits))
+  WarningD (Warnings _ [L _ (Warning names (WarningTxt _ stringLits))])
+    -> AST.UPragmaDecl <$> annContNoSema (AST.UWarningPragma <$> (makeNonemptyList " " $ mapM trfName names)
+                                                             <*> makeList ", " (before AnnClose) (mapM (\(L l (StringLiteral _ fs)) -> trfFastString (L l fs)) stringLits))
+  AnnD (HsAnnotation stxt subject expr)
+    -> AST.UPragmaDecl <$> annContNoSema (AST.UAnnPragma <$> trfAnnotationSubject stxt subject (srcSpanStart $ getLoc expr) <*> trfExpr expr)
+  d -> unhandledElement "declaration" d
+
+trfGADT :: TransformName n r => NewOrData -> Located n -> LHsQTyVars n -> Located (HsContext n)
+                                 -> Maybe (Located (HsKind n)) -> [Located (ConDecl n)]
+                                 -> Maybe (Located [LHsSigType n]) -> AnnKeywordId -> Trf SrcLoc -> Trf (AST.UDecl (Dom r) RangeStage)
+trfGADT nd name vars ctx kind cons derivs ctxTok consLoc
+  = AST.UGDataDecl <$> trfDataKeyword nd
+                   <*> trfCtx (after ctxTok) ctx
+                   <*> betweenIfPresent ctxTok AnnEqual (createDeclHead name vars)
+                   <*> focusBefore AnnWhere (trfKindSig kind)
+                   <*> makeIndentedListBefore " where " consLoc (mapM trfGADTConDecl cons)
+                   <*> trfMaybe "" "" trfDerivings derivs
+
+trfDataDef :: TransformName n r => NewOrData -> Located n -> LHsQTyVars n -> Located (HsContext n)
+                                     -> [Located (ConDecl n)] -> Maybe (Located [LHsSigType n])
+                                     -> AnnKeywordId -> Trf SrcLoc -> Trf (AST.UDecl (Dom r) RangeStage)
+trfDataDef nd name vars ctx cons derivs ctxTok consLoc
+  = AST.UDataDecl <$> trfDataKeyword nd
+                  <*> trfCtx (after ctxTok) ctx
+                  <*> betweenIfPresent ctxTok AnnEqual (createDeclHead name vars)
+                  <*> makeListBefore "=" " | " consLoc (mapM trfConDecl cons)
+                  <*> trfMaybe "" "" trfDerivings derivs
+
+trfVal :: TransformName n r => HsBindLR n n -> Trf (AST.UDecl (Dom r) RangeStage)
+trfVal (PatSynBind psb) = AST.UPatternSynonymDecl <$> annContNoSema (trfPatternSynonym psb)
+trfVal bind = AST.UValueBinding <$> (annContNoSema $ trfBind' bind)
+
+trfSig :: TransformName n r => Sig n -> Trf (AST.UDecl (Dom r) RangeStage)
+trfSig (ts @ (TypeSig {})) = AST.UTypeSigDecl <$> defineTypeVars (annContNoSema $ trfTypeSig' ts)
+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 prag)
+  = AST.UPragmaDecl <$> annContNoSema (AST.UInlinePragmaDecl <$> trfInlinePragma name prag)
+trfSig (SpecSig name (map hsib_body -> types) (inl_act -> phase))
+  = AST.UPragmaDecl <$> annContNoSema (AST.USpecializeDecl <$> trfSpecializePragma name types phase)
+trfSig s = unhandledElement "signature" s
+
+trfSpecializePragma :: TransformName n r
+                    => Located n -> [Located (HsType n)] -> Activation -> Trf (Ann AST.USpecializePragma (Dom r) RangeStage)
+trfSpecializePragma name types phase
+  = annContNoSema $ AST.USpecializePragma <$> trfPhase (pure $ srcSpanStart (getLoc name)) phase
+                                          <*> trfName name
+                                          <*> (orderAnnList <$> trfAnnList ", " trfType' types)
+
+trfConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.UConDecl (Dom r) RangeStage)
+trfConDecl = trfLocNoSema trfConDecl'
+
+trfConDecl' :: TransformName n r => ConDecl n -> Trf (AST.UConDecl (Dom r) RangeStage)
+trfConDecl' (ConDeclH98 { con_name = name, con_qvars = tyVars, con_cxt = ctx, con_details = PrefixCon args })
+  = AST.UConDecl <$> trfConTyVars tyVars <*> trfConCtx ctx <*> define (trfName name) <*> makeList " " atTheEnd (mapM trfType args)
+trfConDecl' (ConDeclH98 { con_name = name, con_qvars = tyVars, con_cxt = ctx, con_details = RecCon (unLoc -> flds) })
+  = AST.URecordDecl <$> trfConTyVars tyVars <*> trfConCtx ctx <*> define (trfName name) <*> (between AnnOpenC AnnCloseC $ trfAnnList ", " trfFieldDecl' flds)
+trfConDecl' (ConDeclH98 { con_name = name, con_qvars = tyVars, con_cxt = ctx, con_details = InfixCon t1 t2 })
+  = AST.UInfixConDecl <$> trfConTyVars tyVars <*> trfConCtx ctx <*> trfType t1 <*> define (trfOperator name) <*> trfType t2
+trfConDecl' gadt@(ConDeclGADT {}) = unhandledElement "normal constructor declaration" gadt
+
+trfConTyVars :: TransformName n r => Maybe (LHsQTyVars n) -> Trf (AnnListG AST.UTyVar (Dom r) RangeStage)
+trfConTyVars Nothing = makeListAfter "." " " atTheStart (return [])
+trfConTyVars (Just vars) = trfBindings $ hsq_explicit vars
+
+trfConCtx :: TransformName n r => Maybe (LHsContext n) -> Trf (AnnMaybeG AST.UContext (Dom r) RangeStage)
+trfConCtx Nothing = nothing "" " => " atTheStart
+trfConCtx (Just ctx) = trfCtx atTheStart ctx
+
+trfGADTConDecl :: TransformName n r => Located (ConDecl n) -> Trf (Ann AST.UGadtConDecl (Dom r) RangeStage)
+trfGADTConDecl = trfLocNoSema trfGADTConDecl'
+
+trfGADTConDecl' :: TransformName n r => ConDecl n -> Trf (AST.UGadtConDecl (Dom r) RangeStage)
+trfGADTConDecl' (ConDeclGADT { con_names = names, con_type = hsib_body -> typ })
+  = let nameLoc = collectLocs names
+        typLoc = getLoc typ
+        (vars, ctx, t) = getTypeVarsAndCtx typ
+     in AST.UGadtConDecl <$> define (trfAnnList ", " trfName' names)
+                         <*> focusOn (mkSrcSpan (srcSpanEnd nameLoc) (srcSpanStart typLoc)) (trfBindings vars)
+                         <*> updateFocus (return . updateEnd (\_ -> srcSpanStart typLoc)) (focusAfterIfPresent AnnDot (trfCtx atTheStart ctx))
+                         <*> trfGadtConType t
+  where getTypeVarsAndCtx :: LHsType n -> ([LHsTyVarBndr n], LHsContext n, LHsType n)
+        getTypeVarsAndCtx (L _ (HsForAllTy [] typ)) = getTypeVarsAndCtx typ
+        getTypeVarsAndCtx (L _ (HsForAllTy bndrs typ)) = let (_,ctx,t) = getTypeVarsAndCtx typ in (bndrs, ctx, t)
+        getTypeVarsAndCtx (L _ (HsQualTy ctx typ)) = let (vars,_,t) = getTypeVarsAndCtx typ in (vars, ctx, t)
+        getTypeVarsAndCtx t = ([], L noSrcSpan [], t)
+
+trfGadtConType :: TransformName n r => Located (HsType n) -> Trf (Ann AST.UGadtConType (Dom r) RangeStage)
+trfGadtConType = trfLocNoSema $ \case
+  HsFunTy (cleanHsType . unLoc -> HsRecTy flds) resType
+    -> AST.UGadtRecordType <$> between AnnOpenC AnnCloseC (trfAnnList ", " trfFieldDecl' flds)
+                           <*> trfType resType
+  typ -> AST.UGadtNormalType <$> annContNoSema (trfType' typ)
+
+trfFieldDecl :: TransformName n r => Located (ConDeclField n) -> Trf (Ann AST.UFieldDecl (Dom r) RangeStage)
+trfFieldDecl = trfLocNoSema trfFieldDecl'
+
+trfFieldDecl' :: TransformName n r => ConDeclField n -> Trf (AST.UFieldDecl (Dom r) RangeStage)
+trfFieldDecl' (ConDeclField names typ _) = AST.UFieldDecl <$> (define $ nonemptyAnnList <$> mapM (trfName . getFieldOccName) names) <*> trfType typ
+
+trfDerivings :: TransformName n r => Located [LHsSigType n] -> Trf (Ann AST.UDeriving (Dom r) RangeStage)
+trfDerivings = trfLocNoSema $ \case
+  [hsib_body -> typ@(unLoc -> HsTyVar {})] -> AST.UDerivingOne <$> trfInstanceHead typ
+  derivs -> AST.UDerivings <$> trfAnnList ", " trfInstanceHead' (map hsib_body derivs)
+
+trfInstanceRule :: TransformName n r => Located (HsType n) -> Trf (Ann AST.UInstanceRule (Dom r) RangeStage)
+trfInstanceRule = trfLocNoSema (trfInstanceRule' . cleanHsType)
+
+trfInstanceRule' :: TransformName n r => HsType n -> Trf (AST.UInstanceRule (Dom r) RangeStage)
+trfInstanceRule' (HsForAllTy bndrs (unLoc -> HsQualTy ctx typ))
+  = AST.UInstanceRule <$> (makeJust <$> annLocNoSema (pure $ collectLocs bndrs) (trfBindings bndrs))
+                      <*> trfCtx (after AnnDot) ctx
+                      <*> trfInstanceHead typ
+trfInstanceRule' (HsQualTy ctx typ) = AST.UInstanceRule <$> nothing "" " . " atTheStart
+                                                        <*> trfCtx atTheStart ctx
+                                                        <*> trfInstanceHead typ
+trfInstanceRule' (HsParTy typ) = instanceHead $ annContNoSema (AST.UInstanceHeadParen <$> trfInstanceHead typ)
+trfInstanceRule' (HsTyVar tv) = instanceHead $ annContNoSema (AST.UInstanceHeadCon <$> trfName tv)
+trfInstanceRule' (HsAppTy t1 t2) = instanceHead $ annContNoSema (AST.UInstanceHeadApp <$> trfInstanceHead t1 <*> trfType t2)
+trfInstanceRule' (HsOpTy t1 op t2) = instanceHead $ annContNoSema (AST.UInstanceHeadApp <$> annLocNoSema (pure $ getLoc t1 `combineSrcSpans` getLoc op) (AST.UInstanceHeadInfix <$> trfType t1 <*> trfOperator op) <*> trfType t2)
+trfInstanceRule' t = unhandledElement "instance rule" t
+
+instanceHead :: Trf (Ann AST.UInstanceHead (Dom r) RangeStage) -> Trf (AST.UInstanceRule (Dom r) RangeStage)
+instanceHead hd = AST.UInstanceRule <$> (nothing "" " . " atTheStart) <*> (nothing " " "" atTheStart) <*> hd
+
+makeInstanceRuleTyVars :: TransformName n r => Located n -> HsImplicitBndrs n [LHsType n] -> Trf (Ann AST.UInstanceRule (Dom r) RangeStage)
+makeInstanceRuleTyVars n vars
+  | isSymOcc (occName (unLoc n))
+  , leftOp:rest <- hsib_body vars
+  , srcSpanStart (getLoc n) > srcSpanEnd (getLoc leftOp)
+  = annContNoSema
+      $ AST.UInstanceRule <$> nothing "" " . " atTheStart
+                          <*> nothing " " "" atTheStart
+                          <*> foldl foldTypeArgs
+                                    (annLocNoSema (pure $ combineSrcSpans (getLoc leftOp) (getLoc n))
+                                      (AST.UInstanceHeadInfix <$> trfType leftOp <*> trfOperator n)) rest
+  | otherwise
+  = annContNoSema
+      $ AST.UInstanceRule <$> nothing "" " . " atTheStart
+                          <*> nothing " " "" atTheStart
+                          <*> foldl foldTypeArgs (copyAnnot AST.UInstanceHeadCon (trfName n)) (hsib_body vars)
+  where foldTypeArgs base typ = annLocNoSema (pure $ combineSrcSpans (getLoc n) (getLoc typ)) $ AST.UInstanceHeadApp <$> base <*> (trfType typ)
+
+
+trfInstanceHead :: TransformName n r => Located (HsType n) -> Trf (Ann AST.UInstanceHead (Dom r) RangeStage)
+trfInstanceHead = trfLocNoSema trfInstanceHead'
+
+trfInstanceHead' :: TransformName n r => HsType n -> Trf (AST.UInstanceHead (Dom r) RangeStage)
+trfInstanceHead' = trfInstanceHead'' . cleanHsType where
+  trfInstanceHead'' (HsForAllTy [] (unLoc -> t)) = trfInstanceHead' t
+  trfInstanceHead'' (HsTyVar tv) = AST.UInstanceHeadCon <$> trfName tv
+  trfInstanceHead'' (HsAppTy t1 t2) = AST.UInstanceHeadApp <$> trfInstanceHead t1 <*> trfType t2
+  trfInstanceHead'' (HsParTy typ) = AST.UInstanceHeadParen <$> trfInstanceHead typ
+  trfInstanceHead'' (HsOpTy t1 op t2)
+    = AST.UInstanceHeadApp <$> (annLocNoSema (pure $ combineSrcSpans (getLoc t1) (getLoc op))
+                                             (AST.UInstanceHeadInfix <$> trfType t1 <*> trfOperator op))
+                          <*> trfType t2
+  trfInstanceHead'' t = unhandledElement "instance head" t
+
+trfTypeEqs :: TransformName n r => Maybe [Located (TyFamInstEqn n)] -> Trf (AnnListG AST.UTypeEqn (Dom r) RangeStage)
+trfTypeEqs eqs =
+  do toks <- tokensAfter AnnWhere
+     case toks of [] -> error "trfTypeEqs: no where found after closed type family"
+                  loc:_ -> makeList "\n" (pure $ srcSpanStart loc) (mapM trfTypeEq (fromMaybe [] eqs))
+
+trfTypeEq :: TransformName n r => Located (TyFamInstEqn n) -> Trf (Ann AST.UTypeEqn (Dom r) RangeStage)
+trfTypeEq = trfLocNoSema $ \(TyFamEqn name pats rhs)
+  -> AST.UTypeEqn <$> defineTypeVars (focusBefore AnnEqual (combineTypes name (hsib_body pats))) <*> trfType rhs
+  where combineTypes :: TransformName n r => Located n -> [LHsType n] -> Trf (Ann AST.UType (Dom r) RangeStage)
+        combineTypes name [lhs, rhs] | srcSpanStart (getLoc name) > srcSpanEnd (getLoc lhs)
+          = annContNoSema $ AST.UTyInfix <$> trfType lhs <*> trfOperator name <*> trfType rhs
+        combineTypes name pats = wrapTypes (annLocNoSema (pure $ getLoc name) (AST.UTyVar <$> trfName name)) pats
+
+        wrapTypes :: TransformName n r => Trf (Ann AST.UType (Dom r) RangeStage) -> [LHsType n] -> Trf (Ann AST.UType (Dom r) RangeStage)
+        wrapTypes base pats
+          = foldl (\t p -> do typ <- t
+                              annLocNoSema (pure $ combineSrcSpans (getRange typ) (getLoc p))
+                                     (AST.UTyApp <$> pure typ <*> trfType p)) base pats
+
+trfFunDeps :: TransformName n r => [Located (FunDep (Located n))] -> Trf (AnnMaybeG AST.UFunDeps (Dom r) RangeStage)
+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)
+
+trfFunDep' :: TransformName n r => FunDep (Located n) -> Trf (AST.UFunDep (Dom r) RangeStage)
+trfFunDep' (lhs, rhs) = AST.UFunDep <$> trfAnnList ", " trfName' lhs <*> trfAnnList ", " trfName' rhs
+
+createDeclHead :: TransformName n r => Located n -> LHsQTyVars n -> Trf (Ann AST.UDeclHead (Dom r) RangeStage)
+createDeclHead name (hsq_explicit -> lhs : rhs : rest)
+  | srcSpanStart (getLoc name) > srcSpanEnd (getLoc lhs)
+  -- infix declaration
+  = wrapDeclHead rest
+      $ annLocNoSema (addParenLocs $ getLoc lhs `combineSrcSpans` getLoc rhs)
+                     (AST.UDHInfix <$> defineTypeVars (trfTyVar lhs) <*> define (trfOperator name) <*> defineTypeVars (trfTyVar rhs))
+createDeclHead name vars = defineTypeVars $ wrapDeclHead (hsq_explicit vars) (define $ copyAnnot AST.UDeclHead (trfName name))
+
+wrapDeclHead :: TransformName n r => [LHsTyVarBndr n] -> Trf (Ann AST.UDeclHead (Dom r) RangeStage) -> Trf (Ann AST.UDeclHead (Dom r) RangeStage)
+wrapDeclHead vars base
+  = foldl (\t p -> do typ <- t
+                      annLocNoSema (addParenLocs $ combineSrcSpans (getRange typ) (getLoc p))
+                             (AST.UDHApp typ <$> trfTyVar p)
+          ) base vars
+
+-- | Get the parentheses directly before and after (for parenthesized application)
+addParenLocs :: SrcSpan -> Trf SrcSpan
+addParenLocs sp
+  = let possibleSpan = mkSrcSpan (updateCol (subtract 1) (srcSpanStart sp)) (updateCol (+1) (srcSpanEnd sp))
+     in local (\s -> s { contRange = possibleSpan })
+              (combineSrcSpans <$> (combineSrcSpans sp <$> tokenLoc AnnOpenP) <*> tokenLocBack AnnCloseP)
+
+
+createClassBody :: TransformName n r => [LSig n] -> LHsBinds n -> [LFamilyDecl n]
+                               -> [LTyFamDefltEqn n] -> Trf (AnnMaybeG AST.UClassBody (Dom r) RangeStage)
+createClassBody sigs binds typeFams typeFamDefs
+  = do isThereWhere <- isGoodSrcSpan <$> (tokenLoc AnnWhere)
+       if isThereWhere
+         then makeJust <$> annLocNoSema (combinedLoc <$> tokenLoc AnnWhere)
+                                        (AST.UClassBody <$> makeList "" (after AnnWhere)
+                                                                       (orderDefs . concat <$> sequenceA allDefs))
+         else nothing " where " "" atTheEnd
+  where combinedLoc wh = foldl combineSrcSpans wh allLocs
+        allLocs = map getLoc sigs ++ map getLoc (bagToList binds) ++ map getLoc typeFams ++ map getLoc typeFamDefs
+        allDefs = [getSigs, getBinds, getFams, getFamDefs]
+        getSigs = mapM trfClassElemSig sigs
+        getBinds = mapM (copyAnnot AST.UClsDef . trfBind) (bagToList binds)
+        getFams = mapM (copyAnnot AST.UClsTypeFam . trfTypeFam) typeFams
+        getFamDefs = mapM trfTypeFamDef typeFamDefs
+
+trfClassElemSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.UClassElement (Dom r) RangeStage)
+trfClassElemSig = trfLocNoSema $ \case
+  TypeSig names typ -> AST.UClsSig <$> (annContNoSema $ AST.UTypeSignature <$> define (makeNonemptyList ", " (mapM trfName names))
+                                  <*> trfType (hswc_body $ hsib_body typ))
+  ClassOpSig True [name] typ -> AST.UClsDefSig <$> trfName name <*> trfType (hsib_body typ)
+  ClassOpSig False names typ -> AST.UClsSig <$> (annContNoSema $ AST.UTypeSignature <$> define (makeNonemptyList ", " (mapM trfName names))
+                                           <*> trfType (hsib_body typ))
+  MinimalSig _ formula -> AST.UClsMinimal <$> trfMinimalFormula formula
+  InlineSig name prag -> AST.UClsInline <$> trfInlinePragma name prag
+  FixSig fixity -> AST.UClsFixity <$> annContNoSema (trfFixitySig fixity)
+  s -> unhandledElement "signature in class" s
+
+trfTypeFam :: TransformName n r => Located (FamilyDecl n) -> Trf (Ann AST.UTypeFamily (Dom r) RangeStage)
+trfTypeFam = trfLocNoSema trfTypeFam'
+
+trfTypeFam' :: TransformName n r => FamilyDecl n -> Trf (AST.UTypeFamily (Dom r) RangeStage)
+trfTypeFam' (FamilyDecl DataFamily name tyVars kindSig _)
+  = AST.UDataFamily <$> (case unLoc kindSig of KindSig _ -> between AnnData AnnDcolon; _ -> id) (createDeclHead name tyVars)
+                   <*> trfFamilyKind kindSig
+trfTypeFam' (FamilyDecl OpenTypeFamily name tyVars kindSig injectivity)
+  = AST.UTypeFamily <$> (case unLoc kindSig of KindSig _ -> between AnnType AnnDcolon; _ -> id) (createDeclHead name tyVars)
+                   <*> trfFamilyResultSig kindSig injectivity
+trfTypeFam' (FamilyDecl (ClosedTypeFamily {}) _ _ _ _) = error "trfTypeFam': closed type family received"
+
+trfTypeFamDef :: TransformName n r => Located (TyFamDefltEqn n) -> Trf (Ann AST.UClassElement (Dom r) RangeStage)
+trfTypeFamDef = trfLocNoSema $ \(TyFamEqn con pats rhs)
+  -> AST.UClsTypeDef <$> between AnnType AnnEqual (createDeclHead con pats) <*> trfType rhs
+
+trfInstBody :: TransformName n r => LHsBinds n -> [LSig n] -> [LTyFamInstDecl n] -> [LDataFamInstDecl n] -> Trf (AnnMaybeG AST.UInstBody (Dom r) RangeStage)
+trfInstBody binds sigs fams dats = do
+    wh <- tokenLoc AnnWhere
+    if isGoodSrcSpan wh then
+      makeJust <$> annLocNoSema (combinedLoc <$> tokenLoc AnnWhere)
+                                (AST.UInstBody <$> (makeList "" (after AnnWhere)
+                                                      (orderDefs . concat <$> sequenceA allDefs)))
+    else nothing " where " "" atTheEnd
+  where combinedLoc wh = foldl combineSrcSpans wh allLocs
+        allLocs = map getLoc sigs ++ map getLoc (bagToList binds) ++ map getLoc fams ++ map getLoc dats
+        allDefs = [getSigs, getBinds, getFams, getDats]
+        getSigs = mapM trfClassInstSig sigs
+        getBinds = mapM (copyAnnot AST.UInstBodyNormalDecl . trfBind) (bagToList binds)
+        getFams = mapM trfInstTypeFam fams
+        getDats = mapM trfInstDataFam dats
+
+trfClassInstSig :: TransformName n r => Located (Sig n) -> Trf (Ann AST.UInstBodyDecl (Dom r) RangeStage)
+trfClassInstSig = trfLocNoSema $ \case
+  TypeSig names typ -> AST.UInstBodyTypeSig <$> (annContNoSema $ AST.UTypeSignature <$> makeNonemptyList ", " (mapM trfName names)
+                                           <*> trfType (hswc_body $ hsib_body typ))
+  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)
+  SpecSig name (map hsib_body -> tys) (inl_act -> phase) -> AST.UInstanceSpecialize <$> trfSpecializePragma name tys phase
+  InlineSig name prag -> AST.UInlineInstance <$> trfInlinePragma name prag
+  s -> unhandledElement "class instance signature" s
+
+trfInstTypeFam :: TransformName n r => Located (TyFamInstDecl n) -> Trf (Ann AST.UInstBodyDecl (Dom r) RangeStage)
+trfInstTypeFam (unLoc -> TyFamInstDecl eqn _) = copyAnnot AST.UInstBodyTypeDecl (trfTypeEq eqn)
+
+trfInstDataFam :: TransformName n r => Located (DataFamInstDecl n) -> Trf (Ann AST.UInstBodyDecl (Dom r) RangeStage)
+trfInstDataFam = trfLocNoSema $ \case
+  (DataFamInstDecl tc (hsib_body -> pats) (HsDataDefn dn ctx _ ks cons derivs) _)
+    | all ((\case ConDeclH98{} -> True; _ -> False) . unLoc) cons
+    -> AST.UInstBodyDataDecl
+         <$> trfDataKeyword dn
+         <*> annLocNoSema (pure $ collectLocs pats `combineSrcSpans` getLoc tc `combineSrcSpans` getLoc ctx)
+                          (AST.UInstanceRule <$> nothing "" " . " atTheStart
+                                             <*> trfCtx atTheStart ctx
+                                             <*> transformNameAndPats tc pats)
+         <*> trfAnnList "" trfConDecl' cons
+         <*> trfMaybe " deriving " "" trfDerivings derivs
+    | otherwise
+    -> AST.UInstBodyGadtDataDecl
+        <$> trfDataKeyword dn
+        <*> annLocNoSema (pure $ collectLocs pats `combineSrcSpans` getLoc tc `combineSrcSpans` getLoc ctx)
+                         (AST.UInstanceRule <$> nothing "" " . " atTheStart
+                                            <*> trfCtx atTheStart ctx
+                                            <*> transformNameAndPats tc pats)
+        <*> trfKindSig ks
+        <*> trfAnnList "" trfGADTConDecl' cons
+        <*> trfMaybe " deriving " "" trfDerivings derivs
+  where transformNameAndPats tc pats
+          | all (\p -> srcSpanEnd (getLoc tc) < srcSpanStart (getLoc p)) pats -- prefix instance head application
+          = foldl (\r t -> annLocNoSema (combineSrcSpans (getLoc t) . getRange <$> r)
+                                          (AST.UInstanceHeadApp <$> r <*> (trfType t)))
+                  (copyAnnot AST.UInstanceHeadCon (trfName tc)) pats
+        transformNameAndPats tc (p:rest)
+          | otherwise -- infix instance head application
+          = foldl (\r t -> annLocNoSema (combineSrcSpans (getLoc t) . getRange <$> r)
+                                          (AST.UInstanceHeadApp <$> r <*> (trfType t)))
+                  (annLocNoSema (pure $ getLoc p `combineSrcSpans` getLoc tc)
+                          (AST.UInstanceHeadInfix <$> trfType p <*> trfOperator tc)) rest
+
+trfPatternSynonym :: forall n r . TransformName n r => PatSynBind n n -> Trf (AST.UPatternSynonym (Dom r) RangeStage)
+trfPatternSynonym (PSB id _ lhs def dir)
+  = let sep = case dir of ImplicitBidirectional -> AnnEqual
+                          _                     -> AnnLarrow
+        rhsLoc = combineSrcSpans (getLoc def) <$> tokenLoc sep
+        -- we use the selector name instead of the pattern variable name
+        rewrites = case lhs of RecordPatSyn flds -> map (\r -> (unLoc (recordPatSynPatVar r), unLoc (recordPatSynSelectorId r))) flds
+                               _                 -> []
+        changedRhs = biplateRef .- (\n -> case lookup n rewrites of Just x -> x; Nothing -> n) $ def
+     in AST.UPatternSynonym <$> trfPatSynLhs id lhs
+                            <*> annLocNoSema rhsLoc (trfPatSynRhs dir changedRhs)
+
+  where trfPatSynLhs :: Located n -> HsPatSynDetails (Located n) -> Trf (Ann AST.UPatSynLhs (Dom r) RangeStage)
+        trfPatSynLhs id (PrefixPatSyn args)
+          = annLocNoSema (pure $ foldLocs (getLoc id : map getLoc args)) $ AST.UNormalPatSyn <$> define (trfName id) <*> trfAnnList " " trfName' args
+        trfPatSynLhs op (InfixPatSyn lhs rhs)
+          = annLocNoSema (pure $ getLoc lhs `combineSrcSpans` getLoc rhs) $ AST.UInfixPatSyn <$> define (trfName lhs) <*> trfOperator op <*> trfName rhs
+        trfPatSynLhs id (RecordPatSyn flds)
+          = annLocNoSema (mkSrcSpan (srcSpanStart (getLoc id)) <$> before AnnEqual)
+              $ AST.URecordPatSyn <$> define (trfName id) <*> trfAnnList ", " trfName' (map recordPatSynSelectorId flds)
+
+        trfPatSynRhs :: HsPatSynDir n -> Located (Pat n) -> Trf (AST.UPatSynRhs (Dom r) RangeStage)
+        trfPatSynRhs ImplicitBidirectional pat = AST.UBidirectionalPatSyn <$> trfPattern pat <*> nothing " where " "" atTheEnd
+        trfPatSynRhs (ExplicitBidirectional mg) pat = AST.UBidirectionalPatSyn <$> trfPattern pat <*> (makeJust <$> trfPatSynWhere mg)
+        trfPatSynRhs Unidirectional pat = AST.UOneDirectionalPatSyn <$> trfPattern pat
+
+        trfPatSynWhere :: MatchGroup n (LHsExpr n) -> Trf (Ann AST.UPatSynWhere (Dom r) RangeStage)
+        trfPatSynWhere (MG { mg_alts = alts }) = annLocNoSema (pure $ getLoc alts) (AST.UPatSynWhere <$> makeIndentedList (after AnnWhere) (mapM (trfMatch (unLoc id)) (unLoc alts)))
+
+trfFamilyKind :: TransformName n r => Located (FamilyResultSig n) -> Trf (AnnMaybeG AST.UKindConstraint (Dom r) RangeStage)
+trfFamilyKind (unLoc -> fr) = case fr of
+  NoSig -> nothing "" " " atTheEnd
+  KindSig k -> trfKindSig (Just k)
+  TyVarSig _ -> error "trfFamilyKind: TyVarSig not supported"
+
+trfFamilyResultSig :: TransformName n r => Located (FamilyResultSig n) -> Maybe (LInjectivityAnn n) -> Trf (AnnMaybeG AST.UTypeFamilySpec (Dom r) RangeStage)
+trfFamilyResultSig (L l fr) Nothing = case fr of
+  NoSig -> nothing "" " " atTheEnd
+  KindSig k -> makeJust <$> (annLocNoSema (pure l) $ AST.UTypeFamilyKind <$> trfKindSig' k)
+  TyVarSig tv -> makeJust <$> (annLocNoSema (pure l) $ AST.UTypeFamilyTyVar <$> trfTyVar tv)
+trfFamilyResultSig (L _ sig) (Just (L l (InjectivityAnn n deps)))
+  = makeJust <$> (annLocNoSema (pure l) $ AST.UTypeFamilyInjectivity <$> (annContNoSema $ AST.UInjectivityAnn <$> tv <*> trfAnnList ", " trfName' deps))
+    where tv = case sig of TyVarSig tv -> trfTyVar tv
+                           _ -> annLocNoSema (pure $ getLoc n) (AST.UTyVarDecl <$> trfName n <*> nothing "" "" (pure $ srcSpanEnd (getLoc n)))
+
+trfAnnotationSubject :: TransformName n r => SourceText -> AnnProvenance n -> SrcLoc -> Trf (Ann AST.UAnnotationSubject (Dom r) RangeStage)
+trfAnnotationSubject stxt subject payloadEnd
+  = do payloadStart <- advanceStr stxt <$> atTheStart
+       case subject of ValueAnnProvenance name@(L l _) -> annLocNoSema (pure l) (AST.UNameAnnotation <$> trfName name)
+                       TypeAnnProvenance name@(L l _) -> annLocNoSema (pure $ mkSrcSpan payloadStart (srcSpanEnd l))
+                                                                      (AST.UTypeAnnotation <$> trfName name)
+                       ModuleAnnProvenance -> annLocNoSema (pure $ mkSrcSpan payloadStart payloadEnd) (pure AST.UModuleAnnotation)
+
+trfDataKeyword ::  NewOrData -> Trf (Ann AST.UDataOrNewtypeKeyword (Dom r) RangeStage)
+trfDataKeyword NewType = annLocNoSema (tokenLoc AnnNewtype) (pure AST.UNewtypeKeyword)
+trfDataKeyword DataType = annLocNoSema (tokenLoc AnnData) (pure AST.UDataKeyword)
+
+trfCallConv :: Located CCallConv -> Trf (Ann AST.UCallConv (Dom r) RangeStage)
+trfCallConv = trfLocNoSema trfCallConv'
+
+trfCallConv' :: CCallConv -> Trf (AST.UCallConv (Dom r) RangeStage)
+trfCallConv' CCallConv = pure AST.UCCall
+trfCallConv' CApiConv = pure AST.UCApi
+trfCallConv' StdCallConv = pure AST.UStdCall
+trfCallConv' JavaScriptCallConv = pure AST.UJavaScript
+trfCallConv' PrimCallConv = error "trfCallConv: PrimCallConv not supported"
+
+trfSafety :: SrcSpan -> Located Safety -> Trf (AnnMaybeG AST.USafety (Dom r) RangeStage)
+trfSafety ccLoc lsaf@(L l _) | isGoodSrcSpan l
+  = makeJust <$> trfLocNoSema (pure . \case
+      PlaySafe -> AST.USafe
+      PlayInterruptible -> AST.UInterruptible
+      PlayRisky -> AST.UUnsafe) lsaf
+  | otherwise = nothing " " "" (pure $ srcSpanEnd ccLoc)
+
+trfOverlap :: Located OverlapMode -> Trf (Ann AST.UOverlapPragma (Dom r) RangeStage)
+trfOverlap = trfLocNoSema $ pure . \case
+  NoOverlap _ -> AST.UDisableOverlap
+  Overlappable _ -> AST.UOverlappable
+  Overlapping _ -> AST.UOverlapping
+  Overlaps _ -> AST.UOverlaps
+  Incoherent _ -> AST.UIncoherentOverlap
+
+trfRole :: Located (Maybe Role) -> Trf (Ann AST.URole (Dom r) RangeStage)
+trfRole = trfLocNoSema $ \case Just Nominal -> pure AST.UNominal
+                               Just Representational -> pure AST.URepresentational
+                               Just GHC.Phantom -> pure AST.UPhantom
+                               Nothing -> error "trfRole: no role"
+
+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 (pure $ srcSpanEnd nameLoc) act
+            <*> makeListAfter " " " " (pure $ srcSpanStart $ getLoc left) (mapM trfRuleBndr bndrs)
+            <*> trfExpr left
+            <*> trfExpr right
+
+trfRuleBndr :: TransformName n r => Located (RuleBndr n) -> Trf (Ann AST.URuleVar (Dom r) RangeStage)
+trfRuleBndr = trfLocNoSema $ \case (RuleBndr n) -> AST.URuleVar <$> trfName n
+                                   (RuleBndrSig n k) -> AST.USigRuleVar <$> trfName n <*> trfType (hswc_body $ hsib_body k)
+
+trfMinimalFormula :: TransformName n r => Located (BooleanFormula (Located n)) -> Trf (Ann AST.UMinimalFormula (Dom r) RangeStage)
+trfMinimalFormula = trfLocNoSema trfMinimalFormula'
+
+trfMinimalFormula' :: TransformName n r => BooleanFormula (Located n) -> Trf (AST.UMinimalFormula (Dom r) RangeStage)
+trfMinimalFormula' (Var name) = AST.UMinimalName <$> trfName name
+trfMinimalFormula' (And formulas) = AST.UMinimalAnd <$> trfAnnList " & " trfMinimalFormula' formulas
+trfMinimalFormula' (Or formulas) = AST.UMinimalOr <$> trfAnnList " | " trfMinimalFormula' formulas
+trfMinimalFormula' (Parens formula) = AST.UMinimalParen <$> trfMinimalFormula formula

@@ -0,0 +1,266 @@+{-# LANGUAGE LambdaCase
+           , ViewPatterns
+           , ScopedTypeVariables
+           , TypeApplications
+           , AllowAmbiguousTypes
+           #-}
+-- | Functions that convert the expression-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Exprs where
+
+import Control.Monad.Reader
+import Data.Function (on)
+import Data.List
+import Data.Maybe (Maybe(..), isJust, fromMaybe, catMaybes)
+
+import BasicTypes as GHC (Boxity(..), StringLiteral(..))
+import FastString (unpackFS)
+import GHC
+import OccName as GHC (occNameString)
+import PrelNames as GHC (negateName)
+import SrcLoc as GHC
+
+import Language.Haskell.Tools.AST.SemaInfoTypes (ScopeInfo, mkScopeInfo)
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.Binds (trfRhsGuard', trfWhereLocalBinds, trfLocalBinds)
+import Language.Haskell.Tools.BackendGHC.GHCUtils (GHCName(..), getFieldOccName)
+import Language.Haskell.Tools.BackendGHC.Literals (trfLiteral', trfOverloadedLit)
+import Language.Haskell.Tools.BackendGHC.Monad
+import Language.Haskell.Tools.BackendGHC.Names
+import Language.Haskell.Tools.BackendGHC.Patterns (trfPattern)
+import Language.Haskell.Tools.BackendGHC.Stmts
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.TH (trfBracket', trfSplice, trfQuasiQuotation')
+import Language.Haskell.Tools.BackendGHC.Types (trfType)
+import Language.Haskell.Tools.BackendGHC.Utils
+
+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)
+-- correction for empty cases
+trfExpr (L l cs@(HsCase expr (unLoc . mg_alts -> [])))
+  = do let realSpan = combineSrcSpans l (getLoc expr)
+       tokensAfter <- allTokensAfter (srcSpanEnd realSpan)
+       let actualSpan = case take 3 tokensAfter of
+                          [(_, AnnOf), (_, AnnOpenC), (endSpan, AnnCloseC)] -> realSpan `combineSrcSpans` endSpan
+                          ((endSpan, AnnOf) : _) -> realSpan `combineSrcSpans` endSpan
+                          _ -> error "trfExpr: case without 'of' '{' or '}' token"
+       annLoc createScopeInfo (pure actualSpan) (trfExpr' cs)
+trfExpr e | RealSrcSpan loce <- getLoc e
+  = do exprSpls <- asks exprSplices
+       let contSplice = filter (\sp -> case getLoc sp of (RealSrcSpan spLoc) -> spLoc `containsSpan` loce; _ -> False) exprSpls
+       case contSplice of
+         [] -> trfLoc trfExpr' createScopeInfo e
+         _ -> let lsp@(L l sp) = minimumBy (compareSpans `on` getLoc) contSplice
+               in case sp of
+                    (HsQuasiQuote {}) -> do
+                      sp' <- rdrSplice sp
+                      exprSpliceInserted lsp (annLoc createScopeInfo (pure l) (AST.UQuasiQuoteExpr <$> annLocNoSema (pure l) (trfQuasiQuotation' sp')))
+                    _ -> do sp' <- rdrSplice sp
+                            exprSpliceInserted lsp (annLoc createScopeInfo (pure l) (AST.USplice <$> trfSplice sp'))
+  | otherwise = trfLoc trfExpr' createScopeInfo e
+
+createScopeInfo :: Trf ScopeInfo
+createScopeInfo = do scope <- asks localsInScope
+                     return (mkScopeInfo scope)
+
+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)
+trfExpr' (HsLit val) = AST.ULit <$> annContNoSema (trfLiteral' val)
+trfExpr' (HsLam (unLoc . mg_alts -> [unLoc -> Match _ pats _ (GRHSs [unLoc -> GRHS [] expr] (unLoc -> EmptyLocalBinds))]))
+  = AST.ULambda <$> (makeNonemptyList " " $ mapM trfPattern pats) <*> addToScope pats (trfExpr expr)
+trfExpr' (HsLamCase _ (unLoc . mg_alts -> matches)) = AST.ULamCase <$> trfAnnList " " trfAlt' matches
+trfExpr' (HsApp e1 e2) = AST.UApp <$> trfExpr e1 <*> trfExpr e2
+trfExpr' (OpApp e1 (unLoc -> HsVar op) _ e2)
+  = AST.UInfixApp <$> trfExpr e1 <*> trfOperator op <*> trfExpr e2
+trfExpr' (OpApp e1 (L nameLoc (HsRecFld fld)) _ e2)
+  = AST.UInfixApp <$> trfExpr e1 <*> trfAmbiguousOperator' nameLoc fld <*> trfExpr e2
+trfExpr' (OpApp _ (L _ op) _ _) = unhandledElement "OpApp expression" op
+trfExpr' (NegApp e _) = AST.UPrefixApp <$> annLocNoSema loc (AST.UNormalOp <$> annLoc info loc (AST.nameFromList <$> trfOperatorStr False "-"))
+                                       <*> trfExpr e
+  where loc = mkSrcSpan <$> atTheStart <*> (pure $ srcSpanStart (getLoc e))
+        info = createNameInfo =<< (fromMaybe (error "minus operation is not found") <$> liftGhc negateOpName)
+        negateOpName = getFromNameUsing (\n -> (\case Just (AnId id) -> Just id; _ -> Nothing) <$> lookupName n) negateName
+trfExpr' (HsPar (unLoc -> SectionL expr (unLoc -> HsVar op))) = AST.ULeftSection <$> trfExpr expr <*> trfOperator op
+trfExpr' (HsPar (unLoc -> SectionL expr (L nameLoc (HsRecFld op))))
+  = AST.ULeftSection <$> trfExpr expr <*> trfAmbiguousOperator' nameLoc op
+trfExpr' (HsPar (unLoc -> SectionR (unLoc -> HsVar op) expr)) = AST.URightSection <$> trfOperator op <*> trfExpr expr
+trfExpr' (HsPar (unLoc -> SectionR (L nameLoc (HsRecFld op)) expr))
+  = AST.URightSection <$> trfAmbiguousOperator' nameLoc op <*> trfExpr expr
+trfExpr' (HsPar expr) = AST.UParen <$> trfExpr expr
+trfExpr' (ExplicitTuple tupArgs box) | all tupArgPresent 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 (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
+        trfTupSecElem :: forall n r . TransformName n r => (HsTupArg n, SrcSpan) -> Trf (Ann AST.UTupSecElem (Dom r) RangeStage)
+        trfTupSecElem (Present e, l)
+          = annLocNoSema (pure l) (AST.Present <$> (annCont createScopeInfo (trfExpr' (unLoc e))))
+        trfTupSecElem (Missing _, l) = annLocNoSema (pure l) (pure AST.Missing)
+
+        existingArgs :: [SrcSpan]
+        existingArgs = catMaybes $ map (\case Present p -> Just (getLoc p); _ -> Nothing) $ map unLoc tupArgs
+
+        elemLocs :: Trf [SrcSpan]
+        elemLocs = do r <- asks contRange
+                      commaLocs <- allTokenLoc AnnComma
+                      return $ foldl breakUp [r] (filter freeComma commaLocs)
+          where freeComma (RealSrcSpan s) = not $ any (\case RealSrcSpan e -> e `containsSpan` s; _ -> False) existingArgs
+                freeComma _ = False
+
+        breakUp :: [SrcSpan] -> SrcSpan -> [SrcSpan]
+        breakUp cont sep = concatMap (breakUpOne sep) cont
+
+        breakUpOne :: SrcSpan -> SrcSpan -> [SrcSpan]
+        breakUpOne sep@(RealSrcSpan realSep) sp@(RealSrcSpan realSp)
+          | realSp `containsSpan` realSep = [mkSrcSpan (srcSpanStart sp) (srcSpanStart sep), mkSrcSpan (srcSpanEnd sep) (srcSpanEnd sp)]
+        breakUpOne _ sp = [sp]
+
+trfExpr' (HsCase expr (unLoc . mg_alts -> cases)) = AST.UCase <$> trfExpr expr <*> (makeIndentedList (focusBeforeIfPresent AnnCloseC atTheEnd) (mapM trfAlt cases))
+trfExpr' (HsIf _ expr thenE elseE) = AST.UIf <$> trfExpr expr <*> trfExpr thenE <*> trfExpr elseE
+trfExpr' (HsMultiIf _ parts) = AST.UMultiIf <$> trfAnnList "" trfGuardedCaseRhs' parts
+trfExpr' (HsLet (unLoc -> binds) expr) = addToScope binds (AST.ULet <$> trfLocalBinds AnnLet binds <*> trfExpr expr)
+trfExpr' (HsDo DoExpr (unLoc -> stmts) _) = AST.UDo <$> annLocNoSema (tokenLoc AnnDo) (pure AST.UDoKeyword)
+                                                    <*> makeNonemptyIndentedList (trfScopedSequence trfDoStmt stmts)
+trfExpr' (HsDo MDoExpr (unLoc -> [unLoc -> RecStmt { recS_stmts = stmts }, lastStmt]) _)
+  = AST.UDo <$> annLocNoSema (tokenLoc AnnMdo) (pure AST.UMDoKeyword)
+            <*> addToScope stmts (makeNonemptyIndentedList (mapM trfDoStmt (stmts ++ [lastStmt])))
+trfExpr' (HsDo MDoExpr (unLoc -> stmts) _) = AST.UDo <$> annLocNoSema (tokenLoc AnnMdo) (pure AST.UMDoKeyword)
+                                                     <*> addToScope stmts (makeNonemptyIndentedList (mapM trfDoStmt stmts))
+trfExpr' (HsDo ListComp (unLoc -> stmts) _)
+  = AST.UListComp <$> trfExpr (getLastStmt stmts) <*> trfListCompStmts stmts
+trfExpr' (HsDo MonadComp (unLoc -> stmts) _)
+  = AST.UListComp <$> trfExpr (getLastStmt stmts) <*> trfListCompStmts stmts
+trfExpr' (HsDo PArrComp (unLoc -> stmts) _)
+  = AST.UParArrayComp <$> trfExpr (getLastStmt stmts) <*> trfListCompStmts stmts
+trfExpr' (ExplicitList _ _ exprs) = AST.UList <$> trfAnnList' ", " trfExpr exprs
+trfExpr' (ExplicitPArr _ exprs) = AST.UParArray <$> trfAnnList' ", " trfExpr exprs
+trfExpr' (RecordCon name _ _ fields) = AST.URecCon <$> trfName name <*> trfFieldInits fields
+trfExpr' (RecordUpd expr fields _ _ _ _) = AST.URecUpdate <$> trfExpr expr <*> trfAnnList ", " trfFieldUpdate fields
+trfExpr' (ExprWithTySig expr typ) = AST.UTypeSig <$> trfExpr expr <*> trfType (hswc_body $ hsib_body typ)
+trfExpr' (ArithSeq _ _ (From from)) = AST.UEnum <$> trfExpr from <*> nothing "," "" (before AnnDotdot)
+                                                                <*> nothing "" "" (before AnnCloseS)
+trfExpr' (ArithSeq _ _ (FromThen from step))
+  = AST.UEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> nothing "" "" (before AnnCloseS)
+trfExpr' (ArithSeq _ _ (FromTo from to))
+  = AST.UEnum <$> trfExpr from <*> nothing "," "" (before AnnDotdot)
+                               <*> (makeJust <$> trfExpr to)
+trfExpr' (ArithSeq _ _ (FromThenTo from step to))
+  = AST.UEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> (makeJust <$> trfExpr to)
+trfExpr' (PArrSeq _ (FromTo from to))
+  = AST.UParArrayEnum <$> trfExpr from <*> nothing "," "" (before AnnDotdot) <*> trfExpr to
+trfExpr' (PArrSeq _ (FromThenTo from step to))
+  = AST.UParArrayEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> trfExpr to
+trfExpr' (HsBracket brack) = AST.UBracketExpr <$> annContNoSema (trfBracket' brack)
+trfExpr' (HsSpliceE qq@(HsQuasiQuote {})) = AST.UQuasiQuoteExpr <$> annContNoSema (trfQuasiQuotation' qq)
+trfExpr' (HsSpliceE splice) = AST.USplice <$> trfSplice splice
+trfExpr' (HsRnBracketOut br _) = AST.UBracketExpr <$> annContNoSema (trfBracket' br)
+trfExpr' (HsProc pat cmdTop) = AST.UProc <$> trfPattern pat <*> trfCmdTop cmdTop
+trfExpr' (HsStatic expr) = AST.UStaticPtr <$> trfExpr expr
+trfExpr' (HsAppType expr typ) = AST.UExplTypeApp <$> trfExpr expr <*> trfType (hswc_body typ)
+trfExpr' (HsSCC _ lit expr) = AST.UExprPragma <$> pragma <*> trfExpr expr
+  where pragma = do pragLoc <- tokensLoc [AnnOpen, AnnClose]
+                    focusOn pragLoc $ annContNoSema (AST.USccPragma <$> annLocNoSema (mappend <$> tokenLoc AnnValStr <*> tokenLocBack AnnVal) (trfText' lit))
+trfExpr' (HsCoreAnn _ lit expr) = AST.UExprPragma <$> pragma <*> trfExpr expr
+  where pragma = do pragLoc <- tokensLoc [AnnOpen, AnnClose]
+                    focusOn pragLoc $ annContNoSema (AST.UCorePragma <$> annLocNoSema (mappend <$> tokenLoc AnnValStr <*> tokenLocBack AnnVal) (trfText' lit))
+trfExpr' (HsTickPragma _ source _ expr) = AST.UExprPragma <$> pragma <*> trfExpr expr
+  where pragma = do pragLoc <- tokensLoc [AnnOpen, AnnClose]
+                    focusOn pragLoc $ annContNoSema (AST.UGeneratedPragma <$> (trfSourceRange source))
+trfExpr' t = unhandledElement "expression" t
+
+trfFieldInits :: TransformName n r => HsRecFields n (LHsExpr n) -> Trf (AnnListG AST.UFieldUpdate (Dom r) RangeStage)
+trfFieldInits (HsRecFields fields dotdot)
+  = do cont <- asks contRange
+       let (normalFlds, implicitFlds) = partition ((cont /=) . getLoc) fields
+       makeList ", " (before AnnCloseC)
+         $ ((++) <$> mapM trfFieldInit normalFlds
+                  <*> (if isJust dotdot then (:[]) <$> annLocNoSema (tokenLoc AnnDotdot)
+                                                                    (AST.UFieldWildcard <$> (annCont (createImplicitFldInfo (unLoc . (\(HsVar n) -> n) . unLoc) (map unLoc implicitFlds)) (pure AST.FldWildcard)))
+                                        else pure []))
+
+trfFieldInit :: TransformName n r => Located (HsRecField n (LHsExpr n)) -> Trf (Ann AST.UFieldUpdate (Dom r) RangeStage)
+trfFieldInit = trfLocNoSema $ \case
+  HsRecField id _ True -> AST.UFieldPun <$> trfName (getFieldOccName id)
+  HsRecField id val False -> AST.UNormalFieldUpdate <$> trfName (getFieldOccName id) <*> trfExpr val
+
+trfFieldUpdate :: TransformName n r => HsRecField' (AmbiguousFieldOcc n) (LHsExpr n) -> Trf (AST.UFieldUpdate (Dom r) RangeStage)
+trfFieldUpdate (HsRecField id _ True) = AST.UFieldPun <$> trfAmbiguousFieldName id
+trfFieldUpdate (HsRecField id val False) = AST.UNormalFieldUpdate <$> trfAmbiguousFieldName id <*> trfExpr val
+
+trfAlt :: TransformName n r => Located (Match n (LHsExpr n)) -> Trf (Ann AST.UAlt (Dom r) RangeStage)
+trfAlt = trfLocNoSema trfAlt'
+
+trfAlt' :: TransformName n r => Match n (LHsExpr n) -> Trf (AST.UAlt (Dom r) RangeStage)
+trfAlt' = gTrfAlt' trfExpr
+
+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 (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)
+trfCaseRhss = gTrfCaseRhss trfExpr
+
+gTrfCaseRhss :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> [Located (GRHS n (Located (ge n)))] -> Trf (Ann (AST.UCaseRhs' ae) (Dom r) RangeStage)
+gTrfCaseRhss te [unLoc -> GRHS [] body] = annLocNoSema (combineSrcSpans (getLoc body) <$> updateFocus (pure . updateEnd (const $ srcSpanStart $ getLoc body))
+                                                                                                      (tokenLocBack AnnRarrow))
+                                                 (AST.UUnguardedCaseRhs <$> te body)
+gTrfCaseRhss te rhss = annLocNoSema (pure $ collectLocs rhss)
+                              (AST.UGuardedCaseRhss <$> trfAnnList ";" (gTrfGuardedCaseRhs' te) rhss)
+
+trfGuardedCaseRhs :: TransformName n r => Located (GRHS n (LHsExpr n)) -> Trf (Ann AST.UGuardedCaseRhs (Dom r) RangeStage)
+trfGuardedCaseRhs = trfLocNoSema trfGuardedCaseRhs'
+
+trfGuardedCaseRhs' :: TransformName n r => GRHS n (LHsExpr n) -> Trf (AST.UGuardedCaseRhs (Dom r) RangeStage)
+trfGuardedCaseRhs' = gTrfGuardedCaseRhs' trfExpr
+
+gTrfGuardedCaseRhs' :: TransformName n r => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> GRHS n (Located (ge n)) -> Trf (AST.UGuardedCaseRhs' ae (Dom r) RangeStage)
+gTrfGuardedCaseRhs' te (GRHS guards body) = AST.UGuardedCaseRhs <$> trfAnnList " " trfRhsGuard' guards <*> te body
+
+trfCmdTop :: TransformName n r => Located (HsCmdTop n) -> Trf (Ann AST.UCmd (Dom r) RangeStage)
+trfCmdTop (L _ (HsCmdTop cmd _ _ _)) = trfCmd cmd
+
+trfCmd :: TransformName n r => Located (HsCmd n) -> Trf (Ann AST.UCmd (Dom r) RangeStage)
+trfCmd = trfLocNoSema trfCmd'
+
+trfCmd' :: TransformName n r => HsCmd n -> Trf (AST.UCmd (Dom r) RangeStage)
+trfCmd' (HsCmdArrApp left right _ typ dir) = AST.UArrowAppCmd <$> trfExpr left <*> op <*> trfExpr right
+  where op = case (typ, dir) of (HsFirstOrderApp, False) -> annLocNoSema (tokenLoc Annrarrowtail) (pure AST.URightAppl)
+                                (HsFirstOrderApp, True) -> annLocNoSema (tokenLoc Annlarrowtail) (pure AST.ULeftAppl)
+                                (HsHigherOrderApp, False) -> annLocNoSema (tokenLoc AnnRarrowtail) (pure AST.URightHighApp)
+                                (HsHigherOrderApp, True) -> annLocNoSema (tokenLoc AnnLarrowtail) (pure AST.ULeftHighApp)
+                                                                       -- FIXME: needs a before
+trfCmd' (HsCmdArrForm expr _ cmds) = AST.UArrowFormCmd <$> trfExpr expr <*> makeList " " (before AnnClose) (mapM trfCmdTop cmds)
+trfCmd' (HsCmdApp cmd expr) = AST.UAppCmd <$> trfCmd cmd <*> trfExpr expr
+trfCmd' (HsCmdLam (MG (unLoc -> [unLoc -> Match _ pats _ (GRHSs [unLoc -> GRHS [] body] _)]) _ _ _))
+  = AST.ULambdaCmd <$> (makeNonemptyList " " $ mapM trfPattern pats) <*> trfCmd body
+trfCmd' (HsCmdPar cmd) = AST.UParenCmd <$> trfCmd cmd
+trfCmd' (HsCmdCase expr (MG (unLoc -> alts) _ _ _))
+  = AST.UCaseCmd <$> trfExpr expr <*> makeNonemptyIndentedList (mapM (trfLocNoSema (gTrfAlt' trfCmd)) alts)
+trfCmd' (HsCmdIf _ pred thenExpr elseExpr) = AST.UIfCmd <$> trfExpr pred <*> trfCmd thenExpr <*> trfCmd elseExpr
+trfCmd' (HsCmdLet (unLoc -> binds) cmd) = addToScope binds (AST.ULetCmd <$> trfLocalBinds AnnLet binds <*> trfCmd cmd)
+trfCmd' (HsCmdDo (unLoc -> stmts) _) = AST.UDoCmd <$> makeNonemptyIndentedList (mapM (trfLocNoSema (gTrfDoStmt' trfCmd)) stmts)
+-- | TODO: implement
+trfCmd' (HsCmdLam {}) = error "trfCmd': cmd lambda not supported yet"
+trfCmd' (HsCmdWrap {}) = error "trfCmd': cmd wrap not supported yet"
+
+trfText' :: StringLiteral -> Trf (AST.UStringNode (Dom r) RangeStage)
+trfText' = pure . AST.UStringNode . unpackFS . sl_fs
+
+trfSourceRange :: (StringLiteral, (Int, Int), (Int, Int)) -> Trf (Ann AST.USourceRange (Dom r) RangeStage)
+trfSourceRange (fileName, (startRow, startCol), (endRow, endCol))
+  = do fnLoc <- tokenLoc AnnValStr
+       [srLoc, scLoc, erLoc, ecLoc] <- allTokenLoc AnnVal
+       annLocNoSema (pure (fnLoc `combineSrcSpans` ecLoc))
+         (AST.USourceRange <$> annLocNoSema (pure fnLoc) (trfText' fileName)
+                           <*> annLocNoSema (pure srLoc) (pure $ AST.Number $ fromIntegral startRow)
+                           <*> annLocNoSema (pure scLoc) (pure $ AST.Number $ fromIntegral startCol)
+                           <*> annLocNoSema (pure erLoc) (pure $ AST.Number $ fromIntegral endRow)
+                           <*> annLocNoSema (pure ecLoc) (pure $ AST.Number $ fromIntegral endCol))

@@ -0,0 +1,12 @@+module Language.Haskell.Tools.BackendGHC.Exprs where
+
+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.BackendGHC.Monad (Trf)
+import Language.Haskell.Tools.BackendGHC.Names (TransformName(..))
+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)
+trfCmd' :: TransformName n r => HsCmd n -> Trf (AST.UCmd (Dom r) RangeStage)

@@ -0,0 +1,274 @@+{-# LANGUAGE MultiParamTypeClasses
+           , TypeSynonymInstances
+           , FlexibleInstances
+           , ScopedTypeVariables
+           , ViewPatterns
+           , LambdaCase
+           , RecordWildCards
+           #-}
+-- | Utility functions defined on the GHC AST representation.
+module Language.Haskell.Tools.BackendGHC.GHCUtils where
+
+import Data.Generics.Uniplate.Data ()
+import Data.List
+
+import Bag (Bag, bagToList, unionManyBags)
+import ConLike (ConLike(..))
+import GHC
+import Id (Id, mkVanillaGlobal)
+import OccName (OccName)
+import Outputable (Outputable(..), OutputableBndr(..), showSDocUnsafe)
+import PatSyn (patSynSig)
+import RdrName (RdrName, rdrNameOcc, nameRdrName)
+import SrcLoc
+import Type (TyThing(..), mkFunTys)
+import Data.Maybe
+
+class OutputableBndr name => GHCName name where
+  rdrName :: name -> RdrName
+  getFromNameUsing :: Applicative f => (Name -> Ghc (f Id)) -> Name -> Ghc (f name)
+  getBindsAndSigs :: HsValBinds name -> ([LSig name], LHsBinds name)
+  nameFromId :: Id -> name
+  unpackPostRn :: RdrName -> PostRn name name -> name
+
+  gunpackPostRn :: a -> (name -> a) -> PostRn name name -> a
+
+instance GHCName RdrName where
+  rdrName = id
+  getFromNameUsing _ n = return $ pure (nameRdrName n)
+  getBindsAndSigs (ValBindsIn binds sigs) = (sigs, binds)
+  getBindsAndSigs _ = error "ValBindsOut: ValBindsOut in parsed source"
+  nameFromId = nameRdrName . getName
+  unpackPostRn rdr _ = rdr
+
+  gunpackPostRn a _ _ = a
+
+occName :: GHCName n => n -> OccName
+occName = rdrNameOcc . rdrName
+
+instance GHCName GHC.Name where
+  rdrName = nameRdrName
+  getFromNameUsing f n = fmap nameFromId <$> f n
+  getBindsAndSigs (ValBindsOut bindGroups sigs) = (sigs, unionManyBags (map snd bindGroups))
+  getBindsAndSigs _ = error "getBindsAndSigs: ValBindsIn in renamed source"
+  nameFromId = getName
+  unpackPostRn _ a = a
+
+  gunpackPostRn _ f pr = f pr
+
+getFieldOccName :: GHCName n => Located (FieldOcc n) -> Located n
+getFieldOccName (L l (FieldOcc (L _ rdr) postRn)) = L l (unpackPostRn rdr postRn)
+
+getFieldOccName' :: GHCName n => FieldOcc n -> n
+getFieldOccName' (FieldOcc (L _ rdr) postRn) = unpackPostRn rdr postRn
+
+
+
+-- | Loading ids for top-level ghc names
+getTopLevelId :: GHC.Name -> Ghc (Maybe GHC.Id)
+getTopLevelId name =
+    lookupName name >>= \case
+      Just (AnId id) -> return (Just id)
+      Just (AConLike (RealDataCon dc)) -> return $ Just $ mkVanillaGlobal name (dataConUserType dc)
+      Just (AConLike (PatSynCon ps)) -> return $ Just $ mkVanillaGlobal name (createPatSynType ps)
+      Just (ATyCon tc) -> return $ Just $ mkVanillaGlobal name (tyConKind tc)
+      _ -> return Nothing
+  where createPatSynType patSyn = case patSynSig patSyn of (_, _, _, _, args, res) -> mkFunTys args res
+
+hsGetNames' :: HsHasName a => a -> [GHC.Name]
+hsGetNames' = map fst . hsGetNames Nothing
+
+-- | Get names from the GHC AST
+class HsHasName a where
+  hsGetNames :: Maybe GHC.Name -> a -> [(GHC.Name, Maybe GHC.Name)]
+
+instance HsHasName RdrName where
+  hsGetNames _ _ = []
+
+instance HsHasName Name where
+  hsGetNames p n = [(n, p)]
+
+instance HsHasName Id where
+  hsGetNames p n = [(getName n, p)]
+
+instance HsHasName e => HsHasName [e] where
+  hsGetNames p es = concatMap (hsGetNames p) es
+
+instance HsHasName e => HsHasName (Located e) where
+  hsGetNames p (L _ e) = hsGetNames p e
+
+instance HsHasName n => HsHasName (HsLocalBinds n) where
+  hsGetNames p (HsValBinds bnds) = hsGetNames p bnds
+  hsGetNames _ _ = []
+
+instance (GHCName n, HsHasName n) => HsHasName (HsDecl n) where
+  hsGetNames p (TyClD tycl) = hsGetNames p tycl
+  hsGetNames p (ValD vald) = hsGetNames p vald
+  hsGetNames p (ForD ford) = hsGetNames p ford
+  hsGetNames p (InstD inst) = hsGetNames p inst
+  hsGetNames _ _ = []
+
+instance (GHCName n, HsHasName n) => HsHasName (InstDecl n) where
+  hsGetNames p (ClsInstD clsInst) = hsGetNames p (cid_datafam_insts clsInst)
+  hsGetNames p (DataFamInstD dataFamInst) = hsGetNames p dataFamInst
+  hsGetNames _ _ = []
+
+instance (GHCName n, HsHasName n) => HsHasName (DataFamInstDecl n) where
+  hsGetNames p dfid = hsGetNames p (dfid_defn dfid)
+
+instance (GHCName n, HsHasName n) => HsHasName (TyClGroup n) where
+  hsGetNames p (TyClGroup tycls _) = hsGetNames p tycls
+
+instance (GHCName n, HsHasName n) => HsHasName (TyClDecl n) where
+  hsGetNames p (FamDecl fd) = hsGetNames p fd
+  hsGetNames p (SynDecl {tcdLName = name}) = hsGetNames p name
+  hsGetNames p (DataDecl {tcdLName = name, tcdDataDefn = datadef})
+    = let n = hsGetNames p name in n ++ hsGetNames (listToMaybe (map fst n)) datadef
+  hsGetNames p (ClassDecl {tcdLName = name, tcdSigs = sigs, tcdATs = typeAssocs})
+    = let n = hsGetNames p name in n ++ hsGetNames (listToMaybe (map fst n)) sigs
+                                     ++ hsGetNames (listToMaybe (map fst n)) typeAssocs
+
+instance (GHCName n, HsHasName n) => HsHasName (FamilyDecl n) where
+ hsGetNames p (FamilyDecl { fdLName = name }) = hsGetNames p name
+
+instance (GHCName n, HsHasName n) => HsHasName (HsDataDefn n) where
+  hsGetNames p (HsDataDefn {dd_cons = ctors}) = hsGetNames p ctors
+
+instance (GHCName n, HsHasName n) => HsHasName (ConDecl n) where
+  hsGetNames p (ConDeclGADT {con_names = names, con_type = (HsIB _ (L _ (HsFunTy (L _ (HsRecTy flds)) _)))})
+    = hsGetNames p names ++ hsGetNames p flds
+  hsGetNames p (ConDeclGADT {con_names = names, con_type = (HsIB _ (L _ (HsRecTy flds)))})
+    = hsGetNames p names ++ hsGetNames p flds
+  hsGetNames p (ConDeclGADT {con_names = names}) = hsGetNames p names
+  hsGetNames p (ConDeclH98 {con_name = name, con_details = details})
+    = hsGetNames p name ++ hsGetNames p details
+
+instance (GHCName n, HsHasName n) => HsHasName (HsConDeclDetails n) where
+  hsGetNames p (RecCon rec) = hsGetNames p rec
+  hsGetNames _ _ = []
+
+instance (GHCName n, HsHasName n) => HsHasName (ConDeclField n) where
+  hsGetNames p (ConDeclField name _ _) = hsGetNames p name
+
+instance (GHCName n, HsHasName n) => HsHasName (FieldOcc n) where
+  hsGetNames p (FieldOcc _ pr) = gunpackPostRn [] (hsGetNames p :: n -> [(Name, Maybe Name)]) pr
+
+instance (GHCName n, HsHasName n) => HsHasName (Sig n) where
+  hsGetNames p (TypeSig n _) = hsGetNames p n
+  hsGetNames p (ClassOpSig _ n _) = hsGetNames p n
+  hsGetNames p (PatSynSig n _) = hsGetNames p n
+  hsGetNames _ _ = []
+
+instance HsHasName n => HsHasName (ForeignDecl n) where
+  hsGetNames p (ForeignImport n _ _ _) = hsGetNames p n
+  hsGetNames _ _ = []
+
+instance HsHasName n => HsHasName (HsValBinds n) where
+  hsGetNames p (ValBindsIn bnds _) = hsGetNames p bnds
+  hsGetNames p (ValBindsOut bnds _) = hsGetNames p $ map snd bnds
+
+instance HsHasName n => HsHasName (Bag n) where
+  hsGetNames p = hsGetNames p . bagToList
+
+instance HsHasName n => HsHasName (HsBind n) where
+  hsGetNames p (FunBind {fun_id = lname}) = hsGetNames p lname
+  hsGetNames p (PatBind {pat_lhs = pat}) = hsGetNames p pat
+  hsGetNames p (VarBind {var_id = id}) = hsGetNames p id
+  hsGetNames p (PatSynBind (PSB {psb_id = id})) = hsGetNames p id
+  hsGetNames _ _ = error "hsGetNames: called on compiler-generated binding"
+
+instance HsHasName n => HsHasName (ParStmtBlock l n) where
+  hsGetNames p (ParStmtBlock _ binds _) = hsGetNames p binds
+
+--instance HsHasName n => HsHasName (LHsTyVarBndrs n) where
+--  hsGetNames (HsQTvs kvs tvs) = hsGetNames kvs ++ hsGetNames tvs
+
+instance HsHasName n => HsHasName (HsTyVarBndr n) where
+  hsGetNames p (UserTyVar n) = hsGetNames p n
+  hsGetNames p (KindedTyVar n _) = hsGetNames p n
+
+instance HsHasName n => HsHasName (Stmt n b) where
+  hsGetNames p (LetStmt binds) = hsGetNames p binds
+  hsGetNames p (BindStmt pat _ _ _ _) = hsGetNames p pat
+  hsGetNames p (RecStmt {recS_rec_ids = ids}) = hsGetNames p ids
+  hsGetNames _ _ = []
+
+instance HsHasName n => HsHasName (Pat n) where
+  hsGetNames x (VarPat id) = hsGetNames x id
+  hsGetNames x (LazyPat p) = hsGetNames x p
+  hsGetNames x (AsPat lname p) = hsGetNames x lname ++ hsGetNames x p
+  hsGetNames x (ParPat p) = hsGetNames x p
+  hsGetNames x (BangPat p) = hsGetNames x p
+  hsGetNames x (ListPat pats _ _) = concatMap (hsGetNames x) pats
+  hsGetNames x (TuplePat pats _ _) = concatMap (hsGetNames x) pats
+  hsGetNames x (PArrPat pats _) = concatMap (hsGetNames x) pats
+  hsGetNames x (ConPatIn _ details) = concatMap (hsGetNames x) (hsConPatArgs details)
+  hsGetNames x (ConPatOut {pat_args = details}) = concatMap (hsGetNames x) (hsConPatArgs details)
+  hsGetNames x (ViewPat _ p _) = hsGetNames x p
+  hsGetNames x (NPlusKPat lname _ _ _ _ _) = hsGetNames x lname
+  hsGetNames x (SigPatIn p _) = hsGetNames x p
+  hsGetNames x (SigPatOut p _) = hsGetNames x p
+  hsGetNames _ _ = []
+
+instance (GHCName n, HsHasName n) => HsHasName (HsGroup n) where
+  hsGetNames p (HsGroup vals _ clds insts _ _ _ foreigns _ _ _ _ _)
+    = hsGetNames p vals ++ hsGetNames p clds ++ hsGetNames p insts ++ hsGetNames p foreigns
+
+-- | Get the original form of a name
+rdrNameStr :: RdrName -> String
+rdrNameStr name = showSDocUnsafe $ ppr name
+
+
+class FromGHCName n where
+  fromGHCName :: GHC.Name -> n
+
+instance FromGHCName RdrName where
+  fromGHCName = rdrName
+
+instance FromGHCName GHC.Name where
+  fromGHCName = id
+
+-- | Tries to simplify the type that has HsAppsTy before renaming. Does not always provide the correct form.
+-- Treats each operator as if they are of equivalent precedence and always left-associative.
+cleanHsType :: forall n . (OutputableBndr n) => HsType n -> HsType n
+-- for some reason * is considered infix
+cleanHsType (HsAppsTy apps) = unLoc $ guessType apps
+  where guessType :: OutputableBndr n => [LHsAppType n] -> LHsType n
+        guessType (L l (HsAppInfix n) : rest) -- must be a prefix actually
+          = guessType' (L l (HsTyVar n)) rest
+        guessType (L _ (HsAppPrefix t) : rest) = guessType' t rest
+        guessType [] = error $ "guessType: empty: " ++ showSDocUnsafe (ppr apps)
+
+        guessType' :: LHsType n -> [LHsAppType n] -> LHsType n
+        guessType' fun (L _ (HsAppPrefix t) : rest) = guessType' (hsAppTy fun t) rest
+        guessType' fun (L l (HsAppInfix n) : rest)
+          -- TODO: find a better check
+          | showSDocUnsafe (ppr n) == "*" = guessType' (hsAppTy fun (L l (HsTyVar n))) rest
+        guessType' left (L _ (HsAppInfix n) : right) = hsOpTy left n (guessType right)
+        guessType' t [] = t
+
+        hsAppTy :: LHsType n -> LHsType n -> LHsType n
+        hsAppTy t1 t2 = L (getLoc t1 `combineSrcSpans` getLoc t2) $ HsAppTy t1 t2
+
+        hsOpTy :: LHsType n -> Located n -> LHsType n -> LHsType n
+        hsOpTy t1 n t2 = L (getLoc t1 `combineSrcSpans` getLoc t2) $ HsOpTy t1 n t2
+cleanHsType t = t
+
+mergeFixityDefs :: [Located (FixitySig n)] -> [Located (FixitySig n)]
+mergeFixityDefs (s@(L l _) : rest)
+  = let (same, different) = partition ((== l) . getLoc) rest
+     in foldl mergeWith s (map unLoc same) : mergeFixityDefs different
+  where mergeWith (L l (FixitySig names fixity)) (FixitySig otherNames _) = L l (FixitySig (names ++ otherNames) fixity)
+mergeFixityDefs [] = []
+
+getGroupRange :: HsGroup n -> SrcSpan
+getGroupRange (HsGroup {..})
+  = foldr combineSrcSpans noSrcSpan locs
+  where locs = [getHsValRange hs_valds] ++ map getLoc hs_splcds ++ map getLoc (concatMap group_tyclds hs_tyclds) ++ map getLoc (concatMap group_roles hs_tyclds)
+                 ++ map getLoc hs_instds ++ map getLoc hs_derivds ++ map getLoc hs_fixds ++ map getLoc hs_defds
+                 ++ map getLoc hs_fords ++ map getLoc hs_warnds ++ map getLoc hs_annds ++ map getLoc hs_ruleds ++ map getLoc hs_vects
+                 ++ map getLoc hs_docs
+
+getHsValRange :: HsValBinds n -> SrcSpan
+getHsValRange (ValBindsIn vals sig) = foldr combineSrcSpans noSrcSpan $ map getLoc (bagToList vals) ++ map getLoc sig
+getHsValRange (ValBindsOut vals sig) = foldr combineSrcSpans noSrcSpan $ concatMap (map getLoc . bagToList . snd) vals ++ map getLoc sig

@@ -0,0 +1,61 @@+{-# LANGUAGE ViewPatterns
+           , TypeFamilies
+           #-}
+-- | Functions that convert the kind-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Kinds where
+
+import ApiAnnotation as GHC (AnnKeywordId(..))
+import FastString as GHC (unpackFS)
+import HsTypes as GHC
+import Name as GHC (occNameString, nameOccName, isWiredInName)
+import RdrName as GHC (RdrName(..))
+import SrcLoc as GHC
+
+import Language.Haskell.Tools.AST (Ann, AnnMaybeG, Dom, RangeStage, HasNoSemanticInfo)
+import qualified Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.BackendGHC.GHCUtils (GHCName(..), cleanHsType)
+import Language.Haskell.Tools.BackendGHC.Monad (Trf, transformingPossibleVar)
+import Language.Haskell.Tools.BackendGHC.Names (TransformName, trfOperator, trfName)
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.Types (trfType')
+import Language.Haskell.Tools.BackendGHC.Utils
+
+
+trfKindSig :: TransformName n r => Maybe (LHsKind n) -> Trf (AnnMaybeG AST.UKindConstraint (Dom r) RangeStage)
+trfKindSig = trfMaybe "" "" trfKindSig'
+
+trfKindSig' :: TransformName n r => Located (HsKind n) -> Trf (Ann AST.UKindConstraint (Dom r) RangeStage)
+trfKindSig' k = annLocNoSema (combineSrcSpans (getLoc k) <$> (tokenBefore (srcSpanStart (getLoc k)) AnnDcolon))
+                             (AST.UKindConstraint <$> trfLocNoSema trfKind' k)
+
+trfKind :: TransformName n r => Located (HsKind n) -> Trf (Ann AST.UKind (Dom r) RangeStage)
+trfKind = trfLocNoSema (trfKind' . cleanHsType)
+
+trfKind' ::TransformName n r => HsKind n -> Trf (AST.UKind (Dom r) RangeStage)
+trfKind' = trfKind'' . cleanHsType where
+  trfKind'' (HsTyVar (rdrName . unLoc -> Exact n))
+    | isWiredInName n && occNameString (nameOccName n) == "*"
+    = pure AST.UStarKind
+    | isWiredInName n && occNameString (nameOccName n) == "#"
+    = pure AST.UUnboxKind
+  trfKind'' (HsParTy kind) = AST.UParenKind <$> trfKind kind
+  trfKind'' (HsFunTy k1 k2) = AST.UFunKind <$> trfKind k1 <*> trfKind k2
+  trfKind'' (HsAppTy k1 k2) = AST.UAppKind <$> trfKind k1 <*> trfKind k2
+  trfKind'' (HsOpTy k1 op k2) = AST.UInfixAppKind <$> trfKind k1 <*> trfOperator op <*> trfKind k2
+  trfKind'' (HsTyVar kv) = transformingPossibleVar kv (AST.UVarKind <$> trfName kv)
+  trfKind'' (HsListTy kind) = AST.UListKind <$> trfKind kind
+  trfKind'' (HsTupleTy _ kinds) = AST.UTupleKind <$> makeList ", " atTheStart (mapM trfKind kinds)
+  trfKind'' (HsAppsTy [unLoc -> HsAppPrefix t]) = trfKind' (unLoc t)
+  trfKind'' (HsAppsTy [unLoc -> HsAppInfix n]) = AST.UVarKind <$> trfName n
+  trfKind'' pt@(HsExplicitListTy {}) = AST.UPromotedKind <$> annContNoSema (trfPromoted' trfKind' pt)
+  trfKind'' pt@(HsExplicitTupleTy {}) = AST.UPromotedKind <$> annContNoSema (trfPromoted' trfKind' pt)
+  trfKind'' pt@(HsTyLit {}) = AST.UPromotedKind <$> annContNoSema (trfPromoted' trfKind' pt)
+  trfKind'' t = AST.UTypeKind <$> annContNoSema (trfType' t)
+
+trfPromoted' :: (TransformName n r, HasNoSemanticInfo (Dom r) a)
+                  => (HsType n -> Trf (a (Dom r) RangeStage)) -> HsType n -> Trf (AST.UPromoted a (Dom r) RangeStage)
+trfPromoted' _ (HsTyLit (HsNumTy _ int)) = pure $ AST.UPromotedInt int
+trfPromoted' _ (HsTyLit (HsStrTy _ str)) = pure $ AST.UPromotedString (unpackFS str)
+trfPromoted' _ (HsTyVar name) = AST.UPromotedCon <$> trfName name
+trfPromoted' f (HsExplicitListTy _ elems) = AST.UPromotedList <$> between AnnOpenS AnnCloseS (trfAnnList ", " f elems)
+trfPromoted' f (HsExplicitTupleTy _ elems) = AST.UPromotedTuple <$> between AnnOpenP AnnCloseP (trfAnnList ", " f elems)
+trfPromoted' _ t = unhandledElement "promoted type/kind" t

@@ -0,0 +1,32 @@+-- | Functions that convert the literals of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Literals where
+
+import qualified Data.ByteString.Char8 as BS (foldr)
+
+import BasicTypes as GHC (FractionalLit(..))
+import FastString as GHC (unpackFS)
+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.BackendGHC.Monad (Trf)
+
+trfLiteral' :: HsLit -> Trf (AST.ULiteral (Dom r) RangeStage)
+trfLiteral' (HsChar _ ch) = pure $ AST.UCharLit ch
+trfLiteral' (HsCharPrim _ ch) = pure $ AST.UPrimCharLit ch
+trfLiteral' (HsString _ str) = pure $ AST.UStringLit (unpackFS str)
+trfLiteral' (HsStringPrim _ str) = pure $ AST.UPrimStringLit (BS.foldr (:) "" str)
+trfLiteral' (HsInt _ i) = pure $ AST.UIntLit i
+trfLiteral' (HsIntPrim _ i) = pure $ AST.UPrimIntLit i
+trfLiteral' (HsWordPrim _ i) = pure $ AST.UPrimWordLit i
+trfLiteral' (HsInt64Prim _ i) = pure $ AST.UPrimIntLit i
+trfLiteral' (HsWord64Prim _ i) = pure $ AST.UPrimWordLit i
+trfLiteral' (HsInteger _ i _) = pure $ AST.UPrimIntLit i
+trfLiteral' (HsRat frac _) = pure $ AST.UFracLit (fl_value frac)
+trfLiteral' (HsFloatPrim frac) = pure $ AST.UPrimFloatLit (fl_value frac)
+trfLiteral' (HsDoublePrim frac) = pure $ AST.UPrimDoubleLit (fl_value frac)
+
+trfOverloadedLit :: OverLitVal -> Trf (AST.ULiteral (Dom r) RangeStage)
+trfOverloadedLit (HsIntegral _ i) = pure $ AST.UIntLit i
+trfOverloadedLit (HsFractional frac) = pure $ AST.UFracLit (fl_value frac)
+trfOverloadedLit (HsIsString _ str) = pure $ AST.UStringLit (unpackFS str)

@@ -0,0 +1,197 @@+{-# LANGUAGE LambdaCase
+           , ViewPatterns
+           , FlexibleContexts
+           , ScopedTypeVariables
+           , TypeApplications
+           , TupleSections
+           , TypeFamilies
+           #-}
+-- | Functions that convert the module-related elements (modules, imports, exports) of the GHC AST to corresponding elements in the Haskell-tools AST representation
+-- Also contains the entry point of the transformation that collects the information from different GHC AST representations.
+module Language.Haskell.Tools.BackendGHC.Modules where
+
+import Control.Monad.Reader
+import Control.Reference hiding (element)
+import Data.Generics.Uniplate.Data ()
+import Data.List as List
+import Data.Map as Map (fromList, lookup)
+import Data.Maybe
+
+import BasicTypes as GHC (WarningTxt(..), StringLiteral(..))
+import DynFlags as GHC ()
+import FastString as GHC (unpackFS)
+import FieldLabel as GHC (FieldLbl(..))
+import GHC
+import SrcLoc as GHC
+import TcRnMonad as GHC (Applicative(..), (<$>))
+
+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.SemaInfoTypes as AST (nameInfo, implicitNames, importedNames)
+import Language.Haskell.Tools.BackendGHC.Decls (trfDecls, trfDeclsGroup)
+import Language.Haskell.Tools.BackendGHC.Exprs (trfText')
+import Language.Haskell.Tools.BackendGHC.Monad
+import Language.Haskell.Tools.BackendGHC.Names (TransformName, trfName)
+import Language.Haskell.Tools.BackendGHC.Utils
+
+trfModule :: ModSummary -> Located (HsModule RdrName) -> Trf (Ann AST.UModule (Dom RdrName) RangeStage)
+trfModule mod hsMod = trfLocCorrect (createModuleInfo mod (maybe noSrcSpan getLoc $ hsmodName $ unLoc hsMod) (hsmodImports $ unLoc hsMod))
+                                    (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos))
+                  (\(HsModule name exports imports decls deprec _) ->
+                     AST.UModule <$> trfFilePragmas
+                                 <*> trfModuleHead name (srcSpanStart (foldLocs (map getLoc imports ++ map getLoc decls))) exports deprec
+                                 <*> trfImports imports
+                                 <*> trfDecls decls) $ hsMod
+
+trfModuleRename :: ModSummary -> Ann AST.UModule (Dom RdrName) RangeStage
+                              -> (HsGroup Name, [LImportDecl Name], Maybe [LIE Name], Maybe LHsDocString)
+                              -> Located (HsModule RdrName)
+                              -> Trf (Ann AST.UModule (Dom GHC.Name) RangeStage)
+trfModuleRename mod rangeMod (gr,imports,exps,_) hsMod
+    = do info <- createModuleInfo mod (maybe noSrcSpan getLoc $ hsmodName $ unLoc hsMod) imports
+         trfLocCorrect (pure info) (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) (trfModuleRename' (info ^. implicitNames)) hsMod
+  where roleAnnots = rangeMod ^? AST.modDecl&AST.annList&filtered ((\case Ann _ (AST.URoleDecl {}) -> True; _ -> False))
+        originalNames = Map.fromList $ catMaybes $ map getSourceAndInfo (rangeMod ^? biplateRef)
+        getSourceAndInfo :: Ann AST.UQualifiedName (Dom RdrName) RangeStage -> Maybe (SrcSpan, RdrName)
+        getSourceAndInfo n = (,) <$> (n ^? annotation&sourceInfo&nodeSpan) <*> (n ^? semantics&nameInfo)
+
+        trfModuleRename' preludeImports hsMod@(HsModule name exports _ _ deprec _) = do
+          transformedImports <- orderAnnList <$> (trfImports imports)
+
+          let importNames impd = ( impd ^. AST.importModule & AST.moduleNameString
+                                 , impd ^? AST.importAs & AST.annJust & AST.importRename & AST.moduleNameString
+                                 , AST.isAnnJust (impd ^. AST.importQualified)
+                                 , impd ^. semantics&importedNames )
+              -- if there is a qualified form of the import Prelude, the names should be empty
+              importPrelude names = ( "Prelude", Nothing, False, names)
+
+          addToScopeImported (map importNames (transformedImports ^? AST.annList) ++ [importPrelude preludeImports])
+            $ loadSplices hsMod
+            $ setOriginalNames originalNames . setDeclsToInsert roleAnnots
+            $ do filePrags <- trfFilePragmas
+                 AST.UModule filePrags
+                  <$> trfModuleHead name
+                       (srcSpanEnd (AST.getRange filePrags))
+                       (case (exports, exps) of (Just (L l _), Just ie) -> Just (L l ie)
+                                                _                       -> Nothing)
+                       deprec
+                  <*> return transformedImports
+                  <*> trfDeclsGroup gr
+
+loadSplices :: HsModule RdrName -> Trf a -> Trf a
+loadSplices hsMod trf = do
+    let declSpls = map (\(SpliceDecl sp _) -> sp) $ hsMod ^? biplateRef :: [Located (HsSplice RdrName)]
+        exprSpls = catMaybes $ map (\case L l (HsSpliceE sp) -> Just (L l sp); _ -> Nothing) $ hsMod ^? biplateRef :: [Located (HsSplice RdrName)]
+        typeSpls = catMaybes $ map (\case L l (HsSpliceTy sp _) -> Just (L l sp); _ -> Nothing) $ hsMod ^? biplateRef :: [Located (HsSplice RdrName)]
+    setSplices declSpls typeSpls exprSpls trf
+
+trfModuleHead :: TransformName n r => Maybe (Located ModuleName) -> SrcLoc -> Maybe (Located [LIE n]) -> Maybe (Located WarningTxt) -> Trf (AnnMaybeG AST.UModuleHead (Dom r) RangeStage)
+trfModuleHead (Just mn) _ exports modPrag
+  = makeJust <$> (annLocNoSema (tokensLoc [AnnModule, AnnWhere])
+                               (AST.UModuleHead <$> trfModuleName mn
+                                                <*> trfModulePragma (srcSpanEnd $ getLoc mn) modPrag
+                                                <*> trfExportList (before AnnWhere) exports))
+trfModuleHead _ rng Nothing _ = nothing "" "" (pure rng)
+trfModuleHead Nothing _ (Just _) _ = error "trfModuleHead: no head but has exports"
+
+trfFilePragmas :: Trf (AnnListG AST.UFilePragma (Dom r) RangeStage)
+trfFilePragmas = do pragmas <- asks pragmaComms
+                    languagePragmas <- mapM trfLanguagePragma (fromMaybe [] $ (Map.lookup "LANGUAGE") pragmas)
+                    optionsPragmas <- mapM trfOptionsPragma (fromMaybe [] $ (Map.lookup "OPTIONS_GHC") pragmas)
+                    makeList "" atTheStart $ pure $ orderDefs $ languagePragmas ++ optionsPragmas
+
+trfLanguagePragma :: Located String -> Trf (Ann AST.UFilePragma (Dom r) RangeStage)
+trfLanguagePragma lstr@(L l _) = annLocNoSema (pure l) (AST.ULanguagePragma <$> makeList ", " (pure $ srcSpanStart $ getLoc $ last pragmaElems)
+                                                                                              (mapM (trfLocNoSema (pure . AST.ULanguageExtension)) extensions))
+  where pragmaElems = splitLocated lstr
+        extensions = filter ((\sp -> srcSpanStart sp /= srcSpanEnd sp) . getLoc)
+                       $ map (removeEnd . removeLang . removeStart) pragmaElems
+        removeStart pr@(L l txt) = if "{-#" `isPrefixOf` txt then L (updateStart (updateCol (+3)) l) (drop 3 txt) else pr
+        removeLang pr@(L l txt) = if "LANGUAGE" `isPrefixOf` txt then L (updateStart (updateCol (+8)) l) (drop 8 txt) else pr
+        removeEnd pr@(L l txt) = if "#-}" `isSuffixOf` txt then L (updateEnd (updateCol (subtract 3)) l) (reverse $ drop 3 $ reverse $ txt) else pr
+
+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 :: 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)
+
+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)))
+
+trfExport :: TransformName n r => LIE n -> Trf (Maybe (Ann AST.UExportSpec (Dom r) RangeStage))
+trfExport = trfMaybeLocNoSema $ \case
+  IEModuleContents n -> Just . AST.UModuleExport <$> (trfModuleName n)
+  other -> do trf <- trfIESpec' other
+              fmap AST.UDeclExport <$> (sequence $ fmap (annContNoSema . return) trf)
+
+trfImports :: TransformName n r => [LImportDecl n] -> Trf (AnnListG AST.UImportDecl (Dom r) RangeStage)
+trfImports (filter (not . ideclImplicit . unLoc) -> imps)
+  = AnnListG <$> importDefaultLoc <*> mapM trfImport imps
+  where importDefaultLoc = noSemaInfo . AST.ListPos (if List.null imps then "\n" else "") "" "\n" (Just []) . srcSpanEnd
+                             <$> (combineSrcSpans <$> asks (srcLocSpan . srcSpanStart . contRange)
+                                                  <*> (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 _ isQual _ declAs declHiding)) = focusOn l $
+  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 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
+       <*> maybe (nothing " " "" (pure $ srcSpanEnd (getLoc name))) (\mn -> makeJust <$> (trfRenaming mn)) declAs
+       <*> trfImportSpecs declHiding
+  where trfRenaming mn
+          = annLocNoSema (tokensLoc [AnnAs,AnnVal])
+                         (AST.UImportRenaming <$> (annLocNoSema (tokenLoc AnnVal)
+                                                  (trfModuleName' mn)))
+
+trfImportSpecs :: TransformName n r => Maybe (Bool, Located [LIE n]) -> Trf (AnnMaybeG AST.UImportSpec (Dom r) RangeStage)
+trfImportSpecs (Just (True, l))
+  = makeJust <$> trfLocNoSema (\specs -> AST.UImportSpecHiding <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec (removeDuplicates specs)))) l
+trfImportSpecs (Just (False, l))
+  = makeJust <$> trfLocNoSema (\specs -> AST.UImportSpecList <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec (removeDuplicates specs)))) l
+trfImportSpecs Nothing = nothing " " "" atTheEnd
+
+trfIESpec :: TransformName n r => LIE n -> Trf (Maybe (Ann AST.UIESpec (Dom r) RangeStage))
+trfIESpec = trfMaybeLocNoSema trfIESpec'
+
+trfIESpec' :: TransformName n r => IE n -> Trf (Maybe (AST.UIESpec (Dom r) RangeStage))
+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 <$> subspec))
+  where subspec = annLocNoSema (combineSrcSpans <$> tokenLocBack AnnOpenP <*> tokenLocBack AnnCloseP) (pure AST.USubSpecAll)
+trfIESpec' (IEThingWith n _ ls flds)
+  = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n <*> (makeJust <$> subspec))
+  where subspec = annLocNoSema (combineSrcSpans <$> tokenLocBack AnnOpenP <*> tokenLocBack AnnCloseP)
+                    $ AST.USubSpecList <$> between AnnOpenP AnnCloseP (orderAnnList <$> makeList ", " atTheStart ((++) <$> mapM trfName ls <*> mapM trfName (map (fmap flSelector) flds)))
+trfIESpec' _ = pure Nothing
+
+trfImportModifier :: Trf (AnnMaybeG AST.UImportModifier (Dom r) RangeStage)
+trfImportModifier = do
+  patLoc <- tokenLoc AnnPattern
+  if isGoodSrcSpan patLoc then makeJust <$> annLocNoSema (return patLoc) (return AST.UImportPattern)
+                          else nothing " " "" atTheStart
+
+trfModuleName :: Located ModuleName -> Trf (Ann AST.UModuleName (Dom r) RangeStage)
+trfModuleName = trfLocNoSema trfModuleName'
+
+trfModuleName' :: ModuleName -> Trf (AST.UModuleName (Dom r) RangeStage)
+trfModuleName' = pure . AST.UModuleName . moduleNameString

@@ -0,0 +1,168 @@+{-# LANGUAGE TupleSections #-}
+-- | The transformation monad carries the necessary information that is passed top-down
+-- during the conversion from GHC AST to our representation.
+module Language.Haskell.Tools.BackendGHC.Monad where
+
+import Control.Applicative ((<|>))
+import Control.Monad.Reader
+import Control.Reference
+import Data.Function (on)
+import Data.List
+import Data.Map as Map (Map, lookup, empty)
+import Data.Maybe
+import Data.Maybe (fromMaybe)
+import Data.Monoid (Monoid(..))
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST.SemaInfoTypes (PName(..), UsageSpec(..))
+import Language.Haskell.Tools.BackendGHC.GHCUtils (HsHasName(..), rdrNameStr)
+import Language.Haskell.Tools.BackendGHC.SourceMap (SourceMap, annotationsToSrcMap)
+
+import ApiAnnotation (ApiAnnKey)
+import DynFlags (xopt_set)
+import ErrUtils (pprErrMsgBagWithLoc)
+import GHC
+import GHC.LanguageExtensions.Type (Extension(..))
+import HscTypes (HscEnv(..))
+import Name (Name, isVarName, isTyVarName)
+import OccName as GHC (HasOccName(..), mkOccEnv)
+import Outputable hiding (empty)
+import RdrName
+import RnEnv (mkUnboundNameRdr)
+import RnExpr (rnLExpr)
+import TcRnMonad
+import TcRnTypes (TcGblEnv(..))
+
+-- | The transformation monad type
+type Trf = ReaderT TrfInput Ghc
+
+-- | The (immutable) data for the transformation
+data TrfInput
+  = TrfInput { srcMap :: SourceMap -- ^ The lexical tokens of the source file
+             , pragmaComms :: Map String [Located String] -- ^ Pragma comments
+             , declsToInsert :: [Ann UDecl (Dom RdrName) RangeStage] -- ^ Declarations that are from the parsed AST
+             , contRange :: SrcSpan -- ^ The focus of the transformation
+             , localsInScope :: [[(GHC.Name, Maybe [UsageSpec], Maybe Name)]] -- ^ Local names visible
+             , defining :: Bool -- ^ True, if names are defined in the transformed AST element.
+             , definingTypeVars :: Bool -- ^ True, if type variable names are defined in the transformed AST element.
+             , originalNames :: Map SrcSpan RdrName -- ^ Stores the original format of names.
+             , declSplices :: [Located (HsSplice GHC.RdrName)] -- ^ Location of the TH splices for extracting declarations from the renamed AST.
+                 -- ^ It is possible that multiple declarations stand in the place of the declaration splice or none at all.
+             , typeSplices :: [Located (HsSplice GHC.RdrName)] -- ^ Type splices
+             , exprSplices :: [Located (HsSplice GHC.RdrName)] -- ^ Expression splices
+             }
+
+trfInit :: Map ApiAnnKey [SrcSpan] -> Map String [Located String] -> TrfInput
+trfInit annots comments
+  = TrfInput { srcMap = annotationsToSrcMap annots
+             , pragmaComms = comments
+             , declsToInsert = []
+             , contRange = noSrcSpan
+             , localsInScope = []
+             , defining = False
+             , definingTypeVars = False
+             , originalNames = empty
+             , declSplices = []
+             , typeSplices = []
+             , exprSplices = []
+             }
+
+liftGhc :: Ghc a -> Trf a
+liftGhc = lift
+
+-- | Perform the transformation taking names as defined.
+define :: Trf a -> Trf a
+define = local (\s -> s { defining = True })
+
+-- | Perform the transformation taking type variable names as defined.
+defineTypeVars :: Trf a -> Trf a
+defineTypeVars = local (\s -> s { definingTypeVars = True })
+
+-- | Transform as type variables
+typeVarTransform :: Trf a -> Trf a
+typeVarTransform = local (\s -> s { defining = defining s || definingTypeVars s })
+
+-- | Transform a name as a type variable if it is one.
+transformingPossibleVar :: HsHasName n => n -> Trf a -> Trf a
+transformingPossibleVar n = case hsGetNames Nothing 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.
+addToScopeImported :: [(String, Maybe String, Bool, [PName GHC.Name])] -> Trf a -> Trf a
+addToScopeImported ls = local (\s -> s { localsInScope = concatMap (\(mn, asName, q, e) -> map (\(PName n p) -> (n, Just [UsageSpec q mn (fromMaybe mn asName)], p)) e) ls : localsInScope s })
+
+
+-- | Perform the transformation putting the given definition in a new local scope.
+addToScope :: HsHasName e => e -> Trf a -> Trf a
+addToScope e = local (\s -> s { localsInScope = map (\(n,p) -> (n, Nothing, p)) (hsGetNames Nothing e) : localsInScope s })
+
+-- | Perform the transformation putting the given definitions in the current scope.
+addToCurrentScope :: HsHasName e => e -> Trf a -> Trf a
+addToCurrentScope e = local (\s -> s { localsInScope = case localsInScope s of lastScope:rest -> (map (\(n,p) -> (n, Nothing, p)) (hsGetNames Nothing e) ++ lastScope):rest
+                                                                               []             -> [map (\(n,p) -> (n, Nothing, p)) (hsGetNames Nothing e)] })
+
+-- | Performs the transformation given the tokens of the source file
+runTrf :: Map ApiAnnKey [SrcSpan] -> Map String [Located String] -> Trf a -> Ghc a
+runTrf annots comments trf = runReaderT trf (trfInit annots comments)
+
+setOriginalNames :: Map SrcSpan RdrName -> Trf a -> Trf a
+setOriginalNames names = local (\s -> s { originalNames = names })
+
+-- | Get the original format of a name (before scoping).
+getOriginalName :: RdrName -> Trf String
+getOriginalName n = do sp <- asks contRange
+                       asks (rdrNameStr . fromMaybe n . (Map.lookup sp) . originalNames)
+
+-- | Set splices that must replace the elements that are generated into the AST representation.
+setSplices :: [Located (HsSplice GHC.RdrName)] -> [Located (HsSplice GHC.RdrName)] -> [Located (HsSplice GHC.RdrName)] -> Trf a -> Trf a
+setSplices declSpls typeSpls exprSpls
+  = local (\s -> s { typeSplices = typeSpls, exprSplices = exprSpls, declSplices = declSpls })
+
+-- | Set the list of declarations that will be missing from AST
+setDeclsToInsert :: [Ann UDecl (Dom RdrName) RangeStage] -> Trf a -> Trf a
+setDeclsToInsert decls = local (\s -> s {declsToInsert = decls})
+
+-- Remove the splice that has already been added
+exprSpliceInserted :: Located (HsSplice n) -> Trf a -> Trf a
+exprSpliceInserted spl = local (\s -> s { exprSplices = Prelude.filter (\sp -> getLoc sp /= getLoc spl) (exprSplices s) })
+
+-- Remove the splice that has already been added
+typeSpliceInserted :: Located (HsSplice n) -> Trf a -> Trf a
+typeSpliceInserted spl = local (\s -> s { typeSplices = Prelude.filter (\sp -> getLoc sp /= getLoc spl) (typeSplices s) })
+
+rdrSplice :: HsSplice RdrName -> Trf (HsSplice GHC.Name)
+rdrSplice spl = do
+    env <- liftGhc getSession
+    locals <- unifyScopes [] <$> asks localsInScope
+    let createLocalGRE (n,imp,p) = [GRE n (maybe NoParent ParentIs p) (isNothing imp) (maybe [] (map createGREImport) imp) ]
+        createGREImport (UsageSpec q useQ asQ) = ImpSpec (ImpDeclSpec (mkModuleName useQ) (mkModuleName asQ) q noSrcSpan) ImpAll
+    let readEnv = mkOccEnv $ map (foldl1 (\e1 e2 -> (fst e1, snd e1 ++ snd e2))) $ groupBy ((==) `on` fst) $ sortOn fst
+                   $ map (\n -> (GHC.occName ((^. _1) n), createLocalGRE n))
+                   -- group up locals by name
+                   $ map (foldl1 (\e1 e2 -> ((^. _1) e1, (^. _2) e1 `mappend` (^. _2) e2, (^. _3) e1 <|> (^. _3) e2)))
+                   $ groupBy ((==) `on` (^. _1)) $ sortBy (compare `on` (^. _1)) locals
+    tcSpl <- liftIO $ runTcInteractive env { hsc_dflags = xopt_set (hsc_dflags env) TemplateHaskellQuotes }
+      $ updGblEnv (\gbl -> gbl { tcg_rdr_env = readEnv })
+      $ tcHsSplice' spl
+    let typecheckErrors = showSDocUnsafe (vcat (pprErrMsgBagWithLoc (fst (fst tcSpl)))
+                                            <+> vcat (pprErrMsgBagWithLoc (snd (fst tcSpl))))
+    when (not (null typecheckErrors)) $ liftIO $ putStrLn ("Typechecking of splice expressions: " ++ typecheckErrors)
+    return $ fromMaybe (error $ "Splice expression could not be typechecked.")
+                       (snd tcSpl)
+  where
+    tcHsSplice' (HsTypedSplice id e)
+      = HsTypedSplice (mkUnboundNameRdr id) <$> (fst <$> rnLExpr e)
+    tcHsSplice' (HsUntypedSplice id e)
+      = HsUntypedSplice (mkUnboundNameRdr id) <$> (fst <$> rnLExpr e)
+    tcHsSplice' (HsQuasiQuote id1 id2 sp fs)
+      = pure $ HsQuasiQuote (mkUnboundNameRdr id1) (mkUnboundNameRdr id2) sp fs
+
+
+    unifyScopes :: [GHC.Name] -> [[(GHC.Name, Maybe [UsageSpec], Maybe GHC.Name)]] -> [(GHC.Name, Maybe [UsageSpec], Maybe GHC.Name)]
+    unifyScopes _ [] = []
+    unifyScopes ex (sc:scs) = filteredSc ++ unifyScopes (ex ++ map (^. _1) filteredSc) scs
+      where filteredSc = filter ((\s -> isNothing $ find (\e -> occName e == occName s) ex) . (^. _1)) sc

@@ -0,0 +1,149 @@+{-# LANGUAGE LambdaCase
+           , TupleSections
+           , TypeFamilies
+           , FlexibleInstances
+           , FlexibleContexts
+           , TypeSynonymInstances
+           , ScopedTypeVariables
+           , MultiParamTypeClasses
+           , UndecidableInstances
+           , AllowAmbiguousTypes
+           , TypeApplications
+           #-}
+-- | Functions that convert the basic elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Names where
+
+import Control.Monad.Reader ((=<<), asks)
+import Data.Char (isAlphaNum)
+import Data.List.Split (splitOn)
+
+import FastString as GHC (FastString, unpackFS)
+import HsSyn as GHC
+import Name as GHC (isSymOcc, occNameString)
+import qualified Name as GHC (Name)
+import RdrName as GHC (RdrName)
+import SrcLoc as GHC
+
+import Language.Haskell.Tools.AST (Ann(..), AnnListG, RangeStage, Dom)
+import qualified Language.Haskell.Tools.AST as AST
+
+import Language.Haskell.Tools.BackendGHC.GHCUtils
+import Language.Haskell.Tools.BackendGHC.Monad
+import Language.Haskell.Tools.BackendGHC.Utils
+
+trfOperator :: TransformName n r => Located n -> Trf (Ann AST.UOperator (Dom r) RangeStage)
+trfOperator = trfLocNoSema trfOperator'
+
+trfOperator' :: TransformName n r => n -> Trf (AST.UOperator (Dom r) RangeStage)
+trfOperator' n
+  | isSymOcc (occName n) = AST.UNormalOp <$> trfQualifiedNameFocus True n
+  | otherwise = AST.UBacktickOp <$> trfQualifiedNameFocus True n
+
+trfName :: TransformName n r => Located n -> Trf (Ann AST.UName (Dom r) RangeStage)
+trfName = trfLocNoSema trfName'
+
+trfName' :: TransformName n r => n -> Trf (AST.UName (Dom r) RangeStage)
+trfName' n
+  | isSymOcc (occName n) = (if isSpecKind then AST.UNormalName else AST.UParenName) <$> trfQualifiedNameFocus isSpecKind n
+  | otherwise = AST.UNormalName <$> trfQualifiedNameFocus False n
+  where -- special names that are operators, but appear in name context
+    isSpecKind = occNameString (occName n) `elem` ["*", "#", "?", "??"]
+
+trfAmbiguousFieldName :: TransformName n r => Located (AmbiguousFieldOcc n) -> Trf (Ann AST.UName (Dom r) RangeStage)
+trfAmbiguousFieldName (L l af) = trfAmbiguousFieldName' l af
+
+trfAmbiguousFieldName' :: forall n r . TransformName n r => SrcSpan -> AmbiguousFieldOcc n -> Trf (Ann AST.UName (Dom r) RangeStage)
+trfAmbiguousFieldName' l (Unambiguous (L _ rdr) pr) = annLocNoSema (pure l) $ trfName' (unpackPostRn @n rdr pr)
+-- no Id transformation is done, so we can basically ignore the postTC value
+trfAmbiguousFieldName' _ (Ambiguous (L l rdr) _)
+  = annLocNoSema (pure l)
+      $ (if (isSymOcc (occName rdr)) then AST.UParenName else AST.UNormalName)
+          <$> (annLoc (createAmbigousNameInfo rdr l) (pure l) $ AST.nameFromList <$> trfNameStr (isSymOcc (occName rdr)) (rdrNameStr rdr))
+
+trfAmbiguousOperator' :: forall n r . TransformName n r => SrcSpan -> AmbiguousFieldOcc n -> Trf (Ann AST.UOperator (Dom r) RangeStage)
+trfAmbiguousOperator' l (Unambiguous (L _ rdr) pr) = annLocNoSema (pure l) $ trfOperator' (unpackPostRn @n rdr pr)
+-- no Id transformation is done, so we can basically ignore the postTC value
+trfAmbiguousFieldOperator' _ (Ambiguous (L l rdr) _)
+  = annLocNoSema (pure l)
+      $ (if (isSymOcc (occName rdr)) then AST.UNormalOp else AST.UBacktickOp)
+          <$> (annLoc (createAmbigousNameInfo rdr l) (pure l) $ AST.nameFromList <$> trfOperatorStr (not $ isSymOcc (occName rdr)) (rdrNameStr rdr))
+
+
+class (DataId n, Eq n, GHCName n, FromGHCName n) => TransformableName n where
+  correctNameString :: n -> Trf String
+  transformSplice :: HsSplice RdrName -> Trf (HsSplice n)
+
+instance TransformableName RdrName where
+  correctNameString = pure . rdrNameStr
+  transformSplice = pure
+
+instance TransformableName GHC.Name where
+  correctNameString n = getOriginalName (rdrName n)
+  transformSplice = rdrSplice
+
+-- | This class allows us to use the same transformation code for multiple variants of the GHC AST.
+-- GHC UName annotated with 'name' can be transformed to our representation with semantic annotations of 'res'.
+class (TransformableName name, HsHasName name, TransformableName res, HsHasName res, GHCName res)
+        => TransformName name res where
+  -- | Demote a given name
+  transformName :: name -> res
+
+instance {-# OVERLAPPABLE #-} (n ~ r, TransformableName n, HsHasName n) => TransformName n r where
+  transformName = id
+
+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 (isOperatorStr str) str))
+
+trfImplicitName :: HsIPName -> Trf (Ann AST.UName (Dom r) RangeStage)
+trfImplicitName (HsIPName fs)
+  = let nstr = unpackFS fs
+     in do rng <- asks contRange
+           let rng' = mkSrcSpan (updateCol (+1) (srcSpanStart rng)) (srcSpanEnd rng)
+           annContNoSema (AST.UImplicitName <$> annLoc (createImplicitNameInfo nstr) (pure rng')
+                                                  (AST.nameFromList <$> trfNameStr (isOperatorStr nstr) nstr))
+
+isOperatorStr :: String -> Bool
+isOperatorStr = any (not . isAlphaNum)
+
+trfQualifiedName :: TransformName n r => Bool -> Located n -> Trf (Ann AST.UQualifiedName (Dom r) RangeStage)
+trfQualifiedName isOperator (L l n) = focusOn l $ trfQualifiedNameFocus isOperator n
+
+trfQualifiedNameFocus :: TransformName n r => Bool -> n -> Trf (Ann AST.UQualifiedName (Dom r) RangeStage)
+trfQualifiedNameFocus isOperator n
+  = do rng <- asks contRange
+       let rng' = if isOperator == isSymOcc (occName n) then rng
+                    else mkSrcSpan (updateCol (+1) (srcSpanStart rng)) (updateCol (subtract 1) (srcSpanEnd rng))
+       annLoc (createNameInfo (transformName n)) (pure rng') (trfQualifiedName' n)
+
+trfQualifiedName' :: TransformName n r => n -> Trf (AST.UQualifiedName (Dom r) RangeStage)
+trfQualifiedName' n = AST.nameFromList <$> ((if isSymOcc (occName n) then trfOperatorStr else trfNameStr) False =<< correctNameString n)
+
+trfOperatorStr :: Bool -> String -> Trf (AnnListG AST.UNamePart (Dom r) RangeStage)
+trfOperatorStr isInParen str = do rng <- correctSpan <$> asks contRange
+                                  makeList "." (pure $ srcSpanStart rng)
+                                               (pure [Ann (noSemaInfo $ AST.NodeSpan rng) (AST.UNamePart str)])
+  where correctSpan sp = if isInParen then mkSrcSpan (updateCol (+1) (srcSpanStart sp))
+                                                     (updateCol (subtract 1) (srcSpanEnd sp))
+                                      else sp
+
+-- | Creates a qualified name from a name string
+trfNameStr :: Bool -> String -> Trf (AnnListG AST.UNamePart (Dom r) RangeStage)
+trfNameStr isInBackticks str = makeList "." atTheStart (trfNameStr' str . correct <$> atTheStart)
+  where correct = if isInBackticks then updateCol (+1) else id
+
+trfNameStr' :: String -> SrcLoc -> [Ann AST.UNamePart (Dom r) RangeStage]
+trfNameStr' str startLoc = fst $
+  foldl (\(r,loc) np -> let nextLoc = advanceAllSrcLoc loc np
+                         in ( r ++ [Ann (noSemaInfo $ AST.NodeSpan (mkSrcSpan loc nextLoc)) (AST.UNamePart np)], advanceAllSrcLoc nextLoc "." ) )
+  ([], startLoc) (splitOn "." str)
+  where -- | Move the source location according to a string
+        advanceAllSrcLoc :: SrcLoc -> String -> SrcLoc
+        advanceAllSrcLoc (RealSrcLoc rl) str = RealSrcLoc $ foldl advanceSrcLoc rl str
+        advanceAllSrcLoc oth _ = oth
+
+trfFastString :: Located FastString -> Trf (Ann AST.UStringNode (Dom r) RangeStage)
+trfFastString = trfLocNoSema $ pure . AST.UStringNode . unpackFS

@@ -0,0 +1,72 @@+{-# LANGUAGE LambdaCase
+           , ViewPatterns
+           , ScopedTypeVariables
+           , AllowAmbiguousTypes
+           #-}
+-- | Functions that convert the pattern-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Patterns where
+
+import ApiAnnotation as GHC (AnnKeywordId(..))
+import BasicTypes as GHC (Boxity(..))
+import Data.List
+import HsExpr (HsSplice(..))
+import HsLit as GHC (HsOverLit(..))
+import HsPat as GHC
+import HsTypes as GHC (HsWildCardBndrs(..), HsImplicitBndrs(..), HsConDetails(..))
+import Language.Haskell.Tools.BackendGHC.GHCUtils (getFieldOccName)
+import SrcLoc as GHC
+
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.Exprs (trfExpr)
+import Language.Haskell.Tools.BackendGHC.Literals (trfLiteral', trfOverloadedLit)
+import Language.Haskell.Tools.BackendGHC.Monad (Trf, define)
+import Language.Haskell.Tools.BackendGHC.Names (TransformName(..), trfOperator, trfName)
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.TH (trfSplice, trfQuasiQuotation')
+import Language.Haskell.Tools.BackendGHC.Types (trfType)
+import Language.Haskell.Tools.BackendGHC.Utils
+
+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
+  = focusOn l $ do
+      let (fromWC, notWC) = partition ((l ==) . getLoc) flds
+      normalFields <- mapM (trfLocNoSema trfPatternField') notWC
+      wildc <- annLocNoSema (tokenLocBack 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)
+correctPatternLoc (L _ p@(ConPatIn _ (InfixCon left right)))
+  = L (getLoc (correctPatternLoc left) `combineSrcSpans` getLoc (correctPatternLoc right)) p
+correctPatternLoc p = p
+
+trfPattern' :: TransformName n r => Pat n -> Trf (AST.UPattern (Dom r) RangeStage)
+trfPattern' (WildPat _) = pure AST.UWildPat
+trfPattern' (VarPat name) = define $ AST.UVarPat <$> trfName name
+trfPattern' (LazyPat pat) = AST.UIrrefutablePat <$> trfPattern pat
+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 <$> 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
+trfPattern' (SplicePat qq@(HsQuasiQuote {})) = AST.UQuasiQuotePat <$> annContNoSema (trfQuasiQuotation' qq)
+trfPattern' (SplicePat splice) = AST.USplicePat <$> trfSplice splice
+trfPattern' (LitPat lit) = AST.ULitPat <$> annContNoSema (trfLiteral' lit)
+trfPattern' (SigPatIn pat (hswc_body . hsib_body -> typ)) = AST.UTypeSigPat <$> trfPattern pat <*> trfType typ
+trfPattern' (NPat (ol_val . unLoc -> lit) _ _ _) = AST.ULitPat <$> annContNoSema (trfOverloadedLit lit)
+trfPattern' (NPlusKPat id (L l lit) _ _ _ _) = AST.UNPlusKPat <$> define (trfName id) <*> annLocNoSema (pure l) (trfOverloadedLit (ol_val lit))
+trfPattern' (CoPat _ pat _) = trfPattern' pat -- coercion pattern introduced by GHC
+trfPattern' p = unhandledElement "pattern" p
+
+trfPatternField' :: TransformName n r => HsRecField n (LPat n) -> Trf (AST.UPatternField (Dom r) RangeStage)
+trfPatternField' (HsRecField id arg False) = AST.UNormalFieldPattern <$> trfName (getFieldOccName id) <*> trfPattern arg
+trfPatternField' (HsRecField id _ True) = AST.UFieldPunPattern <$> trfName (getFieldOccName id)

@@ -0,0 +1,57 @@+{-# LANGUAGE TupleSections #-}
+-- | A representation of the tokens that build up the source file.
+module Language.Haskell.Tools.BackendGHC.SourceMap where
+
+import ApiAnnotation (AnnKeywordId, ApiAnnKey)
+import Data.List as List
+import Data.Map as Map
+import Data.Maybe (Maybe(..), maybe, fromMaybe)
+import Safe (headMay)
+
+import SrcLoc as GHC
+
+-- We store tokens in the source map so it is not a problem that they cannot overlap
+type SourceMap = (Map AnnKeywordId (Map SrcLoc SrcLoc), Map SrcLoc (SrcSpan, AnnKeywordId))
+
+-- | Returns the first occurrence of the keyword in the whole source file
+getKeywordAnywhere :: AnnKeywordId -> SourceMap -> Maybe SrcSpan
+getKeywordAnywhere keyw srcmap = return . uncurry mkSrcSpan =<< headMay . assocs =<< (Map.lookup keyw (fst srcmap))
+
+-- | Get the source location of a token restricted to a certain source span
+getKeywordInside :: AnnKeywordId -> SrcSpan -> SourceMap -> Maybe SrcSpan
+getKeywordInside keyw sr srcmap = getSourceElementInside True sr =<< Map.lookup keyw (fst srcmap)
+
+getKeywordsInside :: AnnKeywordId -> SrcSpan -> SourceMap -> [SrcSpan]
+getKeywordsInside keyw sr srcmap
+  = let tokensOfType = Map.lookup keyw (fst srcmap)
+        (_, startsAtBegin, startAfterBegin) = Map.splitLookup (srcSpanStart sr) $ fromMaybe empty tokensOfType
+        (startsBeforeEnd, _) = Map.split (srcSpanEnd sr) $ maybe id (Map.insert (srcSpanStart sr)) startsAtBegin startAfterBegin -- tokens are minimum 1 char long
+     in List.map (uncurry mkSrcSpan) $ List.filter (\(_, end) -> end <= srcSpanEnd sr) $ assocs startsBeforeEnd
+
+getKeywordInsideBack :: AnnKeywordId -> SrcSpan -> SourceMap -> Maybe SrcSpan
+getKeywordInsideBack keyw sr srcmap = getSourceElementInside False sr =<< Map.lookup keyw (fst srcmap)
+
+getSourceElementInside :: Bool -> SrcSpan -> Map SrcLoc SrcLoc -> Maybe SrcSpan
+getSourceElementInside b sr srcmap =
+  case (if b then lookupGE (srcSpanStart sr) else lookupLT (srcSpanEnd sr)) srcmap of
+    Just (k, v) -> let sp = mkSrcSpan k v in if sp `isSubspanOf` sr then Just sp else Nothing
+    Nothing -> Nothing
+
+-- | Returns the next token on the token stream (including the token that starts on the given location)
+getNextToken :: SrcLoc -> SourceMap -> Maybe (SrcSpan, AnnKeywordId)
+getNextToken loc srcmap = fmap snd $ Map.lookupGE loc $ snd srcmap
+
+-- | Returns all subsequent tokens (including the token that starts on the given location)
+getTokensAfter :: SrcLoc -> SourceMap -> [(SrcSpan, AnnKeywordId)]
+getTokensAfter loc srcmap = case Map.splitLookup loc $ snd srcmap of
+    (_, Just elem, after) -> elem : elems after
+    (_, Nothing, after) -> elems after
+
+-- | Converts GHC Annotations into a convenient format for looking up tokens
+annotationsToSrcMap :: Map ApiAnnKey [SrcSpan] -> SourceMap
+annotationsToSrcMap anns = (Map.map (List.foldr addToSrcRanges Map.empty) $ mapKeysWith (++) snd anns, tokenMap)
+  where
+    addToSrcRanges :: SrcSpan -> Map SrcLoc SrcLoc -> Map SrcLoc SrcLoc
+    addToSrcRanges span srcmap = Map.insert (srcSpanStart span) (srcSpanEnd span) srcmap
+
+    tokenMap = Map.fromList $ List.map (\(k,v) -> (srcSpanStart k, (k, v))) $ concatMap (\(key,vals) -> List.map ((, snd key)) vals) $ Map.assocs anns

@@ -0,0 +1,81 @@+{-# LANGUAGE LambdaCase
+           , ViewPatterns
+           , TypeFamilies
+           #-}
+-- | Functions that convert the statement-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Stmts where
+
+import Control.Monad.Reader (MonadReader(..))
+
+import ApiAnnotation as GHC (AnnKeywordId(..))
+import HsExpr as GHC
+import Outputable (Outputable)
+import SrcLoc as GHC
+
+import Language.Haskell.Tools.AST (Ann, AnnListG, Dom, RangeStage)
+import qualified Language.Haskell.Tools.AST as AST
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.Binds (trfLocalBinds)
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.Exprs (trfExpr)
+import Language.Haskell.Tools.BackendGHC.Monad (TrfInput(..), Trf, addToScope)
+import Language.Haskell.Tools.BackendGHC.Names (TransformName(..))
+import Language.Haskell.Tools.BackendGHC.Patterns (trfPattern)
+import Language.Haskell.Tools.BackendGHC.Utils
+
+import Data.Data (Data)
+
+trfDoStmt :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf (Ann AST.UStmt (Dom r) RangeStage)
+trfDoStmt = trfLocNoSema trfDoStmt'
+
+trfDoStmt' :: TransformName n r => Stmt n (Located (HsExpr n)) -> Trf (AST.UStmt' AST.UExpr (Dom r) RangeStage)
+trfDoStmt' = gTrfDoStmt' trfExpr
+
+gTrfDoStmt' :: (TransformName n r, Data (ge n), Outputable (ge n))
+            => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> Stmt n (Located (ge n)) -> Trf (AST.UStmt' ae (Dom r) RangeStage)
+gTrfDoStmt' et (BindStmt pat expr _ _ _) = AST.UBindStmt <$> trfPattern pat <*> et expr
+gTrfDoStmt' et (BodyStmt expr _ _ _) = AST.UExprStmt <$> et expr
+gTrfDoStmt' _ (LetStmt (unLoc -> binds)) = AST.ULetStmt . orderAnnList <$> addToScope binds (trfLocalBinds AnnLet binds)
+gTrfDoStmt' et (LastStmt body _ _) = AST.UExprStmt <$> et body
+gTrfDoStmt' et (RecStmt { recS_stmts = stmts }) = AST.URecStmt <$> trfAnnList "," (gTrfDoStmt' et) stmts
+gTrfDoStmt' _ stmt = unhandledElement "simple statement" stmt
+
+trfListCompStmts :: TransformName n r => [Located (Stmt n (LHsExpr n))] -> Trf (AnnListG AST.UListCompBody (Dom r) RangeStage)
+trfListCompStmts [unLoc -> ParStmt blocks _ _ _, unLoc -> (LastStmt {})]
+  = nonemptyAnnList
+      <$> trfScopedSequence (\(ParStmtBlock stmts _ _) ->
+                                let ann = collectLocs $ getNormalStmts stmts
+                                 in annLocNoSema (pure ann) (AST.UListCompBody <$> makeList "," (pure $ srcSpanStart ann) (concat <$> trfScopedSequence trfListCompStmt stmts))
+                            ) blocks
+trfListCompStmts others
+  = let ann = (collectLocs $ getNormalStmts others)
+     in makeList "|" (pure $ srcSpanStart ann)
+          ((:[]) <$> annLocNoSema (pure ann)
+                                  (AST.UListCompBody <$> makeList "," (pure $ srcSpanStart ann) (concat <$> trfScopedSequence trfListCompStmt others)))
+
+trfListCompStmt :: TransformName n r => Located (Stmt n (LHsExpr n)) -> Trf [Ann AST.UCompStmt (Dom r) RangeStage]
+trfListCompStmt (L _ trst@(TransStmt { trS_stmts = stmts }))
+  = (++) <$> (concat <$> local (\s -> s { contRange = mkSrcSpan (srcSpanStart (contRange s)) (srcSpanEnd (getLoc (last stmts))) }) (trfScopedSequence trfListCompStmt stmts))
+         <*> ((:[]) <$> extractActualStmt trst)
+-- last statement is extracted
+trfListCompStmt (unLoc -> LastStmt _ _ _) = pure []
+trfListCompStmt other = (:[]) <$> copyAnnot AST.UCompStmt (trfDoStmt other)
+
+extractActualStmt :: TransformName n r => Stmt n (LHsExpr n) -> Trf (Ann AST.UCompStmt (Dom r) RangeStage)
+extractActualStmt = \case
+  TransStmt { trS_form = ThenForm, trS_using = using, trS_by = by }
+    -> addAnnotation by using (AST.UThenStmt <$> trfExpr using <*> trfMaybe "," "" trfExpr by)
+  TransStmt { trS_form = GroupForm, trS_using = using, trS_by = by }
+    -> addAnnotation by using (AST.UGroupStmt <$> trfMaybe "," "" trfExpr by <*> (makeJust <$> trfExpr using))
+  _ -> error "extractActualStmt: called on a statement that is not then or group"
+  where addAnnotation by using
+          = annLocNoSema (combineSrcSpans (getLoc using) . combineSrcSpans (maybe noSrcSpan getLoc by)
+                            <$> tokenLocBack AnnThen)
+
+getNormalStmts :: [Located (Stmt n (LHsExpr n))] -> [Located (Stmt n (LHsExpr n))]
+getNormalStmts (L _ (LastStmt _ _ _) : rest) = getNormalStmts rest
+getNormalStmts (stmt : rest) = stmt : getNormalStmts rest
+getNormalStmts [] = []
+
+getLastStmt :: [Located (Stmt n (LHsExpr n))] -> Located (HsExpr n)
+getLastStmt (L _ (LastStmt body _ _) : _) = body
+getLastStmt (_ : rest) = getLastStmt rest
+getLastStmt [] = error "getLastStmt: empty"

@@ -0,0 +1,70 @@+{-# LANGUAGE LambdaCase #-}
+-- | Functions that convert the Template-Haskell-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.TH where
+
+import Control.Monad.Reader (asks)
+
+import ApiAnnotation as GHC (AnnKeywordId(..))
+import FastString as GHC (unpackFS)
+import HsExpr as GHC (HsSplice(..), HsExpr(..), HsBracket(..))
+import SrcLoc as GHC
+
+import Language.Haskell.Tools.BackendGHC.Decls (trfDecls, trfDeclsGroup)
+import Language.Haskell.Tools.BackendGHC.Exprs (trfExpr, createScopeInfo)
+import Language.Haskell.Tools.BackendGHC.Monad (TrfInput(..), Trf)
+import Language.Haskell.Tools.BackendGHC.Names
+import Language.Haskell.Tools.BackendGHC.Patterns (trfPattern)
+import Language.Haskell.Tools.BackendGHC.Types (trfType)
+import Language.Haskell.Tools.BackendGHC.Utils
+
+import Language.Haskell.Tools.AST (Ann, Dom, RangeStage)
+import qualified Language.Haskell.Tools.AST as AST
+
+trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.UQuasiQuote (Dom r) RangeStage)
+ -- the lexer does not provide us with tokens '[', '|' and '|]'
+trfQuasiQuotation' (HsQuasiQuote _ id l str)
+  = AST.UQuasiQuote <$> annLocNoSema quoterLoc (trfName' id)
+                    <*> annLocNoSema (pure strLoc) (pure $ AST.QQString (unpackFS str))
+  where -- assume that there are no white spaces ain the head and the end of the quasi quote
+        quoterLoc = do rng <- asks contRange
+                       return $ mkSrcSpan (updateCol (+1) (srcSpanStart rng)) (updateCol (subtract 1) (srcSpanStart l))
+        strLoc = mkSrcSpan (srcSpanStart l) (updateCol (subtract 2) (srcSpanEnd l))
+trfQuasiQuotation' qq = unhandledElement "quasi quotation" qq
+
+trfSplice :: TransformName n r => HsSplice n -> Trf (Ann AST.USplice (Dom r) RangeStage)
+trfSplice spls = do rng <- asks contRange
+                    annLocNoSema (pure $ getSpliceLoc spls `mappend` rng) (trfSplice' spls)
+
+getSpliceLoc :: HsSplice a -> SrcSpan
+getSpliceLoc (HsTypedSplice _ e) = getLoc e
+getSpliceLoc (HsUntypedSplice _ e) = getLoc e
+getSpliceLoc (HsQuasiQuote _ _ sp _) = sp
+getSpliceLoc (HsSpliced _ _) = noSrcSpan
+
+trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.USplice (Dom r) RangeStage)
+trfSplice' (HsTypedSplice _ expr) = trfSpliceExpr expr
+trfSplice' (HsUntypedSplice _ expr) = trfSpliceExpr expr
+trfSplice' s = unhandledElement "splice" s
+
+trfSpliceExpr :: TransformName n r => Located (HsExpr n) -> Trf (AST.USplice (Dom r) RangeStage)
+trfSpliceExpr expr =
+  do hasDollar <- allTokenLoc AnnThIdSplice
+     hasDoubleDollar <- allTokenLoc AnnThIdTySplice
+     let newSp = case (hasDollar, hasDoubleDollar) of
+                   ([], []) -> getLoc expr
+                   (_, []) -> updateStart (updateCol (+1)) (getLoc expr)
+                   ([], _) -> updateStart (updateCol (+2)) (getLoc expr)
+     case expr of L _ (HsVar (L _ varName)) -> AST.UIdSplice <$> trfName (L newSp varName)
+                  L _ (HsRecFld fldName) -> AST.UIdSplice <$> trfAmbiguousFieldName' newSp fldName
+                  expr -> AST.UParenSplice <$> trfExpr expr
+
+trfBracket' :: TransformName n r => HsBracket n -> Trf (AST.UBracket (Dom r) RangeStage)
+trfBracket' (ExpBr expr) = AST.UExprBracket <$> trfExpr expr
+trfBracket' (TExpBr expr) = AST.UExprBracket <$> trfExpr expr
+trfBracket' (VarBr isSingle expr)
+  = AST.UExprBracket <$> annLoc createScopeInfo (updateStart (updateCol (if isSingle then (+1) else (+2))) <$> asks contRange)
+      (AST.UVar <$> (annContNoSema (trfName' expr)))
+trfBracket' (PatBr pat) = AST.UPatternBracket <$> trfPattern pat
+trfBracket' (DecBrL decls) = AST.UDeclsBracket <$> trfDecls decls
+trfBracket' (DecBrG decls) = AST.UDeclsBracket <$> trfDeclsGroup decls
+trfBracket' (TypBr typ) = AST.UTypeBracket <$> trfType typ

@@ -0,0 +1,12 @@+module Language.Haskell.Tools.BackendGHC.TH where
+
+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.BackendGHC.Monad (Trf)
+import Language.Haskell.Tools.BackendGHC.Names (TransformName(..))
+
+trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.UQuasiQuote (Dom r) RangeStage)
+trfSplice :: TransformName n r => HsSplice n -> Trf (Ann AST.USplice (Dom r) RangeStage)
+trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.USplice (Dom r) RangeStage)
+trfBracket' :: TransformName n r => HsBracket n -> Trf (AST.UBracket (Dom r) RangeStage)

@@ -0,0 +1,121 @@+{-# LANGUAGE LambdaCase
+           , ViewPatterns
+           , ScopedTypeVariables
+           #-}
+-- | Functions that convert the type-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Types where
+
+import ApiAnnotation as GHC (AnnKeywordId(..))
+import HsExpr (HsSplice(..))
+import HsTypes as GHC
+import Id (mkVanillaGlobal)
+import SrcLoc as GHC
+import TyCon as GHC (TyCon(..))
+import TysWiredIn (heqTyCon)
+
+import Control.Applicative (Applicative(..), (<$>), Alternative(..))
+import Control.Monad.Reader.Class (asks)
+import Control.Reference ((^.))
+import Data.Function (on)
+import Data.List
+import Data.Maybe (Maybe(..), fromJust)
+
+import Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.BackendGHC.GHCUtils (GHCName(..), cleanHsType)
+import Language.Haskell.Tools.BackendGHC.Kinds (trfKindSig, trfKind, trfPromoted')
+import Language.Haskell.Tools.BackendGHC.Monad
+import Language.Haskell.Tools.BackendGHC.Names
+import {-# SOURCE #-} Language.Haskell.Tools.BackendGHC.TH (trfSplice, trfQuasiQuotation')
+import Language.Haskell.Tools.BackendGHC.Utils
+
+trfType :: TransformName n r => Located (HsType n) -> Trf (Ann AST.UType (Dom r) RangeStage)
+trfType typ | RealSrcSpan loce <- getLoc typ
+  = do othSplices <- asks typeSplices
+       let contSplice = filter (\sp -> case getLoc sp of (RealSrcSpan spLoc) -> spLoc `containsSpan` loce; _ -> False) othSplices
+       case contSplice of [] -> trfLocNoSema trfType' typ
+                          _ -> let lsp@(L l sp) = minimumBy (compareSpans `on` getLoc) contSplice
+                                in typeSpliceInserted lsp (annLocNoSema (pure l) (AST.UTySplice <$> (trfSplice =<< rdrSplice sp)))
+  | otherwise = trfLocNoSema trfType' typ
+
+trfType' :: TransformName n r => HsType n -> Trf (AST.UType (Dom r) RangeStage)
+trfType' = trfType'' . cleanHsType where
+  trfType'' (HsForAllTy [] typ) = trfType' (unLoc typ)
+  trfType'' (HsForAllTy bndrs typ) = AST.UTyForall <$> defineTypeVars (trfBindings bndrs)
+                                                   <*> addToScope bndrs (trfType typ)
+  trfType'' (HsQualTy (L _ []) typ) = trfType' (unLoc typ)
+  trfType'' (HsQualTy ctx typ) = AST.UTyCtx <$> (fromJust . (^. annMaybe) <$> trfCtx atTheStart ctx)
+                                            <*> trfType typ
+  trfType'' (HsTyVar name) = AST.UTyVar <$> transformingPossibleVar name (trfName name)
+  trfType'' (HsAppsTy apps) | Just (head, args) <- getAppsTyHead_maybe apps
+    = foldl (\core t -> AST.UTyApp <$> annLocNoSema (pure $ getLoc head `combineSrcSpans` getLoc t) core <*> trfType t) (trfType' (unLoc head)) args
+  trfType'' (HsAppTy t1 t2) = AST.UTyApp <$> trfType t1 <*> trfType t2
+  trfType'' (HsFunTy t1 t2) = AST.UTyFun <$> trfType t1 <*> trfType t2
+  trfType'' (HsListTy typ) = AST.UTyList <$> trfType typ
+  trfType'' (HsPArrTy typ) = AST.UTyParArray <$> trfType typ
+  trfType'' (HsTupleTy HsBoxedOrConstraintTuple typs) = AST.UTyTuple <$> trfAnnList ", " trfType' typs
+  trfType'' (HsTupleTy HsBoxedTuple typs) = AST.UTyTuple <$> trfAnnList ", " trfType' typs
+  trfType'' (HsTupleTy HsUnboxedTuple typs) = AST.UTyUnbTuple <$> trfAnnList ", " trfType' typs
+  trfType'' (HsOpTy t1 op t2) = AST.UTyInfix <$> trfType t1 <*> trfOperator op <*> trfType t2
+  trfType'' (HsParTy typ) = AST.UTyParen <$> trfType typ
+  trfType'' (HsKindSig typ kind) = AST.UTyKinded <$> trfType typ <*> trfKind kind
+  trfType'' (HsSpliceTy qq@(HsQuasiQuote {}) _) = AST.UTyQuasiQuote <$> annContNoSema (trfQuasiQuotation' qq)
+  trfType'' (HsSpliceTy splice _) = AST.UTySplice <$> trfSplice splice
+  trfType'' (HsBangTy (HsSrcBang _ SrcUnpack _) typ) = AST.UTyUnpack <$> trfType typ
+  trfType'' (HsBangTy (HsSrcBang _ SrcNoUnpack _) typ) = AST.UTyNoUnpack <$> trfType typ
+  trfType'' (HsBangTy (HsSrcBang _ _ SrcStrict) typ) = AST.UTyBang <$> trfType typ
+  trfType'' (HsBangTy (HsSrcBang _ _ SrcLazy) typ) = AST.UTyLazy <$> trfType typ
+  trfType'' pt@(HsExplicitListTy {}) = AST.UTyPromoted <$> annContNoSema (trfPromoted' trfType' pt)
+  trfType'' pt@(HsExplicitTupleTy {}) = AST.UTyPromoted <$> annContNoSema (trfPromoted' trfType' pt)
+  trfType'' pt@(HsTyLit {}) = AST.UTyPromoted <$> annContNoSema (trfPromoted' trfType' pt)
+  trfType'' (HsWildCardTy _) = pure AST.UTyWildcard -- TODO: named wildcards
+  trfType'' t = unhandledElement "type" t
+
+trfBindings :: TransformName n r => [Located (HsTyVarBndr n)] -> Trf (AnnListG AST.UTyVar (Dom r) RangeStage)
+trfBindings vars = trfAnnList " " trfTyVar' vars
+
+trfTyVar :: TransformName n r => Located (HsTyVarBndr n) -> Trf (Ann AST.UTyVar (Dom r) RangeStage)
+trfTyVar = trfLocNoSema trfTyVar'
+
+trfTyVar' :: TransformName n r => HsTyVarBndr n -> Trf (AST.UTyVar (Dom r) RangeStage)
+trfTyVar' (UserTyVar name) = AST.UTyVarDecl <$> typeVarTransform (trfName name)
+                                           <*> (nothing " " "" atTheEnd)
+trfTyVar' (KindedTyVar name kind) = AST.UTyVarDecl <$> typeVarTransform (trfName name)
+                                                  <*> trfKindSig (Just kind)
+
+trfCtx :: TransformName n r => Trf SrcLoc -> Located (HsContext n) -> Trf (AnnMaybeG AST.UContext (Dom r) RangeStage)
+trfCtx sp (L _ []) = nothing " " "" sp
+trfCtx _ (L l [L _ (HsParTy t)])
+  = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow)
+                              (AST.UContext <$> annLocNoSema (pure l) (AST.UTupleAssert <$> (trfAnnList ", " trfAssertion' [t])))
+trfCtx _ (L l [t])
+  = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow)
+                              (AST.UContext <$> trfAssertion t)
+trfCtx _ (L l ctx) = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow)
+                                               (AST.UContext <$> annLocNoSema (pure l) (AST.UTupleAssert <$> (trfAnnList ", " trfAssertion' ctx)))
+
+trfAssertion :: TransformName n r => LHsType n -> Trf (Ann AST.UAssertion (Dom r) RangeStage)
+trfAssertion = trfLocNoSema trfAssertion'
+
+trfAssertion' :: forall n r . TransformName n r => HsType n -> Trf (AST.UAssertion (Dom r) RangeStage)
+trfAssertion' (cleanHsType -> HsParTy t)
+  = trfAssertion' (unLoc t)
+trfAssertion' (cleanHsType -> HsOpTy left op right)
+  = AST.UInfixAssert <$> trfType left <*> trfOperator op <*> trfType right
+trfAssertion' (cleanHsType -> HsTupleTy _ tys)
+  = AST.UTupleAssert <$> makeList ", " (after AnnOpenP) (mapM trfAssertion tys)
+trfAssertion' (cleanHsType -> HsWildCardTy _)
+  = pure AST.UWildcardAssert
+trfAssertion' (cleanHsType -> t) = case cleanHsType base of
+   HsTyVar name -> AST.UClassAssert <$> trfName name <*> trfAnnList " " trfType' args
+   HsEqTy t1 t2 -> AST.UInfixAssert <$> trfType t1 <*> annLocNoSema (tokenLoc AnnTilde) (trfOperator' typeEq) <*> trfType t2
+   HsIParamTy name t -> do loc <- tokenLoc AnnVal
+                           AST.UImplicitAssert <$> define (focusOn loc (trfImplicitName name)) <*> trfType t
+   t -> unhandledElement "assertion" t
+  where (args, _, base) = getArgs t
+
+        getArgs :: HsType n -> ([LHsType n], Maybe SrcSpan, HsType n)
+        getArgs (HsAppTy (L l ft) at) = case getArgs ft of (args, sp, base) -> (args++[at], sp <|> Just l, base)
+        getArgs t = ([], Nothing, t)
+
+        typeEq :: n
+        typeEq = nameFromId (mkVanillaGlobal (tyConName heqTyCon) (tyConKind heqTyCon))

@@ -0,0 +1,9 @@+-- | Functions that convert the type-related elements of the GHC AST to corresponding elements in the Haskell-tools AST representation
+module Language.Haskell.Tools.BackendGHC.Types where
+
+import HsTypes as GHC (HsType)
+import Language.Haskell.Tools.AST as AST (UType, Dom, RangeStage)
+import Language.Haskell.Tools.BackendGHC.Monad (Trf)
+import Language.Haskell.Tools.BackendGHC.Names (TransformName)
+
+trfType' :: TransformName n r => HsType n -> Trf (AST.UType (Dom r) RangeStage)

@@ -0,0 +1,466 @@+-- | Utility functions for transforming the GHC AST representation into our own.
+{-# LANGUAGE TypeSynonymInstances
+           , FlexibleInstances
+           , LambdaCase
+           , ViewPatterns
+           , MultiParamTypeClasses
+           , FlexibleContexts
+           , AllowAmbiguousTypes
+           , TypeApplications
+           , TypeFamilies
+           #-}
+module Language.Haskell.Tools.BackendGHC.Utils where
+
+import ApiAnnotation (AnnKeywordId)
+import Avail (availNamesWithSelectors, availNames, availName)
+import BasicTypes (StringLiteral(..))
+import CoAxiom as GHC (CoAxiom(..))
+import CoreSyn as GHC (isOrphan)
+import DynFlags (xopt)
+import FamInstEnv as GHC (FamInst(..), famInstEnvElts)
+import FastString (unpackFS, mkFastString)
+import FieldLabel as GHC (FieldLbl(..))
+import GHC
+import HsSyn
+import HscTypes
+import Id (idName)
+import InstEnv as GHC (ClsInst(..), instanceDFunId, instEnvElts)
+import Language.Haskell.TH.LanguageExtensions (Extension(..))
+import Module as GHC
+import Name
+import Outputable (Outputable(..), showSDocUnsafe)
+import SrcLoc
+
+import Control.Monad.Reader
+import Control.Reference ((^.), (&))
+import Data.Char (isSpace)
+import Data.Data (Data(..))
+import Data.Either (Either(..), rights, lefts)
+import Data.Function hiding ((&))
+import Data.IORef (readIORef)
+import Data.List
+import Data.Maybe
+import Language.Haskell.Tools.AST as AST
+import Language.Haskell.Tools.AST.SemaInfoTypes as Sema
+import Language.Haskell.Tools.BackendGHC.GHCUtils
+import Language.Haskell.Tools.BackendGHC.Monad
+import Language.Haskell.Tools.BackendGHC.SourceMap
+
+createModuleInfo :: ModSummary -> SrcSpan -> [LImportDecl n] -> Trf (Sema.ModuleInfo GHC.Name)
+createModuleInfo mod nameLoc (filter (not . ideclImplicit . unLoc) -> imports) = do
+  let prelude = (xopt ImplicitPrelude $ ms_hspp_opts mod)
+                  && all (\idecl -> ("Prelude" /= (GHC.moduleNameString $ unLoc $ ideclName $ unLoc idecl))
+                                      || nameLoc == getLoc idecl) imports
+  (_,preludeImports) <- if prelude then getImportedNames "Prelude" Nothing else return (ms_mod mod, [])
+  (insts, famInsts) <- if prelude then lift $ getOrphanAndFamInstances (Module baseUnitId (GHC.mkModuleName "Prelude"))
+                                  else return ([], [])
+  return $ mkModuleInfo (ms_mod mod) (ms_hspp_opts mod) (case ms_hsc_src mod of HsSrcFile -> False; _ -> True) preludeImports insts famInsts
+
+-- | Creates a semantic information for a name
+createNameInfo :: n -> Trf (NameInfo n)
+createNameInfo name = do locals <- asks localsInScope
+                         isDefining <- asks defining
+                         return (mkNameInfo locals isDefining name)
+
+-- | Creates a semantic information for an ambiguous name (caused by field disambiguation for example)
+createAmbigousNameInfo :: RdrName -> SrcSpan -> Trf (NameInfo n)
+createAmbigousNameInfo name span = do locals <- asks localsInScope
+                                      isDefining <- asks defining
+                                      return (mkAmbiguousNameInfo locals isDefining name span)
+
+-- | Creates a semantic information for an implicit name
+createImplicitNameInfo :: String -> Trf (NameInfo n)
+createImplicitNameInfo name = do locals <- asks localsInScope
+                                 isDefining <- asks defining
+                                 rng <- asks contRange
+                                 return (mkImplicitNameInfo locals isDefining name rng)
+
+-- | 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 = ( 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)
+createImportData (GHC.ImportDecl _ name pkg _ _ _ _ _ declHiding) =
+  do (mod,importedNames) <- getImportedNames (GHC.moduleNameString $ unLoc name) (fmap (unpackFS . sl_fs) pkg)
+     names <- liftGhc $ filterM (checkImportVisible declHiding . (^. pName)) importedNames
+     -- TODO: only use getFromNameUsing once
+     lookedUpNames <- liftGhc $ mapM translatePName $ names
+     lookedUpImported <- liftGhc $ mapM (getFromNameUsing getTopLevelId . (^. pName)) $ importedNames
+     (insts,famInsts) <- lift $ getOrphanAndFamInstances mod
+     return $ mkImportInfo mod (catMaybes lookedUpImported) (catMaybes lookedUpNames) insts famInsts
+  where translatePName (PName n p) = do n' <- getFromNameUsing getTopLevelId n
+                                        p' <- maybe (return Nothing) (getFromNameUsing getTopLevelId) p
+                                        return (PName <$> n' <*> Just p')
+
+getOrphanAndFamInstances :: Module -> Ghc ([ClsInst], [FamInst])
+getOrphanAndFamInstances mod = do
+  env <- getSession
+  eps <- liftIO (readIORef (hsc_EPS env))
+  let ifc = lookupIfaceByModule (hsc_dflags env) (hsc_HPT env) (eps_PIT eps) mod
+      hp = lookupHptByModule (hsc_HPT env) mod
+      uses = catMaybes $ map getModule $ maybe [] (\ifc -> dep_orphs (mi_deps ifc) `union` dep_finsts (mi_deps ifc)) ifc
+      getModule mod = if moduleUnitId mod == mainUnitId
+                        then fmap Right $ lookupHptByModule (hsc_HPT env) mod
+                        else fmap Left $ lookupIfaceByModule (hsc_dflags env) (hsc_HPT env) (eps_PIT eps) mod
+      usedMods = lefts uses
+      usedDetails = map hm_details (maybeToList hp ++ rights uses)
+      hptInstances = filter (isOrphan . is_orphan) $ concatMap md_insts usedDetails
+      hptFamilyInstances = concatMap md_fam_insts usedDetails
+      allInstances = instEnvElts (eps_inst_env eps)
+      relevantInstances = hptInstances ++ filter ((\n -> nameModule n `elem` (mod : map mi_module usedMods)) . idName . instanceDFunId) (filter (isOrphan . is_orphan) allInstances)
+      allFamilyInstances = famInstEnvElts (eps_fam_inst_env eps)
+      relevantFamilyInstances = hptFamilyInstances ++ filter ((\n -> nameModule n `elem` (mod : map mi_module usedMods)) . co_ax_name . fi_axiom) allFamilyInstances
+  return (relevantInstances, relevantFamilyInstances)
+
+
+-- | Get names that are imported from a given import
+getImportedNames :: String -> Maybe String -> Trf (GHC.Module, [PName GHC.Name])
+getImportedNames name pkg = liftGhc $ do
+  hpt <- hsc_HPT <$> getSession
+  eps <- getSession >>= liftIO . readIORef . hsc_EPS
+  mod <- findModule (mkModuleName name) (fmap mkFastString pkg)
+  -- load exported names from interface file
+  let ifaceNames = maybe [] mi_exports $ flip lookupModuleEnv mod
+                                       $ eps_PIT eps
+  let homeExports = maybe [] (md_exports . hm_details) (lookupHptByModule hpt mod)
+  -- TODO: Why selectors are added in one case and not added in the other?
+  return (mod, concatMap (availToPName availNames) ifaceNames ++ concatMap (availToPName availNamesWithSelectors) homeExports)
+    where availToPName f a = map (\n -> if n == availName a then PName n Nothing else PName n (Just (availName a))) (f a)
+
+-- | Check is a given name is imported from an import with given import specification.
+checkImportVisible :: (HsHasName name, GhcMonad m) => Maybe (Bool, Located [LIE name]) -> GHC.Name -> m Bool
+checkImportVisible (Just (isHiding, specs)) name
+  | isHiding  = not . or @[] <$> mapM (`ieSpecMatches` name) (map unLoc (unLoc specs))
+  | otherwise = or @[] <$> mapM (`ieSpecMatches` name) (map unLoc (unLoc specs))
+checkImportVisible _ _ = return True
+
+ieSpecMatches :: (HsHasName name, GhcMonad m) => IE name -> GHC.Name -> m Bool
+ieSpecMatches (concatMap hsGetNames' . HsSyn.ieNames -> ls) name
+  | name `elem` ls = return True
+ieSpecMatches ie@(IEThingAll _) name | [n] <- hsGetNames' (HsSyn.ieName ie), isTyConName n
+  = do entity <- lookupName n
+       return $ case entity of Just (ATyCon tc)
+                                 | Just cls <- tyConClass_maybe tc
+                                     -> name `elem` map getName (classMethods cls)
+                                 | otherwise -> name `elem` concatMap (\dc -> getName dc : map flSelector (dataConFieldLabels dc))
+                                                                      (tyConDataCons tc)
+                               _             -> False
+ieSpecMatches _ _ = return False
+
+noSemaInfo :: src -> NodeInfo NoSemanticInfo src
+noSemaInfo = NodeInfo mkNoSemanticInfo
+
+-- | Creates a place for a missing node with a default location
+nothing :: String -> String -> Trf SrcLoc -> Trf (AnnMaybeG e (Dom n) RangeStage)
+nothing bef aft pos = annNothing . noSemaInfo . OptionalPos bef aft <$> pos
+
+emptyList :: String -> Trf SrcLoc -> Trf (AnnListG e (Dom n) RangeStage)
+emptyList sep ann = AnnListG <$> (noSemaInfo . ListPos "" "" sep Nothing <$> ann) <*> pure []
+
+-- | Creates a place for a list of nodes with a default place if the list is empty.
+makeList :: String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
+makeList sep ann ls = AnnListG <$> (noSemaInfo . ListPos "" "" sep Nothing <$> ann) <*> ls
+
+makeListBefore :: String -> String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
+makeListBefore bef sep ann ls = do isEmpty <- null <$> ls
+                                   AnnListG <$> (noSemaInfo . ListPos (if isEmpty then bef else "") "" sep Nothing <$> ann) <*> ls
+
+makeListAfter :: String -> String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
+makeListAfter aft sep ann ls = do isEmpty <- null <$> ls
+                                  AnnListG <$> (noSemaInfo . ListPos "" (if isEmpty then aft else "") sep Nothing <$> ann) <*> ls
+
+makeNonemptyList :: String -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
+makeNonemptyList sep ls = AnnListG (noSemaInfo $ ListPos "" "" sep Nothing noSrcLoc) <$> ls
+
+-- | Creates a place for an indented list of nodes with a default place if the list is empty.
+makeIndentedList :: Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
+makeIndentedList ann ls = do
+  elems <- ls
+  indent <- elementsWithoutSemi elems
+  AnnListG <$> (noSemaInfo . ListPos  "" "" "\n" (Just indent) <$> ann) <*> pure elems
+
+makeIndentedListNewlineBefore :: Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
+makeIndentedListNewlineBefore ann ls = do elems <- ls
+                                          indent <- elementsWithoutSemi elems
+                                          AnnListG <$> (noSemaInfo . ListPos (if null elems then "\n" else "") "" "\n" (Just indent) <$> ann) <*> pure elems
+
+makeIndentedListBefore :: String -> Trf SrcLoc -> Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
+makeIndentedListBefore bef sp ls = do elems <- ls
+                                      indent <- elementsWithoutSemi elems
+                                      AnnListG <$> (noSemaInfo . ListPos (if null elems then bef else "") "" "\n" (Just indent) <$> sp) <*> pure elems
+
+makeNonemptyIndentedList :: Trf [Ann e (Dom n) RangeStage] -> Trf (AnnListG e (Dom n) RangeStage)
+makeNonemptyIndentedList ls = do elems <- ls
+                                 indent <- elementsWithoutSemi elems
+                                 AnnListG (noSemaInfo $ ListPos "" "" "\n" (Just indent) noSrcLoc) <$> pure elems
+
+-- | Get the elements where there is no ; before
+elementsWithoutSemi :: [Ann e (Dom n) RangeStage] -> Trf [Bool]
+elementsWithoutSemi [] = return []
+elementsWithoutSemi (fst:rest) = indentedElements' (srcSpanEnd $ getRange fst) rest
+  where indentedElements' lastEnd (elem:rest)
+          = let sepRange = mkSrcSpan lastEnd (srcSpanStart $ getRange elem)
+             in (:) <$> (not . (\l -> isGoodSrcSpan l && srcSpanStart l < srcSpanEnd l) <$> focusOn sepRange (tokenLoc AnnSemi))
+                    <*> indentedElements' (srcSpanEnd $ getRange elem) rest
+        indentedElements' _ [] = return []
+
+-- | Transform a located part of the AST by automatically transforming the location.
+-- Sets the source range for transforming children.
+trfLoc :: (a -> Trf (b (Dom n) RangeStage)) -> Trf (SemanticInfo (Dom n) b) -> Located a -> Trf (Ann b (Dom n) RangeStage)
+trfLoc f sema = trfLocCorrect sema pure f
+
+trfLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => (a -> Trf (b (Dom n) RangeStage)) -> Located a -> Trf (Ann b (Dom n) RangeStage)
+trfLocNoSema f = trfLoc f (pure mkNoSemanticInfo)
+
+-- | Transforms a possibly-missing node with the default location of the end of the focus.
+trfMaybe :: String -> String -> (Located a -> Trf (Ann e (Dom n) RangeStage)) -> Maybe (Located a) -> Trf (AnnMaybeG e (Dom n) RangeStage)
+trfMaybe bef aft f = trfMaybeDefault bef aft f atTheEnd
+
+-- | Transforms a possibly-missing node with a default location
+trfMaybeDefault :: String -> String -> (Located a -> Trf (Ann e (Dom n) RangeStage)) -> Trf SrcLoc -> Maybe (Located a) -> Trf (AnnMaybeG e (Dom n) RangeStage)
+trfMaybeDefault _   _   f _   (Just e) = makeJust <$> f e
+trfMaybeDefault bef aft _ loc Nothing  = nothing bef aft loc
+
+-- | Transform a located part of the AST by automatically transforming the location
+-- with correction by applying the given function. Sets the source range for transforming children.
+trfLocCorrect :: Trf (SemanticInfo (Dom n) b) -> (SrcSpan -> Trf SrcSpan) -> (a -> Trf (b (Dom n) RangeStage)) -> Located a -> Trf (Ann b (Dom n) RangeStage)
+trfLocCorrect sema locF f (L l e) = annLoc sema (locF l) (f e)
+
+-- | Transform a located part of the AST by automatically transforming the location.
+-- Sets the source range for transforming children.
+trfMaybeLoc :: (a -> Trf (Maybe (b (Dom n) RangeStage))) -> SemanticInfo (Dom n) b -> Located a -> Trf (Maybe (Ann b (Dom n) RangeStage))
+trfMaybeLoc f sema (L l e) = do fmap (Ann (NodeInfo sema (NodeSpan l))) <$> local (\s -> s { contRange = l }) (f e)
+
+trfMaybeLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => (a -> Trf (Maybe (b (Dom n) RangeStage))) -> Located a -> Trf (Maybe (Ann b (Dom n) RangeStage))
+trfMaybeLocNoSema f = trfMaybeLoc f mkNoSemanticInfo
+
+-- | Creates a place for a list of nodes with the default place at the end of the focus if the list is empty.
+trfAnnList :: SemanticInfo (Dom n) b ~ NoSemanticInfo => String -> (a -> Trf (b (Dom n) RangeStage)) -> [Located a] -> Trf (AnnListG b (Dom n) RangeStage)
+trfAnnList sep _ [] = makeList sep atTheEnd (pure [])
+trfAnnList sep f ls = makeList sep (pure $ noSrcLoc) (mapM (trfLoc f (pure mkNoSemanticInfo)) ls)
+
+trfAnnList' :: String -> (Located a -> Trf (Ann b (Dom n) RangeStage)) -> [Located a] -> Trf (AnnListG b (Dom n) RangeStage)
+trfAnnList' sep _ [] = makeList sep atTheEnd (pure [])
+trfAnnList' sep f ls = makeList sep (pure $ noSrcLoc) (mapM f ls)
+
+
+-- | Creates a place for a list of nodes that cannot be empty.
+nonemptyAnnList :: [Ann e (Dom n) RangeStage] -> AnnListG e (Dom n) RangeStage
+nonemptyAnnList = AnnListG (noSemaInfo $ ListPos "" "" "" Nothing noSrcLoc)
+
+-- | Creates an optional node from an existing element
+makeJust :: Ann e (Dom n) RangeStage -> AnnMaybeG e (Dom n) RangeStage
+makeJust e = AnnMaybeG (noSemaInfo $ OptionalPos "" "" noSrcLoc) (Just e)
+
+-- | Annotates a node with the given location and focuses on the given source span.
+annLoc :: Trf (SemanticInfo (Dom n) b) -> Trf SrcSpan -> Trf (b (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
+annLoc semam locm nodem = do loc <- locm
+                             node <- focusOn loc nodem
+                             sema <- semam
+                             return (Ann (NodeInfo sema (NodeSpan loc)) node)
+
+annLocNoSema :: SemanticInfo (Dom n) b ~ NoSemanticInfo => Trf SrcSpan -> Trf (b (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
+annLocNoSema = annLoc (pure mkNoSemanticInfo)
+
+-- * Focus manipulation
+
+focusOn :: SrcSpan -> Trf a -> Trf a
+focusOn sp = local (\s -> s { contRange = sp })
+
+updateFocus :: (SrcSpan -> Trf SrcSpan) -> Trf a -> Trf a
+updateFocus f trf = do newSpan <- f =<< asks contRange
+                       focusOn newSpan trf
+
+-- | 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
+
+-- | Focuses the transformation to go between tokens if they are present
+betweenIfPresent :: AnnKeywordId -> AnnKeywordId -> Trf a -> Trf a
+betweenIfPresent firstTok lastTok = focusAfterIfPresent firstTok . focusBeforeIfPresent lastTok
+
+-- | Focuses the transformation to be performed after the given token. The token must be found inside the current range.
+focusAfter :: AnnKeywordId -> Trf a -> Trf a
+focusAfter firstTok trf
+  = do firstToken <- tokenLoc firstTok
+       if (isGoodSrcSpan firstToken)
+          then local (\s -> s { contRange = mkSrcSpan (srcSpanEnd firstToken) (srcSpanEnd (contRange s))}) trf
+          else do rng <- asks contRange
+                  error $ "focusAfter: token not found in " ++ show rng ++ ": " ++ show firstTok
+
+focusAfterIfPresent :: AnnKeywordId -> Trf a -> Trf a
+focusAfterIfPresent firstTok trf
+  = do firstToken <- tokenLoc firstTok
+       if (isGoodSrcSpan firstToken)
+          then local (\s -> s { contRange = mkSrcSpan (srcSpanEnd firstToken) (srcSpanEnd (contRange s))}) trf
+          else trf
+
+-- | Focuses the transformation to be performed before the given token. The token must be found inside the current range.
+focusBefore :: AnnKeywordId -> Trf a -> Trf a
+focusBefore lastTok trf
+  = do lastToken <- tokenLocBack lastTok
+       if (isGoodSrcSpan lastToken)
+          then local (\s -> s { contRange = mkSrcSpan (srcSpanStart (contRange s)) (srcSpanStart lastToken)}) trf
+          else do rng <- asks contRange
+                  error $ "focusBefore: token not found in " ++ show rng ++ ": " ++ show lastTok
+
+focusBeforeIfPresent :: AnnKeywordId -> Trf a -> Trf a
+focusBeforeIfPresent lastTok trf
+  = do lastToken <- tokenLocBack lastTok
+       if (isGoodSrcSpan lastToken)
+          then local (\s -> s { contRange = mkSrcSpan (srcSpanStart (contRange s)) (srcSpanStart lastToken)}) trf
+          else trf
+
+-- | Gets the position before the given token
+before :: AnnKeywordId -> Trf SrcLoc
+before tok = srcSpanStart <$> tokenLoc tok
+
+-- | Gets the position after the given token
+after :: AnnKeywordId -> Trf SrcLoc
+after tok = srcSpanEnd <$> tokenLoc tok
+
+-- | The element should span from the given token to the end of focus
+annFrom :: AnnKeywordId -> Trf (SemanticInfo (Dom n) e) -> Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
+annFrom kw sema = annLoc sema (combineSrcSpans <$> tokenLoc kw <*> asks (srcLocSpan . srcSpanEnd . contRange))
+
+annFromNoSema :: SemanticInfo (Dom n) e ~ NoSemanticInfo => AnnKeywordId -> Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
+annFromNoSema kw = annFrom kw (pure mkNoSemanticInfo)
+
+-- | Gets the position at the beginning of the focus
+atTheStart :: Trf SrcLoc
+atTheStart = asks (srcSpanStart . contRange)
+
+-- | Gets the position at the end of the focus
+atTheEnd :: Trf SrcLoc
+atTheEnd = asks (srcSpanEnd . contRange)
+
+-- | Searches for a token inside the focus and retrieves its location
+tokenLoc :: AnnKeywordId -> Trf SrcSpan
+tokenLoc keyw = fromMaybe noSrcSpan <$> (getKeywordInside keyw <$> asks contRange <*> asks srcMap)
+
+allTokenLoc :: AnnKeywordId -> Trf [SrcSpan]
+allTokenLoc keyw = getKeywordsInside keyw <$> asks contRange <*> asks srcMap
+
+-- | Searches for a token backward inside the focus and retrieves its location
+tokenLocBack :: AnnKeywordId -> Trf SrcSpan
+tokenLocBack keyw = fromMaybe noSrcSpan <$> (getKeywordInsideBack keyw <$> asks contRange <*> asks srcMap)
+
+tokenBefore :: SrcLoc -> AnnKeywordId -> Trf SrcSpan
+tokenBefore loc keyw
+  = fromMaybe noSrcSpan <$> (getKeywordInsideBack keyw <$> (mkSrcSpan <$> (asks (srcSpanStart . contRange)) <*> pure loc) <*> asks srcMap)
+
+allTokensAfter :: SrcLoc -> Trf [(SrcSpan, AnnKeywordId)]
+allTokensAfter loc = getTokensAfter loc <$> asks srcMap
+
+tokensAfter :: AnnKeywordId -> Trf [SrcSpan]
+tokensAfter keyw
+  = map fst . filter ((==keyw) . snd) <$> (asks (srcSpanEnd . contRange) >>= allTokensAfter)
+
+
+-- | Searches for tokens in the given order inside the parent element and returns their combined location
+tokensLoc :: [AnnKeywordId] -> Trf SrcSpan
+tokensLoc keys = asks contRange >>= tokensLoc' keys
+  where tokensLoc' :: [AnnKeywordId] -> SrcSpan -> Trf SrcSpan
+        tokensLoc' (keyw:rest) r
+          = do spanFirst <- tokenLoc keyw
+               spanRest <- tokensLoc' rest (mkSrcSpan (srcSpanEnd spanFirst) (srcSpanEnd r))
+               return (combineSrcSpans spanFirst spanRest)
+        tokensLoc' [] _ = pure noSrcSpan
+
+-- | Searches for a token and retrieves its location anywhere
+uniqueTokenAnywhere :: AnnKeywordId -> Trf SrcSpan
+uniqueTokenAnywhere keyw = fromMaybe noSrcSpan <$> (getKeywordAnywhere keyw <$> asks srcMap)
+
+-- | Annotates the given element with the current focus as a location.
+annCont :: Trf (SemanticInfo (Dom n) e) -> Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
+annCont sema = annLoc sema (asks contRange)
+
+annContNoSema :: SemanticInfo (Dom n) e ~ NoSemanticInfo => Trf (e (Dom n) RangeStage) -> Trf (Ann e (Dom n) RangeStage)
+annContNoSema = annCont (pure mkNoSemanticInfo)
+
+-- | Annotates the element with the same annotation that is on the other element
+copyAnnot :: SemanticInfo (Dom n) a ~ SemanticInfo (Dom n) b
+               => (Ann a (Dom n) RangeStage -> b (Dom n) RangeStage) -> Trf (Ann a (Dom n) RangeStage) -> Trf (Ann b (Dom n) RangeStage)
+copyAnnot f at = (\(Ann i a) -> Ann i (f (Ann i a))) <$> at
+
+-- | Combine source spans into one that contains them all
+foldLocs :: [SrcSpan] -> SrcSpan
+foldLocs = foldl combineSrcSpans noSrcSpan
+
+-- | The location after the given string
+advanceStr :: String -> SrcLoc -> SrcLoc
+advanceStr str (RealSrcLoc l) = RealSrcLoc $ foldl advanceSrcLoc l str
+advanceStr _ l = l
+
+-- | Update column information in a source location
+updateCol :: (Int -> Int) -> SrcLoc -> SrcLoc
+updateCol _ loc@(UnhelpfulLoc _) = loc
+updateCol f (RealSrcLoc loc) = mkSrcLoc (srcLocFile loc) (srcLocLine loc) (f $ srcLocCol loc)
+
+-- | Update the start of the src span
+updateStart :: (SrcLoc -> SrcLoc) -> SrcSpan -> SrcSpan
+updateStart f sp = mkSrcSpan (f (srcSpanStart sp)) (srcSpanEnd sp)
+
+-- | Update the end of the src span
+updateEnd :: (SrcLoc -> SrcLoc) -> SrcSpan -> SrcSpan
+updateEnd f sp = mkSrcSpan (srcSpanStart sp) (f (srcSpanEnd sp))
+
+-- | Combine source spans of elements into one that contains them all
+collectLocs :: [Located e] -> SrcSpan
+collectLocs = foldLocs . map getLoc
+
+-- | Rearrange definitions to appear in the order they are defined in the source file.
+orderDefs :: [Ann e (Dom n) RangeStage] -> [Ann e (Dom n) RangeStage]
+orderDefs = sortBy (compare `on` srcSpanStart . (^. AST.annotation & AST.sourceInfo & AST.nodeSpan))
+
+-- | Orders a list of elements to the order they are defined in the source file.
+orderAnnList :: AnnListG e (Dom n) RangeStage -> AnnListG e (Dom n) RangeStage
+orderAnnList (AnnListG a ls) = AnnListG a (orderDefs ls)
+
+-- | Only keeps one of the elements that are on the same source location
+removeDuplicates :: [Located e] -> [Located e]
+removeDuplicates (fst:rest) = fst : removeDuplicates (filter ((/= getLoc fst) . getLoc) rest)
+removeDuplicates [] = []
+
+-- | Transform a list of definitions where the defined names are in scope for subsequent definitions
+trfScopedSequence :: HsHasName d => (d -> Trf e) -> [d] -> Trf [e]
+trfScopedSequence f (def:rest) = (:) <$> f def <*> addToScope def (trfScopedSequence f rest)
+trfScopedSequence _ [] = pure []
+
+-- | Splits a given string at whitespaces while calculating the source location of the fragments
+splitLocated :: Located String -> [Located String]
+splitLocated (L (RealSrcSpan l) str) = splitLocated' str (realSrcSpanStart l) Nothing
+  where splitLocated' :: String -> RealSrcLoc -> Maybe (RealSrcLoc, String) -> [Located String]
+        splitLocated' (c:rest) currLoc (Just (startLoc, str)) | isSpace c
+          = L (RealSrcSpan $ mkRealSrcSpan startLoc currLoc) (reverse str) : splitLocated' rest (advanceSrcLoc currLoc c) Nothing
+        splitLocated' (c:rest) currLoc Nothing | isSpace c = splitLocated' rest (advanceSrcLoc currLoc c) Nothing
+        splitLocated' (c:rest) currLoc (Just (startLoc, str)) = splitLocated' rest (advanceSrcLoc currLoc c) (Just (startLoc, c:str))
+        splitLocated' (c:rest) currLoc Nothing = splitLocated' rest (advanceSrcLoc currLoc c) (Just (currLoc, [c]))
+        splitLocated' [] currLoc (Just (startLoc, str)) = [L (RealSrcSpan $ mkRealSrcSpan startLoc currLoc) (reverse str)]
+        splitLocated' [] _ Nothing = []
+splitLocated _ = error "splitLocated: unhelpful span given"
+
+compareSpans :: SrcSpan -> SrcSpan -> Ordering
+compareSpans (RealSrcSpan a) (RealSrcSpan b)
+  | a `containsSpan` b = GT
+  | b `containsSpan` a = LT
+compareSpans _ _ = EQ
+
+-- | Report errors when cannot convert a type of element
+unhandledElement :: (Data a, Outputable a) => String -> a -> Trf b
+unhandledElement label e = do rng <- asks contRange
+                              error ("Illegal " ++ label ++ ": " ++ showSDocUnsafe (ppr e) ++ " (ctor: " ++ show (toConstr e) ++ ") at: " ++ show rng)
+
+unhandledElementNoPpr :: (Data a) => String -> a -> Trf b
+unhandledElementNoPpr label e = do rng <- asks contRange
+                                   error ("Illegal " ++ label ++ ": (ctor: " ++ show (toConstr e) ++ ") at: " ++ show rng)
+
+
+instance Monoid SrcSpan where
+  span1@(RealSrcSpan _) `mappend` _ = span1
+  _ `mappend` span2 = span2
+  mempty = noSrcSpan

@@ -1,5 +1,5 @@ name:                haskell-tools-backend-ghc
-version:             0.8.1.0
+version:             0.9.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
@@ -13,23 +13,23 @@ 
 library
   ghc-options: -O2
-  exposed-modules:     Language.Haskell.Tools.AST.FromGHC
-                     , Language.Haskell.Tools.AST.FromGHC.Modules
-                     , Language.Haskell.Tools.AST.FromGHC.TH
-                     , Language.Haskell.Tools.AST.FromGHC.Decls
-                     , Language.Haskell.Tools.AST.FromGHC.Binds
-                     , Language.Haskell.Tools.AST.FromGHC.Exprs
-                     , Language.Haskell.Tools.AST.FromGHC.Stmts
-                     , Language.Haskell.Tools.AST.FromGHC.Patterns
-                     , Language.Haskell.Tools.AST.FromGHC.Types
-                     , Language.Haskell.Tools.AST.FromGHC.Kinds
-                     , Language.Haskell.Tools.AST.FromGHC.Literals
-                     , Language.Haskell.Tools.AST.FromGHC.Names
-                     , Language.Haskell.Tools.AST.FromGHC.GHCUtils
-  other-modules:       Language.Haskell.Tools.AST.FromGHC.Monad
-                     , Language.Haskell.Tools.AST.FromGHC.Utils
-                     , Language.Haskell.Tools.AST.FromGHC.SourceMap
-                     , Language.Haskell.Tools.AST.FromGHC.AddTypeInfo
+  exposed-modules:     Language.Haskell.Tools.BackendGHC
+                     , Language.Haskell.Tools.BackendGHC.Modules
+                     , Language.Haskell.Tools.BackendGHC.TH
+                     , Language.Haskell.Tools.BackendGHC.Decls
+                     , Language.Haskell.Tools.BackendGHC.Binds
+                     , Language.Haskell.Tools.BackendGHC.Exprs
+                     , Language.Haskell.Tools.BackendGHC.Stmts
+                     , Language.Haskell.Tools.BackendGHC.Patterns
+                     , Language.Haskell.Tools.BackendGHC.Types
+                     , Language.Haskell.Tools.BackendGHC.Kinds
+                     , Language.Haskell.Tools.BackendGHC.Literals
+                     , Language.Haskell.Tools.BackendGHC.Names
+                     , Language.Haskell.Tools.BackendGHC.GHCUtils
+  other-modules:       Language.Haskell.Tools.BackendGHC.Monad
+                     , Language.Haskell.Tools.BackendGHC.Utils
+                     , Language.Haskell.Tools.BackendGHC.SourceMap
+                     , Language.Haskell.Tools.BackendGHC.AddTypeInfo
 
   build-depends:       base              >= 4.9  && < 4.10
                      , transformers      >= 0.5  && < 0.6
@@ -41,7 +41,7 @@                      , mtl               >= 2.2  && < 2.3
                      , split             >= 0.2  && < 0.3
                      , template-haskell  >= 2.11 && < 2.12
-                     , ghc               >= 8.0  && < 8.3
-                     , haskell-tools-ast >= 0.8  && < 0.9
-                     , ghc-boot-th       >= 8.0  && < 8.3
+                     , ghc               >= 8.0  && < 8.1
+                     , haskell-tools-ast >= 0.9  && < 0.10
+                     , ghc-boot-th       >= 8.0  && < 8.1
   default-language:    Haskell2010