HaRe-0.7.2.3: the Haskell Refactorer.

Safe HaskellNone

Language.Haskell.Refact.API

Contents

Description

This module should provide all that is required to write further refactorings. NOTE: it is currently unstable, and may change without notice on minor version number bumps

Synopsis

from Monad

type ParseResult = TypecheckedModuleSource

Result of parsing a Haskell source file. It is simply the TypeCheckedModule produced by GHC.

data RefactFlags Source

Constructors

RefFlags 

Fields

rsDone :: !Bool

Current traversal has already made a change

data StateStorage Source

Provide some temporary storage while the refactoring is taking place

Instances

The GHC Monad

initGhcSession :: Cradle -> [FilePath] -> RefactGhc ()Source

Initialise the GHC session, when starting a refactoring. This should never be called directly.

loadModuleGraphGhc :: Maybe [FilePath] -> RefactGhc ()Source

Load a module graph into the GHC session, starting from main

ensureTargetLoaded :: TargetModule -> RefactGhc ModSummarySource

Make sure the given file is the currently loaded target, and load it if not. Assumes that all the module graphs had been generated before, so these are not updated.

from Utils

Managing the GHC / project environment

getModuleGhc :: FilePath -> RefactGhc ()Source

Once the module graph has been loaded, load the given module into the RefactGhc monad TODO: relax the equality test, if the file is loaded via cabal it may have a full filesystem path.

parseSourceFileGhc :: FilePath -> RefactGhc ()Source

Parse a single source file into a GHC session

activateModule :: TargetModule -> RefactGhc ModSummarySource

In the existing GHC session, put the requested TypeCheckedModule into the RefactGhc Monad, after ensuring that its originating target is the currently loaded one

getModuleDetails :: ModSummary -> RefactGhc ()Source

In the existing GHC session, put the requested TypeCheckedModule into the RefactGhc monad

The bits that do the work

runRefacSessionSource

Arguments

:: RefactSettings 
-> Cradle

Identifies the surrounding project

-> RefactGhc [ApplyRefacResult]

The computation doing the refactoring. Normally created via applyRefac

-> IO [FilePath] 

Manage a whole refactor session. Initialise the monad, load the whole project if required, and then apply the individual refactorings, and write out the resulting files.

It is intended that this forms the umbrella function, in which applyRefac is called

applyRefacSource

Arguments

:: RefactGhc a

The refactoring

-> RefacSource

where to get the module and toks

-> RefactGhc (ApplyRefacResult, a) 

Apply a refactoring (or part of a refactoring) to a single module

refactDone :: [ApplyRefacResult] -> BoolSource

Returns True if any of the results has its modified flag set

type ApplyRefacResult = ((FilePath, Bool), ([Line], [PosToken], RenamedSource))Source

The result of a refactoring is the file, a flag as to whether it was modified, the updated token stream, and the updated AST type ApplyRefacResult = ((FilePath, Bool), ([Ppr],[PosToken], GHC.RenamedSource))

updateSource

Arguments

:: Update t t1 
=> t

The syntax phrase to be updated.

-> t

The new syntax phrase.

-> t1

The contex where the old syntax phrase occurs.

-> RefactGhc t1

The result.

Update the occurrence of one syntax phrase in a given scope by another syntax phrase of the same type

fileNameToModName :: FilePath -> RefactGhc ModuleNameSource

From file name to module name.

getModuleName :: ParsedSource -> Maybe (ModuleName, String)Source

Extract the module name from the parsed source, if there is one

clientModsAndFiles :: ModuleName -> RefactGhc [([FilePath], ModSummary)]Source

Return the client modules and file names. The client modules of module, say m, are those modules which directly or indirectly import module m.

serverModsAndFiles :: GhcMonad m => ModuleName -> m [ModSummary]Source

Return the server module and file names. The server modules of module, say m, are those modules which are directly or indirectly imported by module m. This can only be called in a live GHC session TODO: make sure this works with multiple targets. Is that needed? No?

from MonadFunctions

Conveniences for state access

fetchToksFinal :: RefactGhc [PosToken]Source

fetch the final tokens

fetchLinesFinal :: RefactGhc [Line]Source

fetch the final tokens in Ppr format

fetchOrigToks :: RefactGhc [PosToken]Source

fetch the pristine token stream

fetchToks :: RefactGhc [PosToken]Source

fetch the possibly modified tokens. Deprecated

TokenUtils API

replaceToken :: SrcSpan -> PosToken -> RefactGhc ()Source

Replace a token occurring in a given GHC.SrcSpan

putToksForSpan :: SrcSpan -> [PosToken] -> RefactGhc SrcSpanSource

Replace the tokens for a given GHC.SrcSpan, return new GHC.SrcSpan delimiting new tokens

putDeclToksForSpan :: Data t => SrcSpan -> Located t -> [PosToken] -> RefactGhc (SrcSpan, Located t)Source

Replace the tokens for a given GHC.SrcSpan, return new GHC.SrcSpan delimiting new tokens, and update the AST fragment to reflect it

getToksForSpan :: SrcSpan -> RefactGhc [PosToken]Source

Get the current tokens for a given GHC.SrcSpan.

getToksForSpanNoInv :: SrcSpan -> RefactGhc [PosToken]Source

Get the current tokens for a given GHC.SrcSpan, without checking the invariant. TODO: this should not be necessary

getToksForSpanWithIntros :: SrcSpan -> RefactGhc [PosToken]Source

Get the current tokens for a given GHC.SrcSpan, leaving out any leading 'then', 'else', 'of', 'do' or 'in' tokens

getToksBeforeSpan :: SrcSpan -> RefactGhc ReversedToksSource

Get the current tokens preceding a given GHC.SrcSpan.

putToksForPos :: (SimpPos, SimpPos) -> [PosToken] -> RefactGhc SrcSpanSource

Replace the tokens for a given GHC.SrcSpan, return GHC.SrcSpan they are placed in

putToksAfterSpan :: SrcSpan -> Positioning -> [PosToken] -> RefactGhc SrcSpanSource

Add tokens after a designated GHC.SrcSpan

putToksAfterPos :: (SimpPos, SimpPos) -> Positioning -> [PosToken] -> RefactGhc SrcSpanSource

Add tokens after a designated position

putDeclToksAfterSpan :: Data t => SrcSpan -> Located t -> Positioning -> [PosToken] -> RefactGhc (Located t)Source

Add tokens after a designated GHC.SrcSpan, and update the AST fragment to reflect it

removeToksForSpan :: SrcSpan -> RefactGhc ()Source

Remove a GHC.SrcSpan and its associated tokens

removeToksForPos :: (SimpPos, SimpPos) -> RefactGhc ()Source

Remove a GHC.SrcSpan and its associated tokens

indentDeclAndToks :: Data t => Located t -> Int -> RefactGhc (Located t)Source

Indent an AST fragment and its associated tokens by a set amount

LayoutUtils API

For debugging

drawTokenTree :: String -> RefactGhc ()Source

Print the Token Tree for debug purposes

drawTokenTreeDetailed :: String -> RefactGhc ()Source

Print detailed Token Tree for debug purposes

getTokenTree :: RefactGhc (Tree Entry)Source

Get the Token Tree for debug purposes

State flags for managing generic traversals

updateToksSource

Arguments

:: Data t 
=> Located t

Old element

-> Located t

New element

-> (Located t -> [Char])

pretty printer

-> Bool

Add trailing newline if required

-> RefactGhc ()

Updates the RefactState

updateToksWithPosSource

Arguments

:: Data t 
=> (SimpPos, SimpPos)

Start and end pos of old element

-> t

New element

-> (t -> [Char])

pretty printer

-> Bool

Add trailing newline if required

-> RefactGhc ()

Updates the RefactState

from LocUtils

isIgnoredNonComment :: PosToken -> BoolSource

Tokens that are ignored when determining the first non-comment token in a span

endsWithNewLn :: PosToken -> BoolSource

Returns True if the token ends with '\n' ++AZ++: is this meaningful?

startsWithNewLn :: PosToken -> BoolSource

Returns True if the token starts with `\n`. ++AZ++: is this meaningful?

compressPreNewLns :: [PosToken] -> [PosToken]Source

Remove the extra preceding empty lines.

compressEndNewLns :: [PosToken] -> [PosToken]Source

Remove the following extra empty lines.

lengthOfLastLine :: [PosToken] -> IntSource

Given a token stream covering multi-lines, calculate the length of the last line AZ: should be the last token start col, plus length of token.

getToks :: (SimpPos, SimpPos) -> [PosToken] -> [PosToken]Source

get a token stream specified by the start and end position.

replaceTokNoReAlign :: [PosToken] -> SimpPos -> PosToken -> [PosToken]Source

Replace a single token in the token stream by a new token, without adjusting the layout. Note1: does not re-align, else other later replacements may fail. Note2: must keep original end col, to know what the inter-token gap was when re-aligning

deleteToks :: [PosToken] -> SimpPos -> SimpPos -> [PosToken]Source

Delete a sequence of tokens specified by the start position and end position from the token stream, then adjust the remaining token stream to preserve layout

doRmWhites :: Int -> [PosToken] -> [PosToken]Source

remove at most n white space tokens from the beginning of ts

srcLocs :: Data t => t -> [SimpPos]Source

get all the source locations (use locations) in an AST phrase t according the the occurrence order of identifiers.

getSrcSpan :: Data t => t -> Maybe SrcSpanSource

Get the first SrcSpan found, in top down traversal

getAllSrcLocs :: Data t => t -> [(SimpPos, SimpPos)]Source

Get all the source locations in a given syntax fragment

extendForwards :: [PosToken] -> (SimpPos, SimpPos) -> (PosToken -> Bool) -> (SimpPos, SimpPos)Source

Extend the given position forwards to the end of the file while the supplied condition holds

extendBackwards :: [PosToken] -> (SimpPos, SimpPos) -> (PosToken -> Bool) -> (SimpPos, SimpPos)Source

Extend the given position backwards to the front of the file while the supplied condition holds

startEndLocIncFowComment :: Data t => [PosToken] -> t -> (SimpPos, SimpPos)Source

Get the start&end location of syntax phrase t, then extend the end location to cover the comment/white spaces or new line which starts in the same line as the end location TODO: deprecate this in favour of startEndLocIncComments

startEndLocIncComments :: Data t => [PosToken] -> t -> (SimpPos, SimpPos)Source

Get the start&end location of t in the token stream, then extend the start and end location to cover the preceding and following comments.

In this routine, 'then','else','do' and 'in' are treated as comments.

tokenise :: RealSrcLoc -> Int -> Bool -> String -> IO [PosToken]Source

Convert a string into a set of Haskell tokens, following the given position, with each line indented by a given column offset if required TODO: replace 'colOffset withFirstLineIndent' with a Maybe Int ++AZ++

basicTokenise :: String -> IO [PosToken]Source

Convert a string into a set of Haskell tokens. It has default position and offset, since it will be stitched into place in TokenUtils

getLineOffset :: [PosToken] -> SimpPos -> IntSource

Get the start of the line before the pos,

getGhcLoc :: SrcSpan -> (Int, Int)Source

gets the (row,col) of the start of the GHC.SrcSpan, or (-1,-1) if there is an GHC.UnhelpfulSpan

getGhcLocEnd :: SrcSpan -> (Int, Int)Source

gets the (row,col) of the end of the GHC.SrcSpan, or (-1,-1) if there is an GHC.UnhelpfulSpan

splitToks :: (SimpPos, SimpPos) -> [PosToken] -> ([PosToken], [PosToken], [PosToken])Source

Split the token stream into three parts: the tokens before the startPos, the tokens between startPos and endPos, and the tokens after endPos. Note: The startPos and endPos refer to the startPos of a token only. So a single token will have the same startPos and endPos NO^^^^

emptyList :: [t] -> BoolSource

Get around lack of instance Eq when simply testing for empty list

divideComments :: Int -> Int -> [PosToken] -> ([PosToken], [PosToken])Source

Split a set of comment tokens into the ones that belong with the startLine and those that belong with the endLine

getIndentOffset :: [PosToken] -> SimpPos -> IntSource

Get the indent of the line before, taking into account in-line 'where', 'let', 'in' and 'do' tokens

monotonicLineToks :: [PosToken] -> [PosToken]Source

sort out line numbering so that they are always monotonically increasing.

reSequenceToks :: [PosToken] -> [PosToken]Source

Adjust token stream to cater for changes in token length due to token renaming

mkToken :: Token -> SimpPos -> String -> PosTokenSource

Compose a new token using the given arguments.

markToken :: PosToken -> PosTokenSource

Mark a token so that it can be use to trigger layout checking later when the toks are retrieved

isMarked :: PosToken -> BoolSource

Does a token have the file mark in it

addOffsetToToks :: SimpPos -> [PosToken] -> [PosToken]Source

Add a constant line and column offset to a span of tokens

matchTokenPos :: PosToken -> PosToken -> PosTokenSource

Transfer the location information from the first param to the second

from TypeSyn

ghead :: String -> [a] -> aSource

glast :: String -> [a] -> aSource

gtail :: String -> [a] -> [a]Source

gfromJust :: [Char] -> Maybe a -> aSource

from TypeUtils

Program Analysis

Imports and exports

inScopeInfoSource

Arguments

:: InScopes

The inscope relation .

-> [(String, NameSpace, ModuleName, Maybe ModuleName)]

The result

Process the inscope relation returned from the parsing and module analysis pass, and return a list of four-element tuples. Each tuple contains an identifier name, the identifier's namespace info, the identifier's defining module name and its qualifier name.

The same identifier may have multiple entries in the result because it may have different qualifiers. This makes it easier to decide whether the identifier can be used unqualifiedly by just checking whether there is an entry for it with the qualifier field being Nothing.

isInScopeAndUnqualifiedSource

Arguments

:: String

The identifier name.

-> InScopes

The inscope relation

-> Bool

The result.

Return True if the identifier is inscope and can be used without a qualifier.

isInScopeAndUnqualifiedGhcSource

Arguments

:: String

The identifier name.

-> Maybe Name

Existing name, to be excluded from test, if known

-> RefactGhc Bool

The result.

Return True if the identifier is inscope and can be used without a qualifier. The identifier name string may have a qualifier already NOTE: may require qualification based on name clash with an existing identifier.

inScopeNamesSource

Arguments

:: String

The identifier name.

-> RefactGhc [Name]

The result.

isExported :: Name -> RefactGhc BoolSource

Return True if an identifier is exported by the module currently being refactored.

isExplicitlyExportedSource

Arguments

:: Name

The identifier

-> RenamedSource

The AST of the module

-> Bool

The result

Return True if an identifier is explicitly exported by the module.

modIsExportedSource

Arguments

:: ModuleName

The module name

-> RenamedSource

The AST of the module

-> Bool

The result

Return True if the current module is exported either by default or by specifying the module name in the export.

Variable analysis

isFieldName :: Name -> BoolSource

True if the name is a field name

isClassName :: Name -> BoolSource

True if the name is a field name

isInstanceName :: Name -> BoolSource

True if the name is a class instance

hsPNs :: Data t => t -> [PName]Source

Collect the identifiers (in PName format) in a given syntax phrase.

class Data t => HsValBinds t whereSource

Methods

hsValBinds :: t -> HsValBinds NameSource

Return the binds that are directly enclosed in the given syntax phrase. hsValBinds :: t -> [GHC.LHsBind GHC.Name]

replaceValBinds :: t -> HsValBinds Name -> tSource

Replace the directly enclosed bind list by the given bind list. Note: This function does not modify the token stream. replaceBinds :: t -> [GHC.LHsBind GHC.Name] -> t

hsTyDecls :: t -> [[LTyClDecl Name]]Source

Return True if the specified identifier is declared in the given syntax phrase. isDeclaredIn :: GHC.Name -> t -> Bool

Return the type class definitions that are directly enclosed in the given syntax phrase. Note: only makes sense for GHC.RenamedSource

hsFreeAndDeclaredPNsOld :: Data t => t -> ([Name], [Name])Source

Collect the free and declared variables (in the GHC.Name format) in a given syntax phrase t. In the result, the first list contains the free variables, and the second list contains the declared variables. Expects RenamedSource

hsFreeAndDeclaredNameStrings :: (Data t, Outputable t) => t -> RefactGhc ([String], [String])Source

The same as hsFreeAndDeclaredPNs except that the returned variables are in the String format.

hsFreeAndDeclaredGhc :: (Data t, Outputable t) => t -> RefactGhc (FreeNames, DeclaredNames)Source

Collect the free and declared variables (in the GHC.Name format) in a given syntax phrase t. In the result, the first list contains the free variables, and the second list contains the declared variables. TODO: use GHC.NameSet instead of lists for FreeNames/DeclaredNames NOTE: The GHC fvs fields only carry non-GHC values, as they are used in the renaming process

getFvs :: [LHsBind Name] -> [([Name], NameSet)]Source

Experiment with GHC fvs stuff

hsVisiblePNs :: (FindEntity e, Data e, Data t, HsValBinds t, Outputable e) => e -> t -> RefactGhc [Name]Source

Given syntax phrases e and t, if e occurs in t, then return those variables which are declared in t and accessible to e, otherwise return [].

hsVisibleNames :: (FindEntity t1, Data t1, Data t2, HsValBinds t2, Outputable t1) => t1 -> t2 -> RefactGhc [String]Source

Same as hsVisiblePNs except that the returned identifiers are in String format.

hsFDsFromInside :: Data t => t -> RefactGhc ([Name], [Name])Source

hsFDsFromInside is different from hsFreeAndDeclaredPNs in that: given an syntax phrase t, hsFDsFromInside returns not only the declared variables that are visible from outside of t, but also those declared variables that are visible to the main expression inside t. NOTE: Expects to be given RenamedSource

hsFDNamesFromInside :: Data t => t -> RefactGhc ([String], [String])Source

The same as hsFDsFromInside except that the returned variables are in the String format

hsVisibleDs :: (FindEntity e, Data e, Data t, HsValBinds t, Outputable e) => e -> t -> RefactGhc DeclaredNamesSource

Given syntax phrases e and t, if e occurs in t, then return those variables which are declared in t and accessible to e, otherwise return [].

Property checking

isVarId :: String -> BoolSource

Return True if a string is a lexically valid variable name.

isConId :: String -> BoolSource

Return True if a string is a lexically valid constructor name.

isOperator :: String -> BoolSource

Return True if a string is a lexically valid operator name.

isTopLevelPN :: Name -> RefactGhc BoolSource

Return True if a PName is a toplevel PName.

isLocalPN :: Name -> BoolSource

Return True if a PName is a local PName.

isNonLibraryName :: Name -> BoolSource

Return True if the name has a GHC.SrcSpan, i.e. is declared in source we care about

isQualifiedPN :: Name -> RefactGhc BoolSource

Return True if a PName is a qualified PName. AZ:NOTE: this tests the use instance, the underlying name may be qualified. e.g. used name is zip, GHC.List.zip NOTE2: not sure if this gives a meaningful result for a GHC.Name

isFunOrPatName :: Data t => Name -> t -> BoolSource

Return True if a PName is a function/pattern name defined in t.

isTypeSig :: Located (Sig a) -> BoolSource

Return True if a declaration is a type signature declaration.

isFunBindP :: HsDeclP -> BoolSource

Return True if a declaration is a function definition.

isPatBindP :: HsDeclP -> BoolSource

Returns True if a declaration is a pattern binding.

isSimplePatBind :: Data t => LHsBind t -> BoolSource

Return True if a declaration is a pattern binding which only defines a variable value.

isComplexPatBind :: LHsBind Name -> BoolSource

Return True if a declaration is a pattern binding but not a simple one.

isFunOrPatBindP :: HsDeclP -> BoolSource

Return True if a declaration is a function/pattern definition.

isFunOrPatBindR :: LHsBind t -> BoolSource

Return True if a declaration is a function/pattern definition.

usedWithoutQualR :: Data t => Name -> t -> BoolSource

Return True if the identifier is unqualifiedly used in the given syntax phrase. usedWithoutQualR :: GHC.Name -> GHC.ParsedSource -> Bool

isUsedInRhs :: Data t => Located Name -> t -> BoolSource

Return True if the identifier is used in the RHS if a function/pattern binding.

findPNT :: Data t => Located Name -> t -> BoolSource

Return True if the identifier occurs in the given syntax phrase.

findPN :: Data t => Name -> t -> BoolSource

Return True if the identifier occurs in the given syntax phrase.

findAllNameOccurences :: Data t => Name -> t -> [Located Name]Source

Find all occurrences with location of the given name

findPNs :: Data t => [Name] -> t -> BoolSource

Return True if any of the specified PNames ocuur in the given syntax phrase.

findEntity :: (FindEntity a, Data b, Typeable b) => a -> b -> BoolSource

Returns True is a syntax phrase, say a, is part of another syntax phrase, say b. NOTE: very important: only do a shallow check

findEntity' :: (Data a, Data b) => a -> b -> Maybe (SimpPos, SimpPos)Source

sameOccurrence :: Located t -> Located t -> BoolSource

Return True if syntax phrases t1 and t2 refer to the same one.

findIdForName :: Name -> RefactGhc (Maybe Id)Source

Return the type checked Id corresponding to the given Name

defines :: Name -> LHsBind Name -> BoolSource

Return True if the function/pattern binding defines the specified identifier.

definesTypeSig :: Name -> LSig Name -> BoolSource

Return True if the declaration defines the type signature of the specified identifier.

class Data t => UsedByRhs t whereSource

Methods

usedByRhs :: t -> [Name] -> BoolSource

Return True if any of the GHC.Name's appear in the given syntax element

Modules and files

Locations

defineLoc :: Located Name -> SrcLocSource

Return the identifier's defining location. defineLoc::PNT->SrcLoc

useLoc :: Located Name -> SrcLocSource

Return the identifier's source location. useLoc::PNT->SrcLoc

locToExpSource

Arguments

:: (Data t, Typeable n) 
=> SimpPos

The start position.

-> SimpPos

The end position.

-> t

The syntax phrase.

-> Maybe (Located (HsExpr n))

The result.

Given the syntax phrase, find the largest-leftmost expression contained in the region specified by the start and end position, if found.

locToNameSource

Arguments

:: Data t 
=> SimpPos

The row and column number

-> t

The syntax phrase

-> Maybe (Located Name)

The result

Find the identifier(in GHC.Name format) whose start position is (row,col) in the file specified by the fileName, and returns Nothing if such an identifier does not exist.

locToRdrNameSource

Arguments

:: Data t 
=> SimpPos

The row and column number

-> t

The syntax phrase

-> Maybe (Located RdrName)

The result

Find the identifier(in GHC.RdrName format) whose start position is (row,col) in the file specified by the fileName, and returns Nothing if such an identifier does not exist.

getNameSource

Arguments

:: Data t 
=> String

The name to find

-> t

The syntax phrase

-> Maybe Name

The result

Find the identifier with the given name. This looks through the given syntax phrase for the first GHC.Name which matches. Because it is Renamed source, the GHC.Name will include its defining location. Returns Nothing if the name is not found.

Program transformation

Adding

addDeclSource

Arguments

:: (Data t, HsValBinds t) 
=> t

The AST to be updated

-> Maybe Name

If this is Just, then the declaration will be added right after this identifier's definition.

-> (LHsBind Name, [LSig Name], Maybe [PosToken])

The declaration with optional signatures to be added, in both AST and Token stream format (optional). If signature and tokens provided, the tokens should include the signature too

-> Bool

True means the declaration is a toplevel declaration.

-> RefactGhc t 

Adding a declaration to the declaration list of the given syntax phrase. If the second argument is Nothing, then the declaration will be added to the beginning of the declaration list, but after the data type declarations is there is any.

addItemsToImportSource

Arguments

:: ModuleName

The imported module name

-> RenamedSource

The current module

-> [Name]

The items to be added ->Maybe GHC.Name -- ^ The condition identifier.

-> RefactGhc RenamedSource

The result (with token stream updated)

Add identifiers (given by the third argument) to the explicit entity list in the declaration importing the specified module name. This function does nothing if the import declaration does not have an explicit entity list.

addHidingSource

Arguments

:: ModuleName

The imported module name

-> RenamedSource

The current module

-> [Name]

The items to be added

-> RefactGhc RenamedSource

The result (with token stream updated)

add items to the hiding list of an import declaration which imports the specified module.

addParamsToDeclsSource

Arguments

:: [LHsBind Name]

A declaration list where the function is defined and/or used.

-> Name

The function name.

-> [Name]

The parameters to be added.

-> Bool

Modify the token stream or not.

-> RefactGhc [LHsBind Name]

The result.

addImportDeclSource

Arguments

:: RenamedSource 
-> ModuleName 
-> Maybe FastString

qualifier

-> Bool 
-> Bool 
-> Bool 
-> Maybe String

alias

-> Bool 
-> [Name] 
-> RefactGhc RenamedSource 

Add identifiers to the export list of a module. If the second argument is like: Just p, then do the adding only if p occurs in the export list, and the new identifiers are added right after p in the export list. Otherwise the new identifiers are add to the beginning of the export list. In the case that the export list is emport, then if the third argument is True, then create an explict export list to contain only the new identifiers, otherwise do nothing.

duplicateDeclSource

Arguments

:: Data t 
=> [LHsBind Name]

The declaration list

-> t

Any signatures are in here

-> Name

The identifier whose definition is to be duplicated

-> Name

The new name (possibly qualified)

-> RefactGhc [LHsBind Name]

The result

Remove those specified items from the entity list in the import declaration.

Remove the specified entities from the module's exports. The entities can be specified in either of two formats: i.e. either specify the module names and identifier names to be removed, so just given the exact AST for these entities.

Duplicate a function/pattern binding declaration under a new name right after the original one. Also updates the token stream.

Removing

rmDeclSource

Arguments

:: Data t 
=> Name

The identifier whose definition is to be removed.

-> Bool

True means including the type signature.

-> t

The AST fragment containting the declarations

-> RefactGhc (t, LHsBind Name, Maybe (LSig Name))

The result and the removed declaration, with SrcSpans adjusted to reflect the stashed tokens and the possibly removed siganture

Remove the declaration (and the type signature is the second parameter is True) that defines the given identifier from the declaration list.

rmTypeSigSource

Arguments

:: Data t 
=> Name

The identifier whose type signature is to be removed.

-> t

The declarations

-> RefactGhc (t, Maybe (LSig Name))

The result and removed signature, if there was one

Remove the type signature that defines the given identifier's type from the declaration list.

rmTypeSigsSource

Arguments

:: Data t 
=> [Name]

The identifiers whose type signatures are to be removed.

-> t

The declarations

-> RefactGhc (t, [LSig Name])

The result and removed signatures, if there were any

Remove multiple type signatures

Updating

rmQualifierSource

Arguments

:: Data t 
=> [Name]

The identifiers.

-> t

The syntax phrase.

-> RefactGhc t

The result.

Remove the qualifier from the given identifiers in the given syntax phrase.

qualifyToplevelName :: Name -> RefactGhc ()Source

Replace all occurences of a top level GHC.Name with a qualified version.

renamePNSource

Arguments

:: Data t 
=> Name

The identifier to be renamed.

-> Name

The new name, including possible qualifier

-> Bool

True means modifying the token stream as well.

-> Bool

True means use the qualified form for the new name.

-> t

The syntax phrase

-> RefactGhc t 

Rename each occurrences of the identifier in the given syntax phrase with the new name. If the Bool parameter is True, then modify both the AST and the token stream, otherwise only modify the AST. TODO: the syntax phrase is required to be GHC.Located, not sure how to specify this without breaking the everywhereMStaged call

autoRenameLocalVarSource

Arguments

:: HsValBinds t 
=> Bool

True means modfiying the token stream as well.

-> Name

The identifier.

-> t

The syntax phrase.

-> RefactGhc t

The result.

Check whether the specified identifier is declared in the given syntax phrase t, if so, rename the identifier by creating a new name automatically. If the Bool parameter is True, the token stream will be modified, otherwise only the AST is modified.

Miscellous

Parsing, writing and showing

showEntities :: (t -> String) -> [t] -> StringSource

Show a list of entities, the parameter f is a function that specifies how to format an entity.

showPNwithLoc :: Located Name -> StringSource

Show a PName in a format like: pn(at row:r, col: c).

Locations

Default values

defaultExp :: HsExpPSource

Default expression.

Identifiers, expressions, patterns and declarations

expToName :: Located (HsExpr Name) -> NameSource

If an expression consists of only one identifier then return this identifier in the GHC.Name format, otherwise return the default Name

patToPNT :: LPat Name -> Maybe NameSource

If a pattern consists of only one identifier then return this identifier, otherwise return Nothing

pNtoPat :: Name -> Pat NameSource

Compose a pattern from a pName.

definedPNs :: LHsBind Name -> [Name]Source

Return the list of identifiers (in PName format) defined by a function/pattern binding.

definingDeclsNamesSource

Arguments

:: [Name]

The specified identifiers.

-> [LHsBind Name]

A collection of declarations.

-> Bool

True means to include the type signature.

-> Bool

True means to look at the local declarations as well.

-> [LHsBind Name]

The result.

Find those declarations(function/pattern binding) which define the specified GHC.Names. incTypeSig indicates whether the corresponding type signature will be included.

definingDeclsNames'Source

Arguments

:: Data t 
=> [Name]

The specified identifiers.

-> t

A collection of declarations.

-> [LHsBind Name]

The result.

Find those declarations(function/pattern binding) which define the specified GHC.Names. incTypeSig indicates whether the corresponding type signature will be included.

definingSigsNamesSource

Arguments

:: Data t 
=> [Name]

The specified identifiers.

-> t

A collection of declarations.

-> [LSig Name]

The result.

Find those type signatures for the specified GHC.Names.

definingTyClDeclsNamesSource

Arguments

:: Data t 
=> [Name]

The specified identifiers.

-> t

A collection of declarations.

-> [LTyClDecl Name]

The result.

Find those declarations which define the specified GHC.Names.

allNamesSource

Arguments

:: Data t 
=> t

The syntax phrase

-> [Located Name]

The result

Find all Located Names in the given Syntax phrase.

Others

mkNewGhcName :: Maybe Module -> String -> RefactGhc NameSource

Make a new GHC.Name, using the Unique Int sequence stored in the RefactState.

mkNewNameSource

Arguments

:: String

The old name

-> [String]

The set of names which the new name cannot take

-> Int

The posfix value

-> String

The result

Create a new name base on the old name. Suppose the old name is f, then the new name would be like f_i where i is an integer.

causeNameClashInExportsSource

Arguments

:: Name

The original name

-> Name

The new name

-> ModuleName

The identity of the module

-> RenamedSource

The AST of the module

-> Bool

The result

Check if the proposed new name will conflict with an existing export

removeOffset :: Int -> [PosToken] -> [PosToken]Source

Remove at most offset whitespaces from each line in the tokens

Typed AST traversals (added by CMB)

Miscellous

Debug stuff

getSigAndToks :: Data t => Name -> t -> [PosToken] -> Maybe (LSig Name, [PosToken])Source

Get the signature and tokens for a declaration

removeToksOffset :: [PosToken] -> [PosToken]Source

Normalise a set of tokens to start at the offset of the first one

getParsedForRenamedLPat :: ParsedSource -> LPat Name -> LPat RdrNameSource

Given a RenamedSource LPAT, return the equivalent ParsedSource part. NOTE: returns pristine ParsedSource, since HaRe does not change it

getParsedForRenamedName :: ParsedSource -> Located Name -> Located RdrNameSource

Given a RenamedSource Located name, return the equivalent ParsedSource part. NOTE: returns pristine ParsedSource, since HaRe does not change it

getParsedForRenamedLocated :: Typeable b => Located a -> RefactGhc (Located b)Source

Given a RenamedSource Located name, return the equivalent ParsedSource part. NOTE: returns pristine ParsedSource, since HaRe does not change it

newNameTok :: Bool -> SrcSpan -> Name -> PosTokenSource

Create a new name token. If useQual then use the qualified name, if it exists. The end position is not changed, so the eventual realignment can know what the difference in length in the token is

stripLeadingSpaces :: [String] -> [String]Source

Take a list of strings and return a list with the longest prefix of spaces removed

from GhcUtils

SYB versions

everythingButStaged :: Stage -> (r -> r -> r) -> r -> GenericQ (r, Bool) -> GenericQ rSource

somethingStaged :: Stage -> Maybe u -> GenericQ (Maybe u) -> GenericQ (Maybe u)Source

Look up a subterm by means of a maybe-typed filter

everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ rSource

Staged variation of SYB.everything The stage must be provided to avoid trying to modify elements which may not be present at all stages of AST processing. Note: Top-down order

somewhereMStaged :: MonadPlus m => Stage -> GenericM m -> GenericM mSource

Apply a monadic transformation at least somewhere

somewhereMStagedBu :: MonadPlus m => Stage -> GenericM m -> GenericM mSource

Apply a monadic transformation at least somewhere, in bottom up order

everywhereMStaged :: Monad m => Stage -> GenericM m -> GenericM mSource

Monadic variation on everywhere

everywhereMStaged' :: Monad m => Stage -> GenericM m -> GenericM mSource

Monadic variation on everywhere'

everywhereStaged :: Stage -> (forall a. Data a => a -> a) -> forall a. Data a => a -> aSource

Bottom-up transformation

everywhereStaged' :: Stage -> (forall a. Data a => a -> a) -> forall a. Data a => a -> aSource

Top-down version of everywhereStaged

onelayerStaged :: Stage -> r -> GenericQ r -> GenericQ [r]Source

Perform a query on the immediate subterms only, avoiding holes

listifyStaged :: (Data a, Typeable a1) => Stage -> (a1 -> Bool) -> a -> [a1]Source

Staged variation of SYB.listify The stage must be provided to avoid trying to modify elements which may not be present at all stages of AST processing.

SYB Utility

Strafunski StrategyLib versions

full_tdTUGhc :: (MonadPlus m, Monoid a) => TU a m -> TU a mSource

Full type-unifying traversal in top-down order.

stop_tdTUGhc :: (MonadPlus m, Monoid a) => TU a m -> TU a mSource

Top-down type-unifying traversal that is cut of below nodes where the argument strategy succeeds.

stop_tdTPGhc :: MonadPlus m => TP m -> TP mSource

Top-down type-preserving traversal that is cut of below nodes where the argument strategy succeeds.

allTUGhc' :: (MonadPlus m, Monoid a) => TU a m -> TU a mSource

once_tdTPGhc :: MonadPlus m => TP m -> TP mSource

Top-down type-preserving traversal that performs its argument strategy at most once.

once_buTPGhc :: MonadPlus m => TP m -> TP mSource

Bottom-up type-preserving traversal that performs its argument strategy at most once.

oneTPGhc :: MonadPlus m => TP m -> TP mSource

allTUGhc :: MonadPlus m => (a -> a -> a) -> a -> TU a m -> TU a mSource

Strafunski utility

checkItemStage' :: forall m. MonadPlus m => Stage -> TU () mSource

Scrap Your Zipper versions

zeverywhereStaged :: Typeable a => Stage -> GenericT -> Zipper a -> Zipper aSource

Apply a generic transformation everywhere in a bottom-up manner.

zopenStaged :: Typeable a => Stage -> GenericQ Bool -> Zipper a -> [Zipper a]Source

Open a zipper to the point where the Geneneric query passes. returns the original zipper if the query does not pass (check this)

zsomewhereStaged :: MonadPlus m => Stage -> GenericM m -> Zipper a -> m (Zipper a)Source

Apply a generic monadic transformation once at the topmost leftmost successful location, avoiding holes in the GHC structures

transZ :: Stage -> GenericQ Bool -> (Stage -> Zipper a -> Zipper a) -> Zipper a -> Zipper aSource

Transform a zipper opened with a given generic query

transZM :: Monad m => Stage -> GenericQ Bool -> (Stage -> Zipper a -> m (Zipper a)) -> Zipper a -> m (Zipper a)Source

Monadic transform of a zipper opened with a given generic query

zopenStaged' :: Typeable a => Stage -> GenericQ (Maybe b) -> Zipper a -> [(Zipper a, b)]Source

Open a zipper to the point where the Generic query passes, returning the zipper and a value from the specific part of the GenericQ that matched. This allows the components of the query to return a specific transformation routine, to apply to the returned zipper

ztransformStagedM :: (Typeable a, Monad m) => Stage -> GenericQ (Maybe (Stage -> Zipper a -> m (Zipper a))) -> Zipper a -> m (Zipper a)Source

Open a zipper to the point where the Generic query passes, and apply the transformation returned from the specific part of the GenericQ that matched.

SYZ utilities

upUntil :: GenericQ Bool -> Zipper a -> Maybe (Zipper a)Source

Climb the tree until a predicate holds

findAbove :: Data a => (a -> Bool) -> Zipper a -> Maybe aSource

Up the zipper until a predicate holds, and then return the zipper hole

from GhcVersionSpecific

showGhc :: Outputable a => a -> StringSource

Show a GHC API structure

from TokenUtils

data Positioning Source

How new SrcSpans should be inserted in the Token tree, relative to the prior span

Constructors

PlaceAdjacent

Only a single space between the end of the prior span and the new one

PlaceAbsolute !Int !Int

Start at the specified line and col

PlaceAbsCol !Int !Int !Int

Line offset and absolute Col. Mainly for forcing start at left margin, number of lines to add at the end

PlaceOffset !Int !Int !Int

Line and Col offset for start, num lines to add at the end relative to the indent level of the prior span

PlaceIndent !Int !Int !Int

Line and Col offset for start, num lines to add at the end relative to the indent level of the prior line

Instances