diff --git a/Language/Haskell/Tools/AST/Gen/Base.hs b/Language/Haskell/Tools/AST/Gen/Base.hs --- a/Language/Haskell/Tools/AST/Gen/Base.hs +++ b/Language/Haskell/Tools/AST/Gen/Base.hs @@ -1,6 +1,7 @@ -- | Generation of basic AST fragments (names for example) for refactorings {-# LANGUAGE OverloadedStrings , ViewPatterns + , TypeFamilies #-} module Language.Haskell.Tools.AST.Gen.Base where @@ -16,33 +17,33 @@ import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers -- | Creates an annotated qualified operator: @A.B.+@ or @`A.B.mod`@. -mkQualOp' :: TemplateAnnot a => [String] -> GHC.Name -> Ann Operator a +mkQualOp' :: [String] -> GHC.Name -> Ann Operator dom SrcTemplateStage mkQualOp' quals n | GHC.isSymOcc (GHC.getOccName n) = mkAnn child $ NormalOp $ mkQualifiedName' quals n | otherwise = mkAnn ("`" <> child <> "`") $ BacktickOp $ mkQualifiedName' quals n -- | Creates an annotated unqualified operator: @+@ or @`mod`@. -mkUnqualOp' :: TemplateAnnot a => GHC.Name -> Ann Operator a +mkUnqualOp' :: GHC.Name -> Ann Operator dom SrcTemplateStage mkUnqualOp' n | GHC.isSymOcc (GHC.getOccName n) = mkAnn child $ NormalOp $ mkSimpleName' n | otherwise = mkAnn ("`" <> child <> "`") $ BacktickOp $ mkSimpleName' n -- | Creates an annotated qualified (non-operator) binding name: @A.B.f@ or @(A.B.+)@ -mkQualName' :: TemplateAnnot a => [String] -> GHC.Name -> Ann Name a +mkQualName' :: [String] -> GHC.Name -> Ann Name dom SrcTemplateStage mkQualName' quals n | GHC.isSymOcc (GHC.getOccName n) = mkAnn ("(" <> child <> ")") $ ParenName $ mkQualifiedName' quals n | otherwise = mkAnn child $ NormalName $ mkQualifiedName' quals n -- | Creates an annotated unqualified (non-operator) binding name: @f@ or @(+)@ -mkUnqualName' :: TemplateAnnot a => GHC.Name -> Ann Name a +mkUnqualName' :: GHC.Name -> Ann Name dom SrcTemplateStage mkUnqualName' n | GHC.isSymOcc (GHC.getOccName n) = mkAnn ("(" <> child <> ")") $ ParenName $ mkSimpleName' n | otherwise = mkAnn child $ NormalName $ mkSimpleName' n -mkNormalName :: TemplateAnnot a => Ann SimpleName a -> Ann Name a +mkNormalName :: Ann SimpleName dom SrcTemplateStage -> Ann Name dom SrcTemplateStage mkNormalName = mkAnn child . NormalName -mkParenName :: TemplateAnnot a => Ann SimpleName a -> Ann Name a +mkParenName :: Ann SimpleName dom SrcTemplateStage -> Ann Name dom SrcTemplateStage mkParenName = mkAnn ("(" <> child <> ")") . ParenName -- | Creates an annotated qualified simple name -mkQualifiedName' :: TemplateAnnot a => [String] -> GHC.Name -> Ann SimpleName a +mkQualifiedName' :: [String] -> GHC.Name -> Ann SimpleName dom SrcTemplateStage mkQualifiedName' [] n = mkSimpleName' n mkQualifiedName' quals (GHC.occNameString . GHC.getOccName -> name) = mkAnn (child <> "." <> child) @@ -50,12 +51,15 @@ (mkAnn (fromString name) (UnqualName name))) -- | Creates an annotated part of a name. -mkNamePart :: TemplateAnnot a => String -> Ann UnqualName a +mkNamePart :: String -> Ann UnqualName dom SrcTemplateStage mkNamePart s = mkAnn (fromString s) (UnqualName s) -mkSimpleName' :: TemplateAnnot a => GHC.Name -> Ann SimpleName a +mkSimpleName' :: GHC.Name -> Ann SimpleName dom SrcTemplateStage mkSimpleName' = mkSimpleName . GHC.occNameString . GHC.getOccName -mkSimpleName :: TemplateAnnot a => String -> Ann SimpleName a +mkSimpleName :: String -> Ann SimpleName dom SrcTemplateStage mkSimpleName n = mkAnn (child <> child) - (SimpleName emptyList (mkAnn (fromString n) (UnqualName n))) + (SimpleName emptyList (mkAnn (fromString n) (UnqualName n))) + +mkModuleName :: String -> Ann ModuleName dom SrcTemplateStage +mkModuleName s = mkAnn (fromString s) (ModuleName s) diff --git a/Language/Haskell/Tools/AST/Gen/Binds.hs b/Language/Haskell/Tools/AST/Gen/Binds.hs --- a/Language/Haskell/Tools/AST/Gen/Binds.hs +++ b/Language/Haskell/Tools/AST/Gen/Binds.hs @@ -1,7 +1,9 @@ -- | Generation of binding-level AST fragments for refactorings. -- The bindings defined here create a the annotated version of the AST constructor with the same name. -- For example, @mkMatch@ creates the annotated version of the @Match@ constructor. -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings + , TypeFamilies + #-} module Language.Haskell.Tools.AST.Gen.Binds where import qualified Name as GHC @@ -15,26 +17,26 @@ import Language.Haskell.Tools.AnnTrf.SourceTemplate import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers -mkSimpleBind :: TemplateAnnot a => Ann Pattern a -> Ann Rhs a -> Maybe (Ann LocalBinds a) -> Ann ValueBind a +mkSimpleBind :: Ann Pattern dom SrcTemplateStage -> Ann Rhs dom SrcTemplateStage -> Maybe (Ann LocalBinds dom SrcTemplateStage) -> Ann ValueBind dom SrcTemplateStage mkSimpleBind p r l = mkAnn (child <> child <> child) (SimpleBind p r (mkAnnMaybe (optBefore " ") l)) -mkFunctionBind :: TemplateAnnot a => [Ann Match a] -> Ann ValueBind a +mkFunctionBind :: [Ann Match dom SrcTemplateStage] -> Ann ValueBind dom SrcTemplateStage mkFunctionBind = mkAnn child . FunBind . mkAnnList indentedList -mkUnguardedRhs :: TemplateAnnot a => Ann Expr a -> Ann Rhs a +mkUnguardedRhs :: Ann Expr dom SrcTemplateStage -> Ann Rhs dom SrcTemplateStage mkUnguardedRhs = mkAnn (" = " <> child) . UnguardedRhs -mkMatch :: TemplateAnnot a => Ann MatchLhs a -> Ann Rhs a -> Maybe (Ann LocalBinds a) -> Ann Match a +mkMatch :: Ann MatchLhs dom SrcTemplateStage -> Ann Rhs dom SrcTemplateStage -> Maybe (Ann LocalBinds dom SrcTemplateStage) -> Ann Match dom SrcTemplateStage mkMatch lhs rhs locs = mkAnn (child <> child <> child) $ Match lhs rhs (mkAnnMaybe (optBefore " ") locs) -mkNormalMatchLhs :: TemplateAnnot a => Ann Name a -> [Ann Pattern a] -> Ann MatchLhs a +mkNormalMatchLhs :: Ann Name dom SrcTemplateStage -> [Ann Pattern dom SrcTemplateStage] -> Ann MatchLhs dom SrcTemplateStage mkNormalMatchLhs n pats = mkAnn (child <> child) $ NormalLhs n (mkAnnList (listSepBefore " " " ") pats) -mkLocalValBind :: TemplateAnnot a => Ann ValueBind a -> Ann LocalBind a +mkLocalValBind :: Ann ValueBind dom SrcTemplateStage -> Ann LocalBind dom SrcTemplateStage mkLocalValBind = mkAnn child . LocalValBind -mkLocalBinds :: TemplateAnnot a => Int -> [Ann LocalBind a] -> AnnMaybe LocalBinds a +mkLocalBinds :: Int -> [Ann LocalBind dom SrcTemplateStage] -> AnnMaybe LocalBinds dom SrcTemplateStage mkLocalBinds col = mkAnnMaybe (optBefore ("\n" ++ replicate (col - 1) ' ' ++ "where ")) . Just . mkAnn child . LocalBinds . mkAnnList indentedList diff --git a/Language/Haskell/Tools/AST/Gen/Decls.hs b/Language/Haskell/Tools/AST/Gen/Decls.hs --- a/Language/Haskell/Tools/AST/Gen/Decls.hs +++ b/Language/Haskell/Tools/AST/Gen/Decls.hs @@ -1,7 +1,9 @@ -- | Generation of declaration-level AST fragments for refactorings. -- The bindings defined here create a the annotated version of the AST constructor with the same name. -- For example, @mkTypeSignature@ creates the annotated version of the @TypeSignature@ AST constructor. -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings + , TypeFamilies + #-} module Language.Haskell.Tools.AST.Gen.Decls where import qualified Name as GHC @@ -16,9 +18,9 @@ import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers -mkTypeSignature :: TemplateAnnot a => Ann Name a -> Ann Type a -> Ann TypeSignature a +mkTypeSignature :: Ann Name dom SrcTemplateStage -> Ann Type dom SrcTemplateStage -> Ann TypeSignature dom SrcTemplateStage mkTypeSignature n t = mkAnn (child <> " :: " <> child) (TypeSignature (mkAnnList (listSep ", ") [n]) t) -mkValueBinding :: TemplateAnnot a => Ann ValueBind a -> Ann Decl a +mkValueBinding :: Ann ValueBind dom SrcTemplateStage -> Ann Decl dom SrcTemplateStage mkValueBinding = mkAnn child . ValueBinding diff --git a/Language/Haskell/Tools/AST/Gen/Exprs.hs b/Language/Haskell/Tools/AST/Gen/Exprs.hs --- a/Language/Haskell/Tools/AST/Gen/Exprs.hs +++ b/Language/Haskell/Tools/AST/Gen/Exprs.hs @@ -1,7 +1,9 @@ -- | Generation of expression-level AST fragments for refactorings. -- The bindings defined here create a the annotated version of the AST constructor with the same name. -- For example, @mkApp@ creates the annotated version of the @App@ AST constructor. -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings + , TypeFamilies + #-} module Language.Haskell.Tools.AST.Gen.Exprs where import qualified Name as GHC @@ -15,11 +17,11 @@ import Language.Haskell.Tools.AnnTrf.SourceTemplate import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers -mkApp :: TemplateAnnot a => Ann Expr a -> Ann Expr a -> Ann Expr a +mkApp :: Ann Expr dom SrcTemplateStage -> Ann Expr dom SrcTemplateStage -> Ann Expr dom SrcTemplateStage mkApp f e = mkAnn (child <> " " <> child) (App f e) -mkVar :: TemplateAnnot a => Ann Name a -> Ann Expr a +mkVar :: Ann Name dom SrcTemplateStage -> Ann Expr dom SrcTemplateStage mkVar = mkAnn child . Var -mkParen :: TemplateAnnot a => Ann Expr a -> Ann Expr a +mkParen :: Ann Expr dom SrcTemplateStage -> Ann Expr dom SrcTemplateStage mkParen = mkAnn ("(" <> child <> ")") . Paren diff --git a/Language/Haskell/Tools/AST/Gen/Modules.hs b/Language/Haskell/Tools/AST/Gen/Modules.hs --- a/Language/Haskell/Tools/AST/Gen/Modules.hs +++ b/Language/Haskell/Tools/AST/Gen/Modules.hs @@ -1,7 +1,9 @@ -- | Generation of Module-level AST fragments for refactorings. -- The bindings defined here create a the annotated version of the AST constructor with the same name. -- For example, @mkModule@ creates the annotated version of the @Module@ AST constructor. -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings + , TypeFamilies + #-} module Language.Haskell.Tools.AST.Gen.Modules where import qualified Name as GHC @@ -15,40 +17,43 @@ import Language.Haskell.Tools.AnnTrf.SourceTemplate import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers -mkModule :: TemplateAnnot a => [Ann FilePragma a] -> Maybe (Ann ModuleHead a) - -> [Ann ImportDecl a] -> [Ann Decl a] -> Ann Module a +mkModule :: [Ann FilePragma dom SrcTemplateStage] -> Maybe (Ann ModuleHead dom SrcTemplateStage) + -> [Ann ImportDecl dom SrcTemplateStage] -> [Ann Decl dom SrcTemplateStage] -> Ann Module dom SrcTemplateStage mkModule filePrags head imps decls = mkAnn (child <> "\n" <> child <> "\n" <> child <> "\n" <> child) $ Module (mkAnnList (listSep "\n") filePrags) (mkAnnMaybe opt head) (mkAnnList indentedList imps) (mkAnnList indentedList decls) -mkModuleHead :: TemplateAnnot a => Ann SimpleName a -> Maybe (Ann ExportSpecList a) -> Maybe (Ann ModulePragma a) -> Ann ModuleHead a +mkModuleHead :: Ann ModuleName dom SrcTemplateStage -> Maybe (Ann ExportSpecList dom SrcTemplateStage) + -> Maybe (Ann ModulePragma dom SrcTemplateStage) -> Ann ModuleHead dom SrcTemplateStage mkModuleHead n es pr = mkAnn (child <> child <> child) $ ModuleHead n (mkAnnMaybe (optBefore " ") es) (mkAnnMaybe opt pr) -mkExportSpecList :: TemplateAnnot a => [Ann ExportSpec a] -> Ann ExportSpecList a +mkExportSpecList :: [Ann ExportSpec dom SrcTemplateStage] -> Ann ExportSpecList dom SrcTemplateStage mkExportSpecList = mkAnn ("(" <> child <> ")") . ExportSpecList . mkAnnList (listSep ", ") -mkModuleExport :: TemplateAnnot a => Ann SimpleName a -> Ann ExportSpec a +mkModuleExport :: Ann ModuleName dom SrcTemplateStage -> Ann ExportSpec dom SrcTemplateStage mkModuleExport = mkAnn ("module " <> child) . ModuleExport -mkExportSpec :: TemplateAnnot a => Ann IESpec a -> Ann ExportSpec a +mkExportSpec :: Ann IESpec dom SrcTemplateStage -> Ann ExportSpec dom SrcTemplateStage mkExportSpec = mkAnn child . DeclExport -mkImportSpecList :: TemplateAnnot a => [Ann IESpec a] -> Ann ImportSpec a +mkImportSpecList :: [Ann IESpec dom SrcTemplateStage] -> Ann ImportSpec dom SrcTemplateStage mkImportSpecList = mkAnn ("(" <> child <> ")") . ImportSpecList . mkAnnList (listSep ", ") -mkIeSpec :: TemplateAnnot a => Ann Name a -> Maybe (Ann SubSpec a) -> Ann IESpec a +mkIeSpec :: Ann Name dom SrcTemplateStage -> Maybe (Ann SubSpec dom SrcTemplateStage) -> Ann IESpec dom SrcTemplateStage mkIeSpec name ss = mkAnn (child <> child) (IESpec name (mkAnnMaybe opt ss)) -mkSubList :: TemplateAnnot a => [Ann Name a] -> Ann SubSpec a +mkSubList :: [Ann Name dom SrcTemplateStage] -> Ann SubSpec dom SrcTemplateStage mkSubList = mkAnn ("(" <> child <> ")") . SubSpecList . mkAnnList (listSep ", ") -mkSubAll :: TemplateAnnot a => Ann SubSpec a +mkSubAll :: Ann SubSpec dom SrcTemplateStage mkSubAll = mkAnn "(..)" SubSpecAll -- TODO: mk pragmas -mkImportDecl :: TemplateAnnot a => Bool -> Bool -> Bool -> Maybe String -> Ann SimpleName a -> Maybe (Ann ImportRenaming a) -> Maybe (Ann ImportSpec a) -> Ann ImportDecl a +mkImportDecl :: Bool -> Bool -> Bool -> Maybe String -> Ann ModuleName dom SrcTemplateStage + -> Maybe (Ann ImportRenaming dom SrcTemplateStage) -> Maybe (Ann ImportSpec dom SrcTemplateStage) + -> Ann ImportDecl dom SrcTemplateStage mkImportDecl source qualified safe pkg name rename spec = mkAnn ("import " <> child <> child <> child <> child <> child <> child <> child) $ ImportDecl (if source then justVal (mkAnn "{-# SOURCE #-} " ImportSource) else noth) diff --git a/Language/Haskell/Tools/AST/Gen/Patterns.hs b/Language/Haskell/Tools/AST/Gen/Patterns.hs --- a/Language/Haskell/Tools/AST/Gen/Patterns.hs +++ b/Language/Haskell/Tools/AST/Gen/Patterns.hs @@ -1,7 +1,9 @@ -- | Generation of pattern-level AST fragments for refactorings. -- The bindings defined here create a the annotated version of the AST constructor with the same name. -- For example, @mkVarPat@ creates the annotated version of the @VarPat@ AST constructor. -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings + , TypeFamilies + #-} module Language.Haskell.Tools.AST.Gen.Patterns where import qualified Name as GHC @@ -15,8 +17,8 @@ import Language.Haskell.Tools.AnnTrf.SourceTemplate import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers -mkVarPat :: TemplateAnnot a => Ann Name a -> Ann Pattern a +mkVarPat :: Ann Name dom SrcTemplateStage -> Ann Pattern dom SrcTemplateStage mkVarPat = mkAnn child . VarPat -mkAppPat :: TemplateAnnot a => Ann Name a -> [Ann Pattern a] -> Ann Pattern a +mkAppPat :: Ann Name dom SrcTemplateStage -> [Ann Pattern dom SrcTemplateStage] -> Ann Pattern dom SrcTemplateStage mkAppPat n pat = mkAnn (child <> child) $ AppPat n (mkAnnList (listSepBefore " " " ") pat) diff --git a/Language/Haskell/Tools/AST/Gen/Types.hs b/Language/Haskell/Tools/AST/Gen/Types.hs --- a/Language/Haskell/Tools/AST/Gen/Types.hs +++ b/Language/Haskell/Tools/AST/Gen/Types.hs @@ -1,7 +1,9 @@ -- | Generation of type-level AST fragments for refactorings. -- The bindings defined here create a the annotated version of the AST constructor with the same name. -- For example, @mkTyForall@ creates the annotated version of the @TyForall@ AST constructor. -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings + , TypeFamilies + #-} module Language.Haskell.Tools.AST.Gen.Types where import qualified Name as GHC @@ -17,73 +19,73 @@ -- * Generation of types -mkTyForall :: TemplateAnnot a => AnnList TyVar a -> Ann Type a -> Ann Type a +mkTyForall :: AnnList TyVar dom SrcTemplateStage -> Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyForall vars t = mkAnn ("forall " <> child <> " ." <> child <> " " <> child) (TyForall vars t) -mkTypeVarList :: TemplateAnnot a => [GHC.Name] -> AnnList TyVar a +mkTypeVarList :: [GHC.Name] -> AnnList TyVar dom SrcTemplateStage mkTypeVarList ls = mkAnnList (listSep " ") (map (mkTypeVar . mkUnqualName') ls) -mkTyCtx :: TemplateAnnot a => Ann Context a -> Ann Type a -> Ann Type a +mkTyCtx :: Ann Context dom SrcTemplateStage -> Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyCtx ctx t = mkAnn (child <> " " <> child) (TyCtx ctx t) -mkTyFun :: TemplateAnnot a => Ann Type a -> Ann Type a -> Ann Type a +mkTyFun :: Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyFun at rt = mkAnn (child <> " -> " <> child) (TyFun at rt) -mkTyTuple :: TemplateAnnot a => [Ann Type a] -> Ann Type a +mkTyTuple :: [Ann Type dom SrcTemplateStage] -> Ann Type dom SrcTemplateStage mkTyTuple args = mkAnn ("(" <> child <> ")") (TyTuple (mkAnnList (listSep ", ") args)) -mkTyUnbTuple :: TemplateAnnot a => [Ann Type a] -> Ann Type a +mkTyUnbTuple :: [Ann Type dom SrcTemplateStage] -> Ann Type dom SrcTemplateStage mkTyUnbTuple args = mkAnn ("(#" <> child <> "#)") (TyUnbTuple (mkAnnList (listSep ", ") args)) -mkTyList :: TemplateAnnot a => Ann Type a -> Ann Type a +mkTyList :: Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyList = mkAnn ("[" <> child <> "]") . TyList -mkTyParArray :: TemplateAnnot a => Ann Type a -> Ann Type a +mkTyParArray :: Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyParArray = mkAnn ("[:" <> child <> ":]") . TyParArray -mkTyApp :: TemplateAnnot a => Ann Type a -> Ann Type a -> Ann Type a +mkTyApp :: Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyApp ft at = mkAnn (child <> " " <> child) (TyApp ft at) -mkTyInfix :: TemplateAnnot a => Ann Type a -> Ann Operator a -> Ann Type a -> Ann Type a +mkTyInfix :: Ann Type dom SrcTemplateStage -> Ann Operator dom SrcTemplateStage -> Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyInfix left op right = mkAnn (child <> " " <> child <> " " <> child) (TyInfix left op right) -mkTyParen :: TemplateAnnot a => Ann Type a -> Ann Type a +mkTyParen :: Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyParen = mkAnn ("(" <> child <> ")") . TyParen -mkTypeVar :: TemplateAnnot a => Ann Name a -> Ann TyVar a -mkTypeVar n = mkAnn (child <> optBefore " ") (TyVarDecl n noth) +mkTypeVar :: Ann Name dom SrcTemplateStage -> Ann TyVar dom SrcTemplateStage +mkTypeVar n = mkAnn (child <> child) (TyVarDecl n noth) -mkTyVar :: TemplateAnnot a => Ann Name a -> Ann Type a +mkTyVar :: Ann Name dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyVar = wrapperAnn . TyVar -mkTyKinded :: TemplateAnnot a => Ann Type a -> Ann Kind a -> Ann Type a +mkTyKinded :: Ann Type dom SrcTemplateStage -> Ann Kind dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyKinded t k = mkAnn (child <> " :: " <> child) (TyKinded t k) -mkTyBang :: TemplateAnnot a => Ann Type a -> Ann Type a +mkTyBang :: Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyBang = mkAnn ("!" <> child) . TyBang -mkTyUnpack :: TemplateAnnot a => Ann Type a -> Ann Type a +mkTyUnpack :: Ann Type dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyUnpack = mkAnn ("{-# UNPACK #-} " <> child) . TyUnpack -mkTyWildcard :: TemplateAnnot a => Ann Type a +mkTyWildcard :: Ann Type dom SrcTemplateStage mkTyWildcard = mkAnn "_" TyWildcard -mkTyNamedWildcard :: TemplateAnnot a => Ann Name a -> Ann Type a +mkTyNamedWildcard :: Ann Name dom SrcTemplateStage -> Ann Type dom SrcTemplateStage mkTyNamedWildcard = mkAnn ("_" <> child) . TyNamedWildc -- * Generation of contexts -mkContextOne :: TemplateAnnot a => Ann Assertion a -> Ann Context a +mkContextOne :: Ann Assertion dom SrcTemplateStage -> Ann Context dom SrcTemplateStage mkContextOne = mkAnn (child <> " =>") . ContextOne -mkContextMulti :: TemplateAnnot a => [Ann Assertion a] -> Ann Context a +mkContextMulti :: [Ann Assertion dom SrcTemplateStage] -> Ann Context dom SrcTemplateStage mkContextMulti = mkAnn ("(" <> child <> ") =>") . ContextMulti . mkAnnList (listSep ", ") -- * Generation of assertions -mkClassAssert :: TemplateAnnot a => Ann Name a -> [Ann Type a] -> Ann Assertion a +mkClassAssert :: Ann Name dom SrcTemplateStage -> [Ann Type dom SrcTemplateStage] -> Ann Assertion dom SrcTemplateStage -- fixme: class assertion without parameters should not have the last space mkClassAssert n args = mkAnn (child <> " " <> child) $ ClassAssert n (mkAnnList (listSep " ") args) -mkInfixAssert :: TemplateAnnot a => Ann Type a -> Ann Operator a -> Ann Type a -> Ann Assertion a +mkInfixAssert :: Ann Type dom SrcTemplateStage -> Ann Operator dom SrcTemplateStage -> Ann Type dom SrcTemplateStage -> Ann Assertion dom SrcTemplateStage mkInfixAssert left op right = mkAnn (child <> " " <> child <> " " <> child) $ InfixAssert left op right diff --git a/Language/Haskell/Tools/AST/Gen/Utils.hs b/Language/Haskell/Tools/AST/Gen/Utils.hs --- a/Language/Haskell/Tools/AST/Gen/Utils.hs +++ b/Language/Haskell/Tools/AST/Gen/Utils.hs @@ -1,5 +1,7 @@ -- | Utility methods for generating parts of the ADT for refactorings -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances + , TypeFamilies + #-} module Language.Haskell.Tools.AST.Gen.Utils where import Control.Reference @@ -7,37 +9,32 @@ import Language.Haskell.Tools.AnnTrf.SourceTemplate import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers -emptyList :: TemplateAnnot a => AnnList e a +fromTemplate :: src -> NodeInfo sema src +fromTemplate = NodeInfo (error "The newly generated AST fragments have no semantic info") + +emptyList :: AnnList e dom SrcTemplateStage emptyList = AnnList (fromTemplate list) [] -replaceWithJust :: TemplateAnnot a => Ann e a -> AnnMaybe e a -> AnnMaybe e a +replaceWithJust :: Ann e dom SrcTemplateStage -> AnnMaybe e dom SrcTemplateStage -> AnnMaybe e dom SrcTemplateStage replaceWithJust e (AnnMaybe temp _) = AnnMaybe temp (Just e) -justVal :: TemplateAnnot a => Ann e a -> AnnMaybe e a +justVal :: Ann e dom SrcTemplateStage -> AnnMaybe e dom SrcTemplateStage justVal e = AnnMaybe (fromTemplate opt) (Just e) -noth :: TemplateAnnot a => AnnMaybe e a +noth :: AnnMaybe e dom SrcTemplateStage noth = AnnMaybe (fromTemplate opt) Nothing -mkAnn :: TemplateAnnot a => SourceTemplate -> e a -> Ann e a +mkAnn :: SpanInfo SrcTemplateStage -> e dom SrcTemplateStage -> Ann e dom SrcTemplateStage mkAnn temp = Ann (fromTemplate temp) -- | Annotation for a simple wrapper AST node -wrapperAnn :: TemplateAnnot a => e a -> Ann e a +wrapperAnn :: e dom SrcTemplateStage -> Ann e dom SrcTemplateStage wrapperAnn = mkAnn child -- | Transforms the list of elements to an AnnList with the given source template. -mkAnnList :: TemplateAnnot a => SourceTemplate -> [Ann e a] -> AnnList e a +mkAnnList :: ListInfo SrcTemplateStage -> [Ann e dom SrcTemplateStage] -> AnnList e dom SrcTemplateStage mkAnnList temp = AnnList (fromTemplate temp) -- | Transforms the Maybe element to an AnnMaybe with the given source template. -mkAnnMaybe :: TemplateAnnot a => SourceTemplate -> Maybe (Ann e a) -> AnnMaybe e a +mkAnnMaybe :: OptionalInfo SrcTemplateStage -> Maybe (Ann e dom SrcTemplateStage) -> AnnMaybe e dom SrcTemplateStage mkAnnMaybe temp = AnnMaybe (fromTemplate temp) - -instance TemplateAnnot (NodeInfo (SemanticInfo n) SourceTemplate) where - fromTemplate = NodeInfo NoSemanticInfo - getTemplate = (^. sourceInfo) - -instance TemplateAnnot (NodeInfo () SourceTemplate) where - fromTemplate = NodeInfo () - getTemplate = (^. sourceInfo) diff --git a/haskell-tools-ast-gen.cabal b/haskell-tools-ast-gen.cabal --- a/haskell-tools-ast-gen.cabal +++ b/haskell-tools-ast-gen.cabal @@ -1,5 +1,5 @@ name: haskell-tools-ast-gen -version: 0.1.2.0 +version: 0.1.3.0 synopsis: Facilities for generating new parts of the Haskell-Tools AST description: Contains utility functions to generate parts of the Haskell-Tools AST. Generates these elements to be compatible with the source annotations that are already present on the AST. homepage: https://github.com/haskell-tools/haskell-tools @@ -26,7 +26,6 @@ , mtl >=2.2 && <2.3 , containers >=0.5 && <0.6 , references >=0.3.2 && <1.0 - , haskell-tools-ast >=0.1.2 && <0.2 - , haskell-tools-ast-trf >=0.1.2 && <0.2 - , structural-traversal >=0.1 && <0.2 + , haskell-tools-ast >=0.1.3 && <0.2 + , haskell-tools-ast-trf >=0.1.3 && <0.2 default-language: Haskell2010