haskell-tools-backend-ghc 0.5.0.0 → 0.6.0.0

raw patch · 18 files changed

+751/−566 lines, 18 filesdep ~haskell-tools-astPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-tools-ast

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/AST/FromGHC/Binds.hs +62/−57
• Language/Haskell/Tools/AST/FromGHC/Binds.hs-boot +2/−1
• Language/Haskell/Tools/AST/FromGHC/Decls.hs +188/−133
• Language/Haskell/Tools/AST/FromGHC/Exprs.hs +88/−55
• Language/Haskell/Tools/AST/FromGHC/GHCUtils.hs +53/−23
• Language/Haskell/Tools/AST/FromGHC/Kinds.hs +14/−14
• Language/Haskell/Tools/AST/FromGHC/Modules.hs +70/−69
• Language/Haskell/Tools/AST/FromGHC/Monad.hs +10/−9
• Language/Haskell/Tools/AST/FromGHC/Names.hs +56/−41
• Language/Haskell/Tools/AST/FromGHC/Patterns.hs +9/−7
• Language/Haskell/Tools/AST/FromGHC/SourceMap.hs +5/−8
• Language/Haskell/Tools/AST/FromGHC/Stmts.hs +19/−16
• Language/Haskell/Tools/AST/FromGHC/TH.hs +28/−25
• Language/Haskell/Tools/AST/FromGHC/TH.hs-boot +1/−2
• Language/Haskell/Tools/AST/FromGHC/Types.hs +48/−42
• Language/Haskell/Tools/AST/FromGHC/Types.hs-boot +9/−0
• Language/Haskell/Tools/AST/FromGHC/Utils.hs +83/−59
• haskell-tools-backend-ghc.cabal +6/−5

@@ -12,14 +12,14 @@ import HsExpr as GHC
 import HsPat as GHC (LPat)
 import HsTypes as GHC (HsWildCardBndrs(..), HsImplicitBndrs(..))
-import Outputable as GHC (Outputable(..), showSDocUnsafe)
+import Name as GHC (isSymOcc)
 import SrcLoc as GHC
 
 import Control.Monad.Reader (Monad(..), mapM, asks)
-import Data.Data (Data(..))
 import Data.List
 
 import Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr)
+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)
@@ -31,21 +31,21 @@ 
 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) })]} }) 
+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) _ _ _) _ _ _) 
+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 
+trfBind' (PatBind pat (GRHSs rhs (unLoc -> locals)) _ _ _)
+  = AST.USimpleBind <$> trfPattern pat
                     <*> addEmptyScope (addToScope locals (trfRhss rhs))
                     <*> addEmptyScope (trfWhereLocalBinds (collectLocs rhs) locals)
 trfBind' (PatSynBind _) = error "Pattern synonym bindings should be recognized on the declaration level"
-trfBind' _ = error "Bindings generated by the compiler cannot be converted"
+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)
@@ -58,93 +58,95 @@                <*> 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 
+trfMatchLhs name fb pats
   = do implicitIdLoc <- mkSrcSpan <$> atTheStart <*> atTheStart
+       parenOpLoc <- tokensLoc [AnnOpenP, AnnVal, AnnCloseP]
+       nonFunOpLoc <- tokenLoc AnnVal
+       let infixLoc = parenOpLoc `mappend` nonFunOpLoc
        closeLoc <- srcSpanStart <$> (combineSrcSpans <$> tokenLoc AnnEqual <*> tokenLoc AnnVbar)
-       let (n, isInfix) = case fb of NonFunBindMatch -> (L implicitIdLoc name, False)
-                                     FunBindMatch n inf -> (n, inf)
        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 
+         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) 
+trfRhss [unLoc -> GRHS [] body] = annLocNoSema (combineSrcSpans (getLoc body) <$> tokenBefore (srcSpanStart $ getLoc body) AnnEqual)
                                          (AST.UUnguardedRhs <$> trfExpr body)
-trfRhss rhss = annLocNoSema (pure $ collectLocs rhss) 
+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) 
+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 binds
-trfRhsGuard' d = error $ "Illegal guard: " ++ showSDocUnsafe (ppr d) ++ " (ctor: " ++ show (toConstr d) ++ ")"
-  
+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 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 => HsLocalBinds n -> Trf (AnnListG AST.ULocalBind (Dom r) RangeStage)
-trfLocalBinds (HsValBinds (ValBindsIn binds sigs)) 
-  = makeIndentedListBefore " " (after AnnWhere)
-      (orderDefs <$> ((++) <$> mapM (copyAnnot AST.ULocalValBind . trfBind) (bagToList binds) 
+
+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 (HsValBinds (ValBindsOut binds sigs)) 
-  = makeIndentedListBefore " " (after AnnWhere)
+trfLocalBinds token (HsValBinds (ValBindsOut binds sigs))
+  = makeIndentedListBefore " " (after token)
       (orderDefs <$> ((++) <$> (concat <$> mapM (mapM (copyAnnot AST.ULocalValBind . trfBind) . bagToList . snd) binds)
                            <*> mapM trfLocalSig sigs))
-trfLocalBinds (HsIPBinds (IPBinds binds _))
-  = makeIndentedListBefore " " (after AnnWhere) (mapM trfIpBind binds)
-trfLocalBinds EmptyLocalBinds
-  -- TODO: implement
-  = error "trfLocalBinds: EmptyLocalBinds not supported yet"
+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 
+  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 -> error $ "Illegal local signature: " ++ showSDocUnsafe (ppr d) ++ " (ctor: " ++ show (toConstr d) ++ ")"
-  
+  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) 
+trfTypeSig' (TypeSig names typ)
   = defineTypeVars $ AST.UTypeSignature <$> makeNonemptyList ", " (mapM trfName names) <*> trfType (hswc_body $ hsib_body typ)
-trfTypeSig' ts = error $ "Illegal type signature: " ++ showSDocUnsafe (ppr ts) ++ " (ctor: " ++ show (toConstr ts) ++ ")"
+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
+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 
+                            <*> (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))
@@ -152,32 +154,35 @@   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 _) 
+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) 
+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 
+                       AST.UInlinePragma <$> trfConlike parts cl
+                                         <*> trfPhase (pure $ srcSpanStart (getLoc name)) phase
                                          <*> trfName name
 
 trfPhase :: Trf SrcLoc -> Activation -> Trf (AnnMaybeG AST.UPhaseControl (Dom r) RangeStage)
 trfPhase l AlwaysActive = nothing " " "" l
-trfPhase _ (ActiveAfter _ pn) = makeJust <$> annLocNoSema (combineSrcSpans <$> tokenLoc AnnOpenS <*> tokenLoc AnnCloseS) 
-                                                          (AST.UPhaseControl <$> nothing "" "" (before AnnCloseS) <*> trfPhaseNum pn)
+trfPhase _ (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)) <*> trfPhaseNum pn)
-trfPhase _ NeverActive = do range <- asks contRange 
-                            error $ "NeverActive pragmas should be checked earlier : " ++ show range
+                                                           (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 = makeJust <$> annLocNoSema (pure $ parts !! 2) (pure AST.UConlikeAnnot)
-trfConlike parts FunLike = nothing " " "" (pure $ srcSpanEnd $ parts !! 1)+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,5 +1,6 @@ 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)
@@ -8,7 +9,7 @@ import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..))
 import SrcLoc as GHC (Located, SrcSpan)
 
-trfLocalBinds :: TransformName n r => HsLocalBinds n -> Trf (AnnListG AST.ULocalBind (Dom r) RangeStage)
+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,4 +1,4 @@-{-# LANGUAGE LambdaCase 
+{-# LANGUAGE LambdaCase
            , ViewPatterns
            , ScopedTypeVariables
            #-}
@@ -13,7 +13,7 @@ import ForeignCall as GHC (Safety(..), CExportSpec(..), CCallConv(..))
 import qualified GHC
 import HsSyn as GHC
-import Name as GHC (Name, occNameString, nameOccName)
+import Name as GHC (Name, occNameString, nameOccName, isSymOcc)
 import Outputable as GHC (Outputable(..), showSDocUnsafe)
 import RdrName as GHC (RdrName, rdrNameOcc)
 import SrcLoc as GHC
@@ -21,7 +21,6 @@ 
 import Control.Monad.Reader
 import Control.Reference ((.-), (!~), biplateRef)
-import Data.Data (toConstr)
 import Data.Generics.Uniplate.Data ()
 import Data.List
 import Data.Maybe (Maybe(..), fromMaybe)
@@ -33,7 +32,7 @@ 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 {-# SOURCE #-} Language.Haskell.Tools.AST.FromGHC.TH (trfSplice)
 import Language.Haskell.Tools.AST.FromGHC.Types
 import Language.Haskell.Tools.AST.FromGHC.Utils
 
@@ -46,7 +45,7 @@ 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 _) 
+trfDeclsGroup (HsGroup vals splices tycls insts derivs fixities defaults foreigns warns anns rules vects _)
   = do spls <- getDeclSplices
        let (sigs, bagToList -> binds) = getBindsAndSigs vals
            alldecls :: [Located (HsDecl n)]
@@ -56,24 +55,37 @@                         ++ (map (fmap TyClD) (concat $ map group_tyclds tycls))
                         ++ (map (fmap InstD) insts)
                         ++ (map (fmap DerivD) derivs)
-                        ++ (map (fmap (SigD . FixSig)) (mergeFixityDefs fixities)) 
+                        ++ (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)
-       let actualDefinitions = replaceSpliceDecls spls alldecls
-       addToCurrentScope actualDefinitions $ makeIndentedListNewlineBefore atTheEnd (orderDefs <$> ((++) <$> getDeclsToInsert <*> (mapM trfDecl actualDefinitions)))
-  where 
+       let actualDefinitions = removeContained $ orderElems $ replaceSpliceDecls spls alldecls
+       addToCurrentScope actualDefinitions
+         $ makeIndentedListNewlineBefore atTheEnd
+            (orderDefs <$> ((++) <$> getDeclsToInsert <*> (mapM trfDecl actualDefinitions)))
+  where
     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) | RealSrcSpan fstLoc <- getLoc fst
+                                   , RealSrcSpan sndLoc <- getLoc snd
+                                   , fstLoc `containsSpan` sndLoc
+      = removeContained (fst:rest)
+    removeContained (fst:rest) = fst : removeContained rest
+    removeContained [] = []
+
     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
@@ -82,38 +94,38 @@        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)) 
+               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 _)) 
-    -> AST.UClosedTypeFamilyDecl <$> focusAfter AnnType (createDeclHead name tyVars) 
-                                <*> trfFamilyKind kindSig 
+  TyClD (FamDecl (FamilyDecl (ClosedTypeFamily typeEqs) name tyVars kindSig _))
+    -> AST.UClosedTypeFamilyDecl <$> focusAfter AnnType (createDeclHead name tyVars)
+                                <*> trfFamilyKind kindSig
                                 <*> trfTypeEqs typeEqs
   TyClD (FamDecl fd) -> AST.UTypeFamilyDecl <$> annContNoSema (trfTypeFam' fd)
-  TyClD (SynDecl name vars rhs _) 
+  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) _ _) 
+  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 
+  TyClD (ClassDecl ctx name vars funDeps sigs defs typeFuns typeFunDefs _ _)
+    -> AST.UClassDecl <$> trfCtx (after AnnClass) ctx
                      <*> betweenIfPresent AnnClass AnnWhere (createDeclHead name vars)
-                     <*> trfFunDeps funDeps 
+                     <*> trfFunDeps funDeps
                      <*> createClassBody sigs defs typeFuns typeFunDefs
   InstD (ClsInstD (ClsInstDecl typ binds sigs typefam datafam overlap))
-    -> AST.UInstDecl <$> trfMaybeDefault " " "" trfOverlap (after AnnInstance) 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) 
+                        <*> (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)
@@ -123,36 +135,40 @@   ValD bind -> trfVal bind
   SigD sig -> trfSig sig
   DerivD (DerivDecl t overlap) -> AST.UDerivDecl <$> trfMaybeDefault " " "" trfOverlap (after AnnInstance) overlap <*> trfInstanceRule (hsib_body t)
-  -- TODO: Warnings, rewrite rules
   RuleD (HsRules _ rules) -> AST.UPragmaDecl <$> annContNoSema (AST.URulePragma <$> makeIndentedList (before AnnClose) (mapM trfRewriteRule rules))
-  RoleAnnotD (RoleAnnotDecl name roles) -> AST.URoleDecl <$> trfQualifiedName name <*> makeList " " atTheEnd (mapM trfRole roles)
-  DefD (DefaultDecl types) -> AST.UDefaultDecl . nonemptyAnnList <$> mapM trfType types
-  ForD (ForeignImport name (hsib_body -> typ) _ (CImport ccall safe _ _ _)) 
+  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)) _)) 
+  ForD (ForeignExport name (hsib_body -> typ) _ (CExport (L l (CExportStatic _ _ ccall)) _))
     -> AST.UForeignExport <$> annLocNoSema (pure l) (trfCallConv' ccall) <*> trfName name <*> trfType typ
-  SpliceD (SpliceDecl (unLoc -> spl) _) -> AST.USpliceDecl <$> (annContNoSema $ trfSplice' spl)
-  WarningD (Warnings src [L _ (Warning names (DeprecatedTxt _ [L l (StringLiteral _ fs)]))]) 
-    -> AST.UPragmaDecl <$> annContNoSema (AST.UDeprPragma <$> (makeNonemptyList " " $ mapM trfName names) <*> trfFastString (L l fs))
-  WarningD (Warnings src [L _ (Warning names (WarningTxt _ [L l (StringLiteral _ fs)]))]) 
-    -> AST.UPragmaDecl <$> annContNoSema (AST.UWarningPragma <$> (makeNonemptyList " " $ mapM trfName names) <*> trfFastString (L l fs))
-  AnnD (HsAnnotation stxt subject expr) 
+  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 -> error ("Illegal declaration: " ++ showSDocUnsafe (ppr d) ++ " (ctor: " ++ show (toConstr d) ++ ")")
+  d -> unhandledElement "declaration" d
 
-trfGADT :: TransformName n r => NewOrData -> Located n -> LHsQTyVars n -> Located (HsContext n) 
-                                 -> Maybe (Located (HsKind n)) -> [Located (ConDecl n)] 
+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)
-                   <*> trfKindSig kind
+                   <*> 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]) 
+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
@@ -168,38 +184,61 @@ 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) 
+trfSig (PatSynSig id typ)
   = AST.UPatTypeSigDecl <$> annContNoSema (AST.UPatternTypeSignature <$> trfName id <*> trfType (hsib_body typ))
-trfSig (InlineSig name prag)  
+trfSig (InlineSig name prag)
   = AST.UPragmaDecl <$> annContNoSema (AST.UInlinePragmaDecl <$> trfInlinePragma name prag)
-trfSig (SpecSig name (map hsib_body -> types) (inl_act -> phase)) 
-  = AST.UPragmaDecl <$> annContNoSema (AST.USpecializePragma <$> trfPhase (pure $ srcSpanStart (getLoc name)) phase 
-                                       <*> trfName name 
-                                       <*> (orderAnnList <$> trfAnnList ", " trfType' types))
-trfSig s = error ("Illegal signature: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
+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_details = PrefixCon args })
-  = AST.UConDecl <$> define (trfName name) <*> makeList " " atTheEnd (mapM trfType args)
-trfConDecl' (ConDeclH98 { con_name = name, con_details = RecCon (unLoc -> flds) })
-  = AST.URecordDecl <$> define (trfName name) <*> (between AnnOpenC AnnCloseC $ trfAnnList ", " trfFieldDecl' flds)
-trfConDecl' (ConDeclH98 { con_name = name, con_details = InfixCon t1 t2 })
-  = AST.UInfixConDecl <$> trfType t1 <*> define (trfOperator name) <*> trfType t2
+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' (ConDeclGADT {}) = error "trfConDecl': GADT con received"
 
+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 $ \(ConDeclGADT { con_names = names, con_type = hsib_body -> typ })
-  -> AST.UGadtConDecl <$> define (trfAnnList ", " trfName' names) 
-                     <*> trfGadtConType 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
+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)
@@ -212,34 +251,46 @@ 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)) 
+  = AST.UInstanceRule <$> (makeJust <$> annLocNoSema (pure $ collectLocs bndrs) (trfBindings bndrs))
                       <*> trfCtx (after AnnDot) ctx
                       <*> trfInstanceHead typ
-trfInstanceRule' (HsQualTy ctx typ) = AST.UInstanceRule <$> nothing "" " . " atTheStart 
+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' t = error (showSDocUnsafe $ ppr t)
+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 = annContNoSema
-  $ AST.UInstanceRule <$> nothing "" " . " atTheStart
-                      <*> nothing " " "" atTheStart
-                      <*> foldl (\c t -> annLocNoSema (pure $ combineSrcSpans (getLoc n) (getLoc t)) $ AST.UInstanceHeadApp <$> c <*> (trfType t))
-                                (copyAnnot AST.UInstanceHeadCon (trfName n))
-                                (hsib_body vars)
+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'
 
@@ -249,18 +300,20 @@   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) 
+  trfInstanceHead'' (HsOpTy t1 op t2)
     = AST.UInstanceHeadApp <$> (annLocNoSema (pure $ combineSrcSpans (getLoc t1) (getLoc op))
-                                             (AST.UInstanceHeadInfix <$> trfType t1 <*> trfName op)) 
+                                             (AST.UInstanceHeadInfix <$> trfType t1 <*> trfOperator op))
                           <*> trfType t2
-  trfInstanceHead'' t = error ("Illegal instance head: " ++ showSDocUnsafe (ppr t) ++ " (ctor: " ++ show (toConstr t) ++ ")")
- 
+  trfInstanceHead'' t = unhandledElement "instance head" t
+
 trfTypeEqs :: TransformName n r => Maybe [Located (TyFamInstEqn n)] -> Trf (AnnListG AST.UTypeEqn (Dom r) RangeStage)
-trfTypeEqs Nothing = makeList "\n" (after AnnWhere) (pure [])
-trfTypeEqs (Just eqs) = makeNonemptyList "\n" (mapM trfTypeEq eqs)
+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) 
+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)
@@ -268,17 +321,17 @@         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 
+        wrapTypes base pats
           = foldl (\t p -> do typ <- t
-                              annLocNoSema (pure $ combineSrcSpans (getRange typ) (getLoc p)) 
+                              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) 
+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
 
@@ -287,32 +340,32 @@   | srcSpanStart (getLoc name) > srcSpanEnd (getLoc lhs)
   -- infix declaration
   = wrapDeclHead rest
-      $ annLocNoSema (addParenLocs $ getLoc lhs `combineSrcSpans` getLoc rhs) 
+      $ 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)) 
+  = 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 
+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] 
+
+
+createClassBody :: TransformName n r => [LSig n] -> LHsBinds n -> [LFamilyDecl n]
                                -> [LTyFamDefltEqn n] -> Trf (AnnMaybeG AST.UClassBody (Dom r) RangeStage)
-createClassBody sigs binds typeFams typeFamDefs 
+createClassBody sigs binds typeFams typeFamDefs
   = do isThereWhere <- isGoodSrcSpan <$> (tokenLoc AnnWhere)
-       if isThereWhere 
-         then makeJust <$> annLocNoSema (combinedLoc <$> tokenLoc AnnWhere) 
-                                        (AST.UClassBody <$> makeList "" (after 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
@@ -322,41 +375,42 @@         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)) 
+  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)) 
+  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
-  s -> error ("Illegal signature in class: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
-         
+  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) 
+  = 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) 
+  = 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) 
+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)))
+      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
@@ -365,34 +419,35 @@         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) 
+  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)) 
+  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 -> error ("Illegal class instance signature: " ++ showSDocUnsafe (ppr s) ++ " (ctor: " ++ show (toConstr s) ++ ")")
-          
+  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 _ _ cons derivs) _) 
-    -> AST.UInstBodyDataDecl 
-         <$> trfDataKeyword dn 
+trfInstDataFam = trfLocNoSema $ \case
+  (DataFamInstDecl tc (hsib_body -> pats) (HsDataDefn dn ctx _ _ cons derivs) _)
+    -> AST.UInstBodyDataDecl
+         <$> trfDataKeyword dn
          <*> annLocNoSema (pure $ collectLocs pats `combineSrcSpans` getLoc tc `combineSrcSpans` getLoc ctx)
                           (AST.UInstanceRule <$> nothing "" " . " atTheStart
-                                             <*> trfCtx atTheStart ctx 
-                                             <*> foldr (\t r -> annLocNoSema (combineSrcSpans (getLoc t) . getRange <$> r) 
-                                                                             (AST.UInstanceHeadApp <$> r <*> (trfType t))) 
+                                             <*> trfCtx atTheStart ctx
+                                             <*> foldl (\r t -> annLocNoSema (combineSrcSpans (getLoc t) . getRange <$> r)
+                                                                             (AST.UInstanceHeadApp <$> r <*> (trfType t)))
                                                        (copyAnnot AST.UInstanceHeadCon (trfName tc)) pats)
          <*> trfAnnList "" trfConDecl' cons
          <*> trfMaybe " deriving " "" trfDerivings derivs
-          
+
 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
@@ -411,14 +466,14 @@         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) 
+          = 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)))
 
@@ -429,28 +484,28 @@   TyVarSig {} -> error "trfFamilyKind: TyVarSig not supported yet"
 
 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 
+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 yet"
-trfFamilyResultSig _ (Just (L l (InjectivityAnn n deps))) 
+trfFamilyResultSig _ (Just (L l (InjectivityAnn n deps)))
   = makeJust <$> (annLocNoSema (pure l) $ AST.UTypeFamilyInjectivity <$> (annContNoSema $ AST.UInjectivityAnn <$> trfName n <*> trfAnnList ", " trfName' deps))
 
 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)) 
+                       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
@@ -459,7 +514,7 @@ 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 
+trfSafety ccLoc lsaf@(L l _) | isGoodSrcSpan l
   = makeJust <$> trfLocNoSema (pure . \case
       PlaySafe -> AST.USafe
       PlayInterruptible -> AST.UInterruptible
@@ -482,15 +537,15 @@ 
 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) 
+  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.UTyVar (Dom r) RangeStage)
-trfRuleBndr = trfLocNoSema $ \case (RuleBndr n) -> AST.UTyVarDecl <$> trfName n <*> nothing " " "" atTheEnd
-                                   (RuleBndrSig n k) -> AST.UTyVarDecl <$> trfName n <*> (makeJust <$> (trfKindSig' (hswc_body $ hsib_body k)))
+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'
@@ -499,4 +554,4 @@ 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+trfMinimalFormula' (Parens formula) = AST.UMinimalParen <$> trfMinimalFormula formula

@@ -8,14 +8,13 @@ module Language.Haskell.Tools.AST.FromGHC.Exprs where
 
 import Control.Monad.Reader
-import Data.Data (toConstr)
 import Data.List (partition, find)
-import Data.Maybe (Maybe(..), isJust, fromMaybe)
+import Data.Maybe (Maybe(..), isJust, fromMaybe, catMaybes)
 
-import BasicTypes as GHC (Boxity(..))
+import BasicTypes as GHC (Boxity(..), StringLiteral(..))
+import FastString (unpackFS)
 import GHC
 import OccName as GHC (occNameString)
-import Outputable as GHC (Outputable(..), showSDocUnsafe)
 import PrelNames as GHC (negateName)
 import SrcLoc as GHC
 
@@ -24,9 +23,9 @@ 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, trfPattern')
+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 {-# 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)
@@ -36,20 +35,21 @@ 
 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 -> []))) 
+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 
+       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 = do exprSpls <- asks exprSplices
-               let RealSrcSpan loce = getLoc e
-                   contSplice = find (\sp -> case getSpliceLoc sp of (RealSrcSpan spLoc) -> spLoc `containsSpan` loce; _ -> False) exprSpls
-               case contSplice of Just sp -> case sp of HsQuasiQuote {} -> exprSpliceInserted sp (annCont createScopeInfo (AST.UQuasiQuoteExpr <$> annLocNoSema (pure $ getSpliceLoc sp) (trfQuasiQuotation' sp)))
-                                                        _               -> exprSpliceInserted sp (annCont createScopeInfo (AST.USplice <$> annLocNoSema (pure $ getSpliceLoc sp) (trfSplice' sp)))
-                                  Nothing -> trfLoc trfExpr' createScopeInfo e
+trfExpr e | RealSrcSpan loce <- getLoc e
+  = do exprSpls <- asks exprSplices
+       let contSplice = find (\sp -> case getSpliceLoc sp of (RealSrcSpan spLoc) -> spLoc `containsSpan` loce; _ -> False) exprSpls
+       case contSplice of Just sp -> case sp of HsQuasiQuote {} -> exprSpliceInserted sp (annLoc createScopeInfo (pure $ getSpliceLoc sp) (AST.UQuasiQuoteExpr <$> annLocNoSema (pure $ getSpliceLoc sp) (trfQuasiQuotation' sp)))
+                                                _               -> exprSpliceInserted sp (annLoc createScopeInfo (pure $ getSpliceLoc sp) (AST.USplice <$> trfSplice sp))
+                          Nothing -> trfLoc trfExpr' createScopeInfo e
+  | otherwise = trfLoc trfExpr' createScopeInfo e
 
 createScopeInfo :: Trf ScopeInfo
 createScopeInfo = do scope <- asks localsInScope
@@ -63,21 +63,27 @@ 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 <$> (trfAnnList " " trfPattern' pats) <*> addToScope pats (trfExpr expr)
+  = 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) 
+trfExpr' (OpApp e1 (unLoc -> HsVar op) _ e2)
   = AST.UInfixApp <$> trfExpr e1 <*> trfOperator op <*> trfExpr e2
-trfExpr' (NegApp e _) = AST.UPrefixApp <$> annLocNoSema loc (AST.UNormalOp <$> annLoc info loc (AST.nameFromList <$> trfNameStr "-"))
+trfExpr' (OpApp e1 (L nameLoc (HsRecFld fld)) _ e2)
+  = AST.UInfixApp <$> trfExpr e1 <*> trfAmbiguousOperator' nameLoc fld <*> trfExpr e2
+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) 
+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)
@@ -86,34 +92,39 @@                    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) 
+        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] commaLocs
+                      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) 
+        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 binds <*> trfExpr expr)
-trfExpr' (HsDo DoExpr (unLoc -> stmts) _) = AST.UDo <$> annLocNoSema (tokenLoc AnnDo) (pure AST.UDoKeyword) 
+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]) _) 
+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))
--- TODO: scoping
 trfExpr' (HsDo ListComp (unLoc -> stmts) _)
   = AST.UListComp <$> trfExpr (getLastStmt stmts) <*> trfListCompStmts stmts
 trfExpr' (HsDo MonadComp (unLoc -> stmts) _)
@@ -127,42 +138,50 @@ 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)) 
+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)) 
+trfExpr' (ArithSeq _ _ (FromThenTo from step to))
   = AST.UEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> (makeJust <$> trfExpr to)
-trfExpr' (PArrSeq _ (FromTo from to)) 
+trfExpr' (PArrSeq _ (FromTo from to))
   = AST.UParArrayEnum <$> trfExpr from <*> nothing "," "" (before AnnDotdot) <*> trfExpr to
-trfExpr' (PArrSeq _ (FromThenTo from step to)) 
+trfExpr' (PArrSeq _ (FromThenTo from step to))
   = AST.UParArrayEnum <$> trfExpr from <*> (makeJust <$> trfExpr step) <*> trfExpr to
--- TODO: SCC, CORE, GENERATED annotations
 trfExpr' (HsBracket brack) = AST.UBracketExpr <$> annContNoSema (trfBracket' brack)
 trfExpr' (HsSpliceE qq@(HsQuasiQuote {})) = AST.UQuasiQuoteExpr <$> annContNoSema (trfQuasiQuotation' qq)
-trfExpr' (HsSpliceE splice) = AST.USplice <$> annContNoSema (trfSplice' splice)
+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' t = error ("Illegal expression: " ++ showSDocUnsafe (ppr t) ++ " (ctor: " ++ show (toConstr t) ++ ")")
-  
+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))) 
+                  <*> (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
@@ -177,19 +196,19 @@ 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)) 
+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) 
+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 = trfLocNoSema trfGuardedCaseRhs'
 
 trfGuardedCaseRhs' :: TransformName n r => GRHS n (LHsExpr n) -> Trf (AST.UGuardedCaseRhs (Dom r) RangeStage)
 trfGuardedCaseRhs' = gTrfGuardedCaseRhs' trfExpr
@@ -204,22 +223,36 @@ 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 
+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 
+                                                                       -- 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 <$> trfAnnList " " trfPattern' pats <*> trfCmd body
+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' (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 binds <*> trfCmd cmd)
+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"+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))

@@ -22,7 +22,7 @@ import SrcLoc
 import Type (TyThing(..), mkFunTys)
 
-class OutputableBndr name => GHCName name where 
+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)
@@ -42,8 +42,8 @@   gunpackPostRn a _ _ = a
 
 occName :: GHCName n => n -> OccName
-occName = rdrNameOcc . rdrName 
-    
+occName = rdrNameOcc . rdrName
+
 instance GHCName GHC.Name where
   rdrName = nameRdrName
   getFromNameUsing f n = fmap nameFromId <$> f n
@@ -64,7 +64,7 @@ 
 -- | Loading ids for top-level ghc names
 getTopLevelId :: GHC.Name -> Ghc (Maybe GHC.Id)
-getTopLevelId name = 
+getTopLevelId name =
     lookupName name >>= \case
       Just (AnId id) -> return (Just id)
       Just (AConLike (RealDataCon dc)) -> return $ Just $ mkVanillaGlobal name (dataConUserType dc)
@@ -78,13 +78,13 @@   hsGetNames :: a -> [GHC.Name]
 
 instance HsHasName RdrName where
-  hsGetNames _ = [] 
+  hsGetNames _ = []
 
 instance HsHasName Name where
-  hsGetNames n = [n] 
+  hsGetNames n = [n]
 
 instance HsHasName Id where
-  hsGetNames n = [getName n] 
+  hsGetNames n = [getName n]
 
 instance HsHasName e => HsHasName [e] where
   hsGetNames es = concatMap hsGetNames es
@@ -100,8 +100,17 @@   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
 
@@ -115,7 +124,7 @@   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 (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
@@ -127,7 +136,7 @@ instance (GHCName n, HsHasName n) => HsHasName (ConDeclField n) where
   hsGetNames (ConDeclField name _ _) = hsGetNames name
 
-instance (GHCName n, HsHasName n) => HsHasName (FieldOcc n) where 
+instance (GHCName n, HsHasName n) => HsHasName (FieldOcc n) where
   hsGetNames (FieldOcc _ pr) = gunpackPostRn [] (hsGetNames :: n -> [Name]) pr
 
 instance (HsHasName n) => HsHasName (Sig n) where
@@ -187,30 +196,51 @@   hsGetNames _ = []
 
 instance (GHCName n, HsHasName n) => HsHasName (HsGroup n) where
-  hsGetNames (HsGroup vals _ clds _ _ _ _ foreigns _ _ _ _ _) = hsGetNames vals ++ hsGetNames clds ++ hsGetNames foreigns
+  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 :: OutputableBndr n => HsType n -> HsType n
+cleanHsType :: forall n . (OutputableBndr n) => HsType n -> HsType n
 -- for some reason * is considered infix
-cleanHsType (HsAppsTy [unLoc -> HsAppInfix t]) = HsTyVar t
-cleanHsType (HsAppsTy apps) = unLoc $ guessType (splitHsAppsTy apps)
-  where guessType :: OutputableBndr n => ([[LHsType n]], [Located n]) -> LHsType n
-        guessType (term@(hd:_):terms, operator:operators)  
-          = let rhs = guessType (terms,operators)
-             in L (getLoc hd `combineSrcSpans` getLoc rhs) $ HsOpTy (doApps term) operator rhs
-        guessType ([term],[]) = doApps term
-        guessType x = error ("guessType: " ++ showSDocUnsafe (ppr x))
-        doApps term = foldl1 (\core t -> L (getLoc core `combineSrcSpans` getLoc t) $ HsAppTy core t) term
+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 
+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 [] = []+mergeFixityDefs [] = []

@@ -1,5 +1,5 @@ {-# LANGUAGE ViewPatterns
-           , TypeFamilies 
+           , 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
@@ -9,18 +9,16 @@ import HsTypes as GHC
 import Name as GHC (occNameString, nameOccName, isWiredInName)
 import OccName as GHC (occNameString)
-import Outputable as GHC (Outputable(..), showSDocUnsafe)
 import RdrName as GHC (RdrName(..))
 import SrcLoc as GHC
 
-import Control.Monad.Reader (Monad(..), asks)
-import Data.Data (toConstr)
-
+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(..), trfName)
+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
 
 
@@ -28,7 +26,7 @@ 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)) 
+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)
@@ -36,7 +34,7 @@ 
 trfKind' ::TransformName n r => HsKind n -> Trf (AST.UKind (Dom r) RangeStage)
 trfKind' = trfKind'' . cleanHsType where
-  trfKind'' (HsTyVar (rdrName . unLoc -> Exact n)) 
+  trfKind'' (HsTyVar (rdrName . unLoc -> Exact n))
     | isWiredInName n && occNameString (nameOccName n) == "*"
     = pure AST.UStarKind
     | isWiredInName n && occNameString (nameOccName n) == "#"
@@ -44,20 +42,22 @@   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'' k = error ("Illegal kind: " ++ showSDocUnsafe (ppr k) ++ " (ctor: " ++ show (toConstr k) ++ ")")
+  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) 
+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 = asks contRange >>= \r -> error $ "Unknown promoted type/kind: " ++ (showSDocUnsafe (ppr t) ++ " at: " ++ show r)+trfPromoted' _ t = unhandledElement "promoted type/kind" t

@@ -4,6 +4,7 @@            , 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.
@@ -11,6 +12,7 @@ 
 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)
@@ -20,12 +22,14 @@ 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
+import RdrName as GHC (RdrName, Parent(..), GlobalRdrElt(..))
 import RnEnv as GHC (mkUnboundNameRdr)
 import RnExpr as GHC (rnLExpr)
 import SrcLoc as GHC
@@ -35,80 +39,79 @@                                   , 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 (HsHasName(..))
 import Language.Haskell.Tools.AST.FromGHC.Monad
-import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..), trfName)
+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 = trfLocCorrect (createModuleInfo mod) (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) $ 
-                  \(HsModule name exports imports decls deprec _) -> 
+trfModule mod = trfLocCorrect (createModuleInfo mod) (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) $
+                  \(HsModule name exports imports decls deprec _) ->
                     AST.UModule <$> trfFilePragmas
                                 <*> trfModuleHead name exports deprec
                                 <*> trfImports imports
                                 <*> trfDecls decls
-       
-trfModuleRename :: ModSummary -> Ann AST.UModule (Dom RdrName) RangeStage 
-                              -> (HsGroup Name, [LImportDecl Name], Maybe [LIE Name], Maybe LHsDocString) 
-                              -> Located (HsModule RdrName) 
+
+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 
+trfModuleRename mod rangeMod (gr,imports,exps,_) hsMod
     = do info <- createModuleInfo mod
-         trfLocCorrect (pure info) (\sr -> combineSrcSpans sr <$> (uniqueTokenAnywhere AnnEofPos)) (trfModuleRename' (info ^. implicitNames)) hsMod      
+         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) 
+        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)
-           
+
           addToScope (concat @[] (transformedImports ^? AST.annList&semantics&importedNames) ++ preludeImports)
-            $ loadSplices hsMod gr $ setOriginalNames originalNames . setDeclsToInsert roleAnnots
+            $ loadSplices mod hsMod transformedImports preludeImports gr $ setOriginalNames originalNames . setDeclsToInsert roleAnnots
               $ AST.UModule <$> trfFilePragmas
                             <*> trfModuleHead name (case (exports, exps) of (Just (L l _), Just ie) -> Just (L l ie)
                                                                             _                       -> Nothing) deprec
                             <*> return transformedImports
                             <*> trfDeclsGroup gr
 
-loadSplices :: HsModule RdrName -> HsGroup Name -> Trf a -> Trf a
-loadSplices hsMod group trf = do 
+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 HsSpliceE sp -> Just sp; _ -> Nothing) $ hsMod ^? biplateRef :: [HsSplice RdrName]
         typeSpls = catMaybes $ map (\case HsSpliceTy sp _ -> Just sp; _ -> Nothing) $ hsMod ^? biplateRef :: [HsSplice RdrName]
     -- initialize reader environment
-    env <- liftGhc getSession
-
-    locals <- asks ((hsGetNames group ++) . concat . localsInScope)
-    let createGRE n | Just modName <- nameModule_maybe n
-                    = [GRE n NoParent False [ImpSpec (ImpDeclSpec (moduleName modName) (moduleName modName) False noSrcSpan) ImpAll]]
-                    | otherwise = []
-        readEnv = mkOccEnv (map (\n -> (GHC.occName n, createGRE n)) locals)
-
+    env <- liftGhc $ setSessionDynFlags (ms_hspp_opts modSum) >> getSession
+    importEnv <- liftIO $ hscRnImportDecls env (hsmodImports hsMod)
+    let locals = hsGetNames group
+        createLocalGRE n = [GRE n NoParent True []]
+        readEnv = mkOccEnv $ map (foldl1 (\e1 e2 -> (fst e1, snd e1 ++ snd e2)) . map snd) $ groupBy ((==) `on` fst) $ sortOn fst
+                   $ (map (\n -> (n, (GHC.occName n, createLocalGRE n))) (locals ++ preludeImports))
     tcdSplices <- liftIO $ runTcInteractive env { hsc_dflags = xopt_set (hsc_dflags env) TemplateHaskellQuotes }
-      $ updGblEnv (\gbl -> gbl { tcg_rdr_env = readEnv }) 
+      $ updGblEnv (\gbl -> gbl { tcg_rdr_env = plusOccEnv readEnv importEnv })
       $ (,,) <$> mapM tcHsSplice declSpls <*> mapM tcHsSplice' typeSpls <*> mapM tcHsSplice' exprSpls
-    let (declSplices, typeSplices, exprSplices) 
-          = fromMaybe (error $ "Splice expression could not be typechecked: " 
-                                 ++ showSDocUnsafe (vcat (pprErrMsgBagWithLoc (fst (fst tcdSplices))) 
-                                                      <+> vcat (pprErrMsgBagWithLoc (snd (fst tcdSplices))))) 
+    let (declSplices, typeSplices, exprSplices)
+          = fromMaybe (error $ "Splice expression could not be typechecked: "
+                                 ++ showSDocUnsafe (vcat (pprErrMsgBagWithLoc (fst (fst tcdSplices)))
+                                                      <+> vcat (pprErrMsgBagWithLoc (snd (fst tcdSplices)))))
                       (snd tcdSplices)
     setSplices declSplices typeSplices exprSplices trf
   where
     tcHsSplice :: Located (HsSplice RdrName) -> RnM (Located (HsSplice Name))
     tcHsSplice (L l s) = L l <$> tcHsSplice' s
-    tcHsSplice' (HsTypedSplice id e) 
+    tcHsSplice' (HsTypedSplice id e)
       = HsTypedSplice (mkUnboundNameRdr id) <$> (fst <$> rnLExpr e)
-    tcHsSplice' (HsUntypedSplice id e) 
+    tcHsSplice' (HsUntypedSplice id e)
       = HsUntypedSplice (mkUnboundNameRdr id) <$> (fst <$> rnLExpr e)
-    tcHsSplice' (HsQuasiQuote id1 id2 sp fs) 
+    tcHsSplice' (HsQuasiQuote id1 id2 sp fs)
       = pure $ HsQuasiQuote (mkUnboundNameRdr id1) (mkUnboundNameRdr id2) sp fs
 
-trfModuleHead :: TransformName n r => Maybe (Located ModuleName) -> Maybe (Located [LIE n]) -> Maybe (Located WarningTxt) -> Trf (AnnMaybeG AST.UModuleHead (Dom r) RangeStage) 
+trfModuleHead :: TransformName n r => Maybe (Located ModuleName) -> 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 
+                               (AST.UModuleHead <$> trfModuleName mn
                                                 <*> trfModulePragma (srcSpanEnd $ getLoc mn) modPrag
                                                 <*> trfExportList (before AnnWhere) exports))
 trfModuleHead _ Nothing _ = nothing "" "" moduleHeadPos
@@ -123,41 +126,40 @@                     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) 
+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 = init $ drop 2 pragmaElems
+        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) 
+                                                                 DeprecatedTxt _ txts -> AST.UModuleDeprecatedPragma <$> trfAnnList " " trfText' txts)
                                     (pure l)
 
-trfText' :: StringLiteral -> Trf (AST.UStringNode (Dom r) RangeStage)
-trfText' = pure . AST.UStringNode . unpackFS . sl_fs
-
-
-
 trfExportList :: TransformName n r => 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 
+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) 
+trfImports (filter (not . ideclImplicit . unLoc) -> imps)
   = AnnListG <$> importDefaultLoc <*> mapM trfImport imps
-  where importDefaultLoc = noSemaInfo . AST.ListPos (if List.null imps then "\n" else "") "" "\n" True . srcSpanEnd 
-                             <$> (combineSrcSpans <$> asks (srcLocSpan . srcSpanStart . contRange) 
+  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 isSafe isQual _ declAs declHiding)) =
@@ -168,43 +170,43 @@          annBeforeSafe = if isQual then AnnQualified else annBeforeQual
          annBeforePkg = if isGoodSrcSpan safeTok then AnnSafe else annBeforeSafe
 
-     annLoc (createImportData impDecl) (pure l) $ AST.UImportDecl 
+     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)) 
+       <*> (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)) 
+       <*> (if isGoodSrcSpan safeTok then makeJust <$> (annLocNoSema (pure safeTok) (pure AST.UImportSafe))
                                      else nothing " " "" (after annBeforeSafe))
-       <*> maybe (nothing " " "" (after annBeforePkg)) 
+       <*> maybe (nothing " " "" (after annBeforePkg))
                  (\str -> makeJust <$> (annLocNoSema (tokenLoc AnnPackageName) (pure (AST.UStringNode (unpackFS $ sl_fs str))))) pkg
-       <*> trfModuleName name 
+       <*> trfModuleName name
        <*> maybe (nothing " " "" (pure $ srcSpanEnd (getLoc name))) (\mn -> makeJust <$> (trfRenaming mn)) declAs
-       <*> trfImportSpecs declHiding 
+       <*> trfImportSpecs declHiding
   where trfRenaming mn
           = annLocNoSema (tokensLoc [AnnAs,AnnVal])
-                         (AST.UImportRenaming <$> (annLocNoSema (tokenLoc AnnVal) 
-                                                  (trfModuleName' mn)))  
-  
+                         (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)) 
+trfImportSpecs (Just (True, l))
   = makeJust <$> trfLocNoSema (\specs -> AST.UImportSpecHiding <$> (makeList ", " (after AnnOpenP) (catMaybes <$> mapM trfIESpec (removeDuplicates specs)))) l
-trfImportSpecs (Just (False, 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 :: 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) 
+trfIESpec' (IEThingAll n)
   = Just <$> (AST.UIESpec <$> trfImportModifier <*> trfName n <*> (makeJust <$> subspec))
-  where subspec = betweenIncluding AnnOpenP AnnCloseP $ annContNoSema (pure AST.USubSpecAll)
-trfIESpec' (IEThingWith n _ ls _)
+  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 = betweenIncluding AnnOpenP AnnCloseP $ annContNoSema 
-                    $ AST.USubSpecList <$> between AnnOpenP AnnCloseP (makeList ", " atTheStart (mapM trfName ls))
+  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)
@@ -212,10 +214,9 @@   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 
- +trfModuleName' = pure . AST.UModuleName . moduleNameString

@@ -27,14 +27,14 @@              , 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.Name)] -- ^ Location of the TH splices for extracting declarations from the renamed AST. 
+             , declSplices :: [Located (HsSplice GHC.Name)] -- ^ 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 :: [HsSplice GHC.Name] -- ^ Other types of splices (expressions, types). 
-             , exprSplices :: [HsSplice GHC.Name] -- ^ Other types of splices (expressions, types). 
+             , typeSplices :: [HsSplice GHC.Name] -- ^ Other types of splices (expressions, types).
+             , exprSplices :: [HsSplice GHC.Name] -- ^ Other types of splices (expressions, types).
              }
-      
+
 trfInit :: Map ApiAnnKey [SrcSpan] -> Map String [Located String] -> TrfInput
-trfInit annots comments 
+trfInit annots comments
   = TrfInput { srcMap = annotationsToSrcMap annots
              , pragmaComms = comments
              , declsToInsert = []
@@ -65,17 +65,17 @@ 
 -- | 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 
+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 }) 
+addEmptyScope = local (\s -> s { localsInScope = [] : localsInScope s })
 
 -- | Perform the transformation putting the given definition in a new local scope.
 addToScope :: HsHasName e => e -> Trf a -> Trf a
-addToScope e = local (\s -> s { localsInScope = hsGetNames e : localsInScope s }) 
+addToScope e = local (\s -> s { localsInScope = hsGetNames e : localsInScope s })
 
 -- | Perform the transformation putting the given definitions in the current scope.
 addToCurrentScope :: HsHasName e => e -> Trf a -> Trf a
@@ -96,7 +96,7 @@ 
 -- | Set splices that must replace the elements that are generated into the AST representation.
 setSplices :: [Located (HsSplice GHC.Name)] -> [HsSplice GHC.Name] -> [HsSplice GHC.Name] -> Trf a -> Trf a
-setSplices declSpls typeSpls exprSpls 
+setSplices declSpls typeSpls exprSpls
   = local (\s -> s { typeSplices = typeSpls, exprSplices = exprSpls, declSplices = declSpls })
 
 -- | Set the list of declarations that will be missing from AST
@@ -116,3 +116,4 @@ getSpliceLoc (HsTypedSplice _ e) = getLoc e
 getSpliceLoc (HsUntypedSplice _ e) = getLoc e
 getSpliceLoc (HsQuasiQuote _ _ sp _) = sp
+getSpliceLoc (HsSpliced _ _) = noSrcSpan

@@ -14,11 +14,12 @@ module Language.Haskell.Tools.AST.FromGHC.Names where
 
 import Control.Monad.Reader ((=<<), asks)
-import Data.Char (isDigit, isLetter)
+import Data.Char (isAlphaNum)
+import Data.List.Split (splitOn)
 
 import FastString as GHC (FastString, unpackFS)
 import HsSyn as GHC
-import Name as GHC (isSymOcc)
+import Name as GHC (isSymOcc, occNameString)
 import qualified Name as GHC (Name)
 import RdrName as GHC (RdrName)
 import SrcLoc as GHC
@@ -35,18 +36,18 @@ 
 trfOperator' :: TransformName n r => n -> Trf (AST.UOperator (Dom r) RangeStage)
 trfOperator' n
-  | isSymOcc (occName n) = AST.UNormalOp <$> (annCont (createNameInfo (transformName n)) (trfQualifiedName' n))
-  | otherwise = AST.UBacktickOp <$> (annLoc (createNameInfo (transformName n)) loc (trfQualifiedName' n))
-     where loc = mkSrcSpan <$> (updateCol (+1) <$> atTheStart) <*> (updateCol (subtract 1) <$> atTheEnd)
+  | 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) = AST.UParenName <$> (annLoc (createNameInfo (transformName n)) loc (trfQualifiedName' n))
-  | otherwise = AST.UNormalName <$> (annCont (createNameInfo (transformName n)) (trfQualifiedName' n))
-     where loc = mkSrcSpan <$> (updateCol (+1) <$> atTheStart) <*> (updateCol (subtract 1) <$> atTheEnd)
+  | 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
@@ -54,29 +55,35 @@ 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) 
-      $ AST.UNormalName 
-          <$> (annLoc (createAmbigousNameInfo rdr l) (pure l) $ AST.nameFromList <$> trfNameStr (rdrNameStr rdr))
+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))
 
-class (DataId n, Eq n, GHCName n) => TransformableName n where
+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
   getDeclSplices :: Trf [Located (HsSplice n)]
-  fromGHCName :: GHC.Name -> n 
 
 instance TransformableName RdrName where
   correctNameString = pure . rdrNameStr
   getDeclSplices = pure []
-  fromGHCName = rdrName
 
 instance TransformableName GHC.Name where
   correctNameString n = getOriginalName (rdrName n)
   getDeclSplices = asks declSplices
-  fromGHCName = id
 
 -- | 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) 
+class (TransformableName name, HsHasName name, TransformableName res, HsHasName res, GHCName res)
         => TransformName name res where
   -- | Demote a given name
   transformName :: name -> res
@@ -89,46 +96,54 @@ 
 trfNameText :: String -> Trf (Ann AST.UName (Dom r) RangeStage)
 trfNameText str
-  = annContNoSema (AST.UNormalName <$> annLoc (createImplicitNameInfo str) (asks contRange) (AST.nameFromList <$> trfNameStr 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 
+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 nstr))
+           annContNoSema (AST.UImplicitName <$> annLoc (createImplicitNameInfo nstr) (pure rng')
+                                                  (AST.nameFromList <$> trfNameStr (isOperatorStr nstr) nstr))
 
-trfQualifiedName :: TransformName n r => Located n -> Trf (Ann AST.UQualifiedName (Dom r) RangeStage)
-trfQualifiedName (L l n) = annLoc (createNameInfo (transformName n)) (pure l) (trfQualifiedName' n)
+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 <$> (trfNameStr =<< correctNameString n)
+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 :: String -> Trf (AnnListG AST.UNamePart (Dom r) RangeStage)
-trfNameStr str = makeList "." atTheStart (trfNameStr' str <$> atTheStart)
+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 srcLoc = fst $
+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 "." ) ) 
-  ([], srcLoc) (nameParts str)
+                         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
-
-        -- | Break up a name into parts, but take care for operators
-        nameParts :: String -> [String]
-        nameParts = nameParts' ""
-
-        nameParts' :: String -> String -> [String]
-        nameParts' carry (c : rest) | isLetter c || isDigit c || c == '\'' || c == '_' || c == '#'
-                                    = nameParts' (c:carry) rest
-        nameParts' carry@(_:_) ('.' : rest) = reverse carry : nameParts rest
-        nameParts' "" rest = [rest] 
-        nameParts' carry [] = [reverse carry]
-        nameParts' carry str = error $ "nameParts': " ++ show carry ++ " " ++ show str
 
 trfFastString :: Located FastString -> Trf (Ann AST.UStringNode (Dom r) RangeStage)
 trfFastString = trfLocNoSema $ pure . AST.UStringNode . unpackFS

@@ -9,6 +9,7 @@ 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(..))
@@ -19,7 +20,7 @@ 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')
+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
 
@@ -28,11 +29,11 @@ 
 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 
+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 (tokenLoc AnnDotdot) (AST.UFieldWildcardPattern <$> annCont (createImplicitFldInfo (unLoc . (\(VarPat n) -> n) . unLoc) (map unLoc fromWC)) (pure AST.FldWildcard))
+      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)
 
@@ -57,14 +58,15 @@ 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 splice) = AST.USplicePat <$> annContNoSema (trfSplice' splice)
+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' _ = error "trfPattern': cannot be used on patterns generated by the compiler"
+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)+trfPatternField' (HsRecField id _ True) = AST.UFieldPunPattern <$> trfName (getFieldOccName id)

@@ -22,7 +22,7 @@ getKeywordInside keyw sr srcmap = getSourceElementInside True sr =<< Map.lookup keyw (fst srcmap)
 
 getKeywordsInside :: AnnKeywordId -> SrcSpan -> SourceMap -> [SrcSpan]
-getKeywordsInside keyw sr srcmap 
+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
@@ -32,7 +32,7 @@ getKeywordInsideBack keyw sr srcmap = getSourceElementInside False sr =<< Map.lookup keyw (fst srcmap)
 
 getSourceElementInside :: Bool -> SrcSpan -> Map SrcLoc SrcLoc -> Maybe SrcSpan
-getSourceElementInside b sr srcmap = 
+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
@@ -43,18 +43,15 @@ 
 -- | 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 
+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 
+  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
-    
-    
-                

@@ -4,11 +4,12 @@            #-}
 -- | 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)
@@ -19,60 +20,62 @@ 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 => (Located (ge n) -> Trf (Ann ae (Dom r) RangeStage)) -> Stmt n (Located (ge n)) -> Trf (AST.UStmt' ae (Dom r) RangeStage)
+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 binds)
+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' _ _ = error "gTrfDoStmt': not a simple do statement"
+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 _ _) -> 
+      <$> 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 
+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)) 
+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 } 
+  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 } 
+  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 (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,3 +1,4 @@+{-# 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
 
@@ -6,15 +7,12 @@ import ApiAnnotation as GHC (AnnKeywordId(..))
 import FastString as GHC (unpackFS)
 import HsExpr as GHC (HsSplice(..), HsExpr(..), HsBracket(..))
-import OccName as GHC (occNameString)
-import RdrName as GHC (rdrNameOcc)
 import SrcLoc as GHC
 
 import Language.Haskell.Tools.AST.FromGHC.Decls (trfDecls, trfDeclsGroup)
 import Language.Haskell.Tools.AST.FromGHC.Exprs (trfExpr, createScopeInfo)
-import Language.Haskell.Tools.AST.FromGHC.GHCUtils (GHCName(..))
-import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf)
-import Language.Haskell.Tools.AST.FromGHC.Names (TransformName(..), trfName')
+import Language.Haskell.Tools.AST.FromGHC.Monad (TrfInput(..), Trf, getSpliceLoc)
+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
@@ -24,35 +22,40 @@ 
 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 (pure quoterLoc) (trfName' id)
-                   <*> annLocNoSema (pure strLoc) (pure $ AST.QQString (unpackFS str))
-  where quoterLoc = mkSrcSpan (updateCol (subtract (1 + length (occNameString $ rdrNameOcc $ rdrName id))) (srcSpanStart l)) 
-                              (updateCol (subtract 1) (srcSpanStart l))
+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' _ = error "trfQuasiQuotation': splice received"
+trfQuasiQuotation' qq = unhandledElement "quasi quotation" qq
 
-trfSplice :: TransformName n r => Located (HsSplice n) -> Trf (Ann AST.USplice (Dom r) RangeStage)
-trfSplice = trfLocNoSema trfSplice'
+trfSplice :: TransformName n r => HsSplice n -> Trf (Ann AST.USplice (Dom r) RangeStage)
+trfSplice spls = annLocNoSema (pure $ getSpliceLoc spls) (trfSplice' spls)
 
 trfSplice' :: TransformName n r => HsSplice n -> Trf (AST.USplice (Dom r) RangeStage)
-trfSplice' (HsTypedSplice _ expr) = AST.UParenSplice <$> trfCorrectDollar expr
-trfSplice' (HsUntypedSplice _ expr) = AST.UParenSplice <$> trfCorrectDollar expr
-trfSplice' (HsQuasiQuote {}) = error "trfSplice': quasi quotation received"
+trfSplice' (HsTypedSplice _ expr) = trfSpliceExpr expr
+trfSplice' (HsUntypedSplice _ expr) = trfSpliceExpr expr
+trfSplice' s = unhandledElement "splice" s
 
-trfCorrectDollar :: TransformName n r => Located (HsExpr n) -> Trf (Ann AST.UExpr (Dom r) RangeStage)
-trfCorrectDollar expr = 
-  do isSplice <- allTokenLoc AnnThIdSplice
-     case isSplice of [] -> trfExpr expr
-                      _  -> let newSp = updateStart (updateCol (+1)) (getLoc expr) 
-                             in case expr of L _ (HsVar (L _ varName)) -> trfExpr $ L newSp (HsVar (L newSp varName))
-                                             L _ exp                   -> trfExpr $ L newSp exp
+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) 
+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

@@ -5,9 +5,8 @@ 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)
 
 trfQuasiQuotation' :: TransformName n r => HsSplice n -> Trf (AST.UQuasiQuote (Dom r) RangeStage)
-trfSplice :: TransformName n r => Located (HsSplice n) -> Trf (Ann AST.USplice (Dom r) RangeStage)
+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)

@@ -4,11 +4,11 @@            #-}
 -- | 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 Outputable as GHC (Outputable(..), showSDocUnsafe)
 import SrcLoc as GHC
 import TyCon as GHC (TyCon(..))
 import TysWiredIn (heqTyCon)
@@ -16,7 +16,6 @@ import Control.Applicative (Applicative(..), (<$>), Alternative(..))
 import Control.Monad.Reader.Class (asks)
 import Control.Reference ((^.))
-import Data.Data (Data(..), toConstr)
 import Data.List (find)
 import Data.Maybe (Maybe(..), fromJust)
 
@@ -25,26 +24,28 @@ 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')
+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 = do othSplices <- asks typeSplices
-                 let RealSrcSpan loce = getLoc typ
-                     contSplice = find (\sp -> case getSpliceLoc sp of (RealSrcSpan spLoc) -> spLoc `containsSpan` loce; _ -> False) othSplices
-                 case contSplice of Just sp -> let loc = pure $ getSpliceLoc sp
-                                                in typeSpliceInserted sp (annLocNoSema loc (AST.UTySplice <$> annLocNoSema loc (trfSplice' sp)))
-                                    Nothing -> trfLocNoSema trfType' typ
+trfType typ | RealSrcSpan loce <- getLoc typ
+  = do othSplices <- asks typeSplices
+       let contSplice = find (\sp -> case getSpliceLoc sp of (RealSrcSpan spLoc) -> spLoc `containsSpan` loce; _ -> False) othSplices
+       case contSplice of Just sp -> let loc = pure $ getSpliceLoc sp
+                                      in typeSpliceInserted sp (annLocNoSema loc (AST.UTySplice <$> trfSplice sp))
+                          Nothing -> trfLocNoSema trfType' typ
+  | 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 ctx typ) = AST.UTyCtx <$> (fromJust . (^. annMaybe) <$> trfCtx atTheStart ctx) 
-                                           <*> trfType 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 
+  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
@@ -56,59 +57,64 @@   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 splice _) = AST.UTySplice <$> annContNoSema (trfSplice' splice)
+  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'' 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 = error ("Illegal type: " ++ showSDocUnsafe (ppr t) ++ " (ctor: " ++ show (toConstr t) ++ ")")
-  
+  trfType'' t = unhandledElement "type" t
+
 trfBindings :: TransformName n r => [Located (HsTyVarBndr n)] -> Trf (AnnListG AST.UTyVar (Dom r) RangeStage)
-trfBindings vars = trfAnnList "\n" trfTyVar' vars
-  
+trfBindings vars = trfAnnList " " trfTyVar' vars
+
 trfTyVar :: TransformName n r => Located (HsTyVarBndr n) -> Trf (Ann AST.UTyVar (Dom r) RangeStage)
-trfTyVar = trfLocNoSema trfTyVar' 
-  
+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) 
+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.UContextMulti <$> trfAnnList ", " trfAssertion' [t])
-trfCtx _ (L l [t]) 
-  = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow) 
-                              (AST.UContextOne <$> trfAssertion t)
-trfCtx _ (L l ctx) = makeJust <$> annLocNoSema (combineSrcSpans l <$> tokenLoc AnnDarrow) 
-                                               (AST.UContextMulti <$> trfAnnList ", " trfAssertion' ctx) 
-  
+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' (cleanHsType -> HsParTy t)
   = trfAssertion' (unLoc t)
-trfAssertion' (cleanHsType -> HsOpTy left op right) 
+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 -> error ("Illegal trf assertion: " ++ showSDocUnsafe (ppr t) ++ " (ctor: " ++ show (toConstr 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))+        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.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,5 +1,5 @@ -- | Utility functions for transforming the GHC AST representation into our own.
-{-# LANGUAGE TypeSynonymInstances 
+{-# LANGUAGE TypeSynonymInstances
            , FlexibleInstances
            , LambdaCase
            , ViewPatterns
@@ -28,11 +28,13 @@ 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)
@@ -45,12 +47,12 @@ import Language.Haskell.Tools.AST.SemaInfoTypes as Sema
 
 createModuleInfo :: ModSummary -> Trf (Sema.ModuleInfo GHC.Name)
-createModuleInfo mod = do 
+createModuleInfo mod = do
   let prelude = xopt ImplicitPrelude $ ms_hspp_opts mod
   (_,preludeImports) <- if prelude then getImportedNames "Prelude" Nothing else return (ms_mod mod, [])
-  (insts, famInsts) <- if prelude then lift $ getOrphanAndFamInstances (Module baseUnitId (GHC.mkModuleName "Prelude")) 
+  (insts, famInsts) <- if prelude then lift $ getOrphanAndFamInstances (Module baseUnitId (GHC.mkModuleName "Prelude"))
                                   else return ([], [])
-  return $ mkModuleInfo (ms_mod mod) (case ms_hsc_src mod of HsSrcFile -> False; _ -> True) preludeImports insts famInsts
+  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)
@@ -81,7 +83,7 @@ 
 -- | 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) = 
+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
@@ -90,13 +92,13 @@      return $ mkImportInfo mod (catMaybes lookedUpImported) (catMaybes lookedUpNames) insts famInsts
 
 getOrphanAndFamInstances :: Module -> Ghc ([ClsInst], [FamInst])
-getOrphanAndFamInstances mod = do      
+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 
+      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
@@ -117,8 +119,8 @@   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 
+  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
@@ -132,58 +134,75 @@ checkImportVisible _ _ = return True
 
 ieSpecMatches :: (HsHasName name, GhcMonad m) => IE name -> GHC.Name -> m Bool
-ieSpecMatches (hsGetNames . HsSyn.ieName -> [n]) name
-  | n == name = return True
-  | isTyConName n
+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 
+       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)) 
+                                 | 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 
+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 False <$> ann) <*> pure []
+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 False <$> ann) <*> ls
+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 False <$> ann) <*> ls
+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 False <$> ann) <*> ls
+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 False noSrcLoc) <$> ls
+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 = AnnListG <$> (noSemaInfo . ListPos  "" "" "\n" True <$> ann) <*> ls
+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 isEmpty <- null <$> ls 
-                                          AnnListG <$> (noSemaInfo . ListPos (if isEmpty then "\n" else "") "" "\n" True <$> ann) <*> ls
+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 isEmpty <- null <$> ls 
-                                      AnnListG <$> (noSemaInfo . ListPos (if isEmpty then bef else "") "" "\n" True <$> sp) <*> ls
-  
+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 = AnnListG (noSemaInfo $ ListPos "" "" "\n" True noSrcLoc) <$> ls
-  
+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)
@@ -226,7 +245,7 @@ 
 -- | 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 "" "" "" False noSrcLoc)
+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
@@ -255,16 +274,6 @@ between :: AnnKeywordId -> AnnKeywordId -> Trf a -> Trf a
 between firstTok lastTok = focusAfter firstTok . focusBefore lastTok
 
-betweenIncluding :: AnnKeywordId -> AnnKeywordId -> Trf a -> Trf a
-betweenIncluding firstTok lastTok trf
-  = do start <- tokenLoc firstTok
-       end <- tokenLocBack lastTok
-       if isGoodSrcSpan start && isGoodSrcSpan end
-          then local (\s -> s { contRange = mkSrcSpan (srcSpanStart start) (srcSpanEnd end)}) trf
-          else do rng <- asks contRange 
-                  error $ "betweenIncluding: tokens not found in " ++ show rng ++ ": " 
-                            ++ show firstTok ++ " or " ++ show lastTok
-
 -- | Focuses the transformation to go between tokens if they are present
 betweenIfPresent :: AnnKeywordId -> AnnKeywordId -> Trf a -> Trf a
 betweenIfPresent firstTok lastTok = focusAfterIfPresent firstTok . focusBeforeIfPresent lastTok
@@ -275,7 +284,7 @@   = do firstToken <- tokenLoc firstTok
        if (isGoodSrcSpan firstToken)
           then local (\s -> s { contRange = mkSrcSpan (srcSpanEnd firstToken) (srcSpanEnd (contRange s))}) trf
-          else do rng <- asks contRange 
+          else do rng <- asks contRange
                   error $ "focusAfter: token not found in " ++ show rng ++ ": " ++ show firstTok
 
 focusAfterIfPresent :: AnnKeywordId -> Trf a -> Trf a
@@ -291,7 +300,7 @@   = do lastToken <- tokenLocBack lastTok
        if (isGoodSrcSpan lastToken)
           then local (\s -> s { contRange = mkSrcSpan (srcSpanStart (contRange s)) (srcSpanStart lastToken)}) trf
-          else do rng <- asks contRange 
+          else do rng <- asks contRange
                   error $ "focusBefore: token not found in " ++ show rng ++ ": " ++ show lastTok
 
 focusBeforeIfPresent :: AnnKeywordId -> Trf a -> Trf a
@@ -304,7 +313,7 @@ -- | 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
@@ -316,14 +325,14 @@ 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       
+-- | 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      
+
+-- | 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)
@@ -336,26 +345,31 @@ tokenLocBack keyw = fromMaybe noSrcSpan <$> (getKeywordInsideBack keyw <$> asks contRange <*> asks srcMap)
 
 tokenBefore :: SrcLoc -> AnnKeywordId -> Trf SrcSpan
-tokenBefore loc keyw 
+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 
+        tokensLoc' (keyw:rest) r
           = do spanFirst <- tokenLoc keyw
                spanRest <- tokensLoc' rest (mkSrcSpan (srcSpanEnd spanFirst) (srcSpanEnd r))
-               return (combineSrcSpans spanFirst spanRest)                   
+               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)
@@ -364,7 +378,7 @@ 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 
+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
 
@@ -396,7 +410,7 @@ 
 -- | 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` AST.ordSrcSpan . (^. AST.annotation & AST.sourceInfo & AST.nodeSpan))
+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
@@ -416,11 +430,21 @@ 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 
+        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"+splitLocated _ = error "splitLocated: unhelpful span given"
+
+-- | 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

@@ -1,5 +1,5 @@ name:                haskell-tools-backend-ghc
-version:             0.5.0.0
+version:             0.6.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
@@ -12,7 +12,8 @@ cabal-version:       >=1.10
 
 library
-  exposed-modules:     Language.Haskell.Tools.AST.FromGHC   
+  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
@@ -24,7 +25,7 @@                      , Language.Haskell.Tools.AST.FromGHC.Kinds
                      , Language.Haskell.Tools.AST.FromGHC.Literals
                      , Language.Haskell.Tools.AST.FromGHC.Names
-                     , Language.Haskell.Tools.AST.FromGHC.GHCUtils                  
+                     , 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
@@ -41,5 +42,5 @@                      , split             >= 0.2  && < 0.3
                      , template-haskell  >= 2.11 && < 2.12
                      , ghc               >= 8.0  && < 8.1
-                     , haskell-tools-ast >= 0.5  && < 0.6
-  default-language:    Haskell2010+                     , haskell-tools-ast >= 0.6  && < 0.7
+  default-language:    Haskell2010