nix-lang-0.1.0.0: src/Nix/Lang/ExactPrint/Prepare/Repair.hs
-- | Recursive repair engine for exact-print normalization.
--
-- After an edit changes tree shape, this module recalculates spans, token
-- deltas, and related annotations so the tree can be rendered again.
module Nix.Lang.ExactPrint.Prepare.Repair
( repairExprLayout,
repairBindingLayout,
repairAttrPathLayout,
repairFuncPatLayout,
)
where
import Control.Monad (foldM)
import Control.Monad.Reader (ReaderT (..), ask, local, runReaderT)
import Data.Text (Text)
import qualified Data.Text as T
import Nix.Lang.Annotation
import Nix.Lang.ExactPrint.Prepare.Rebuild
import Nix.Lang.ExactPrint.Prepare.Types
import Nix.Lang.ExactPrint.Prepare.Utils
import Nix.Lang.ExactPrint.Operations
import Nix.Lang.Outputable (renderToText)
import Nix.Lang.Span
import Nix.Lang.Types
import Nix.Lang.Types.Ps
import Nix.Lang.Utils
--------------------------------------------------------------------------------
newtype RepairContext = RepairContext
{ repairCursor :: RenderCursor
}
type RepairM = ReaderT RepairContext EPResult
--------------------------------------------------------------------------------
runRepairAt :: RenderCursor -> RepairM a -> EPResult a
runRepairAt cursor = flip runReaderT (RepairContext cursor)
withRepairCursor :: RenderCursor -> RepairM a -> RepairM a
withRepairCursor cursor = local (\ctx -> ctx {repairCursor = cursor})
currentRepairCursor :: RepairM RenderCursor
currentRepairCursor = repairCursor <$> ask
--------------------------------------------------------------------------------
repairExprLayout :: Expr -> EPResult Expr
repairExprLayout = repairLocatedLayout exprSpan repairExpr
repairBindingLayout :: Binding -> EPResult Binding
repairBindingLayout = repairLocatedLayout bindingSpan repairBinding
repairAttrPathLayout :: AttrPath -> EPResult AttrPath
repairAttrPathLayout = repairLocatedLayout attrPathSpan repairAttrPath
repairFuncPatLayout :: FuncPat -> EPResult FuncPat
repairFuncPatLayout = repairLocatedLayout funcPatBodySpan repairFuncPat
--------------------------------------------------------------------------------
repairLocatedLayout :: (a -> SrcSpan) -> (Located a -> RepairM (Located a)) -> a -> EPResult a
repairLocatedLayout spanOf repair value =
unLoc <$> runRepairAt (spanStartCursor span') (repair (L span' value))
where
span' = spanOf value
--------------------------------------------------------------------------------
-- | Repair an expression subtree starting from the current repair cursor.
repairExpr :: LExpr -> RepairM LExpr
repairExpr (L originalSpan node) =
case node of
NixVar ann ident -> pure (repairVarExpr originalSpan ann ident)
NixLit ann lit -> pure (repairLit originalSpan ann lit)
NixPar ann inner -> repairPar originalSpan ann inner
NixString ann str -> pure (repairStringExpr originalSpan ann str)
NixPath ann path -> pure (repairPathExpr originalSpan ann path)
NixEnvPath ann path -> pure (repairEnvPath originalSpan ann path)
NixLam ann pat body -> repairLam originalSpan ann pat body
NixApp ann lhs rhs -> repairApp originalSpan ann lhs rhs
NixBinApp ann op lhs rhs -> repairBinApp originalSpan ann op lhs rhs
NixNotApp ann inner -> repairPrefix originalSpan ann NixNotApp inner
NixNegApp ann inner -> repairPrefix originalSpan ann NixNegApp inner
NixList ann xs -> repairList ann xs
NixSet ann kind (L _ bindings) -> repairSet ann kind bindings
NixLet ann (L _ bindings) body -> repairLet ann bindings body
NixHasAttr ann lhs path -> repairHasAttr originalSpan ann lhs path
NixSelect ann lhs path def -> repairSelect originalSpan ann lhs path def
NixIf ann cond thenExpr elseExpr -> repairIf originalSpan ann cond thenExpr elseExpr
NixWith ann scope body -> repairWith originalSpan ann scope body
NixAssert ann assertion body -> repairAssert originalSpan ann assertion body
repairExprAt :: RenderCursor -> LExpr -> RepairM LExpr
repairExprAt cursor expr = withRepairCursor cursor (repairExpr translated)
where
translated = translateFromTo (getLoc expr) (cursorSpan cursor (srcSpanFilename (getLoc expr))) expr
repairChildAfter :: SrcSpan -> SrcSpan -> SrcSpan -> LExpr -> RepairM LExpr
repairChildAfter oldAnchor oldTarget newAnchor child =
repairExprAt (preserveGapTarget oldAnchor oldTarget newAnchor) child
--------------------------------------------------------------------------------
repairVarExpr :: SrcSpan -> AnnCommon -> LVarName -> LExpr
repairVarExpr originalSpan ann ident =
let ident' = repairLocatedTextAt (spanStartCursor originalSpan) ident
span' = getLoc ident'
ann' = setAnnSpan span' ann
in L span' (NixVar ann' ident')
--------------------------------------------------------------------------------
repairLit :: SrcSpan -> AnnCommon -> LLit -> LExpr
repairLit originalSpan ann lit =
let lit' = repairLocatedLitAt (spanStartCursor originalSpan) lit
span' = getLoc lit'
ann' = setAnnSpan span' ann
in L span' (NixLit ann' lit')
--------------------------------------------------------------------------------
repairStringExpr :: SrcSpan -> AnnStringNode -> LNString -> LExpr
repairStringExpr originalSpan ann str =
let str' = repairLocatedStringAt (spanStartCursor originalSpan) str
span' = getLoc str'
ann' = setAnnSpan span' ann
in L span' (NixString ann' str')
--------------------------------------------------------------------------------
repairPathExpr :: SrcSpan -> AnnPathNode -> LPath -> LExpr
repairPathExpr originalSpan ann path =
let path' = repairLocatedPathAt (spanStartCursor originalSpan) path
span' = getLoc path'
ann' = setAnnSpan span' ann
in L span' (NixPath ann' path')
--------------------------------------------------------------------------------
repairPar :: SrcSpan -> AnnParNode -> LExpr -> RepairM LExpr
repairPar originalSpan ann inner = do
let openSpan = tokenSpanAt (spanStartCursor originalSpan) (apnOpenP ann)
inner' <- repairChildAfter (expectTokenSpan "paren open" (apnOpenP ann)) (getLoc inner) openSpan inner
let closeSpan = preserveGapSpan (getLoc inner) (tokenSpanFromAnchor "paren close" (getLoc inner') (apnCloseP ann)) inner'
ann0 = ann {apnOpenP = (apnOpenP ann) {annTokenPos = AnnSpan openSpan}, apnCloseP = (apnCloseP ann) {annTokenPos = AnnSpan closeSpan}}
ann' = setAnnSpan (openSpan `combineSrcSpans` closeSpan) (prepareParLayout ann0 (unLoc inner'))
expr' = NixPar ann' inner'
pure (L (exprSpan expr') expr')
--------------------------------------------------------------------------------
repairEnvPath :: SrcSpan -> AnnEnvPathNode -> Located Text -> LExpr
repairEnvPath _ ann path =
let openSpan = expectTokenSpan "env path open" (aenvOpen ann)
path' = repairLocatedTextAt (spanStartCursor (preserveGapSpan openSpan (getLoc path) (L openSpan ()))) path
closeSpan = preserveGapSpan (getLoc path) (expectTokenSpan "env path close" (aenvClose ann)) path'
ann' = setAnnSpan (openSpan `combineSrcSpans` closeSpan) ann {aenvClose = (aenvClose ann) {annTokenPos = AnnSpan closeSpan}}
span' = openSpan `combineSrcSpans` closeSpan
in L span' (NixEnvPath ann' path')
--------------------------------------------------------------------------------
repairLam :: SrcSpan -> AnnLamNode -> LFuncPat -> LExpr -> RepairM LExpr
repairLam originalSpan ann pat body = do
pat' <- repairFuncPatAt (spanStartCursor originalSpan) pat
let colonSpan = preserveGapSpan (funcPatRenderSpan (unLoc pat)) (expectTokenSpan "lambda colon" (alamColon ann)) pat'
body' <- repairChildAfter (expectTokenSpan "lambda colon" (alamColon ann)) (getLoc body) colonSpan body
let span' = funcPatRenderSpan (unLoc pat') `combineSrcSpans` getLoc body'
ann' = setAnnSpan span' ann {alamColon = (alamColon ann) {annTokenPos = AnnSpan colonSpan}}
pure (L span' (NixLam ann' pat' body'))
--------------------------------------------------------------------------------
repairApp :: SrcSpan -> AnnAppNode -> LExpr -> LExpr -> RepairM LExpr
repairApp originalSpan ann lhs rhs = do
lhs' <- repairExprAt (spanStartCursor originalSpan) lhs
rhs' <- repairChildAfter (getLoc lhs) (getLoc rhs) (getLoc lhs') rhs
let span' = getLoc lhs' `combineSrcSpans` getLoc rhs'
ann' = setAnnSpan span' ann
pure (L span' (NixApp ann' lhs' rhs'))
--------------------------------------------------------------------------------
repairBinApp :: SrcSpan -> AnnBinAppNode -> BinaryOp -> LExpr -> LExpr -> RepairM LExpr
repairBinApp originalSpan ann op lhs rhs = do
lhs' <- repairExprAt (spanStartCursor originalSpan) lhs
let opSpan = preserveGapSpan (getLoc lhs) (expectTokenSpan "binary operator" (abinOperator ann)) lhs'
rhs' <- repairChildAfter (expectTokenSpan "binary operator" (abinOperator ann)) (getLoc rhs) opSpan rhs
let span' = getLoc lhs' `combineSrcSpans` getLoc rhs'
ann' = setAnnSpan span' ann {abinOperator = (abinOperator ann) {annTokenPos = AnnSpan opSpan}}
pure (L span' (NixBinApp ann' op lhs' rhs'))
--------------------------------------------------------------------------------
repairPrefix :: SrcSpan -> AnnPrefixNode -> (AnnPrefixNode -> LExpr -> Expr) -> LExpr -> RepairM LExpr
repairPrefix originalSpan ann mkNode inner = do
let tokSpan = tokenSpanAt (spanStartCursor originalSpan) (apfxToken ann)
inner' <- repairChildAfter (expectTokenSpan "prefix operator" (apfxToken ann)) (getLoc inner) tokSpan inner
let span' = tokSpan `combineSrcSpans` getLoc inner'
ann' = setAnnSpan span' ann {apfxToken = (apfxToken ann) {annTokenPos = AnnSpan tokSpan}}
pure (L span' (mkNode ann' inner'))
--------------------------------------------------------------------------------
repairList :: AnnListNode -> [LExpr] -> RepairM LExpr
repairList ann xs = do
xs' <- mapM repairExpr xs
repaired <- liftEPResult (rebuildListLayout ann xs')
pure (L (exprSpan repaired) repaired)
--------------------------------------------------------------------------------
repairSet :: AnnSet -> NixSetIsRecursive -> [LBinding] -> RepairM LExpr
repairSet ann kind bindings = do
bindings' <- mapM repairBinding bindings
repaired <- liftEPResult (rebuildSetLayout ann kind bindings')
pure (L (exprSpan repaired) repaired)
--------------------------------------------------------------------------------
repairLet :: AnnLetNode -> [LBinding] -> LExpr -> RepairM LExpr
repairLet ann bindings body = do
-- repair bindings
bindings' <- mapM repairBinding bindings
-- rebuild let to discover new in
provisional <- liftEPResult (rebuildLetLayout ann bindings' body)
let newInSpan = case provisional of
NixLet ann' _ _ -> expectTokenSpan "in keyword" (alIn ann')
_ -> error "impossible: rebuildLetLayout did not return let"
oldInSpan = expectTokenSpan "in keyword" (alIn ann)
bodyCursor
| srcSpanStartLine (getLoc body) > srcSpanEndLine oldInSpan = RenderCursor (srcSpanEndLine newInSpan + 1) (srcSpanStartColumn (getLoc body))
| otherwise = preserveGapTarget oldInSpan (getLoc body) newInSpan
-- repair body there
body' <- repairExprAt bodyCursor body
-- rebuild let again with the repaired body
repaired <- liftEPResult (rebuildLetLayout ann bindings' body')
pure (L (exprSpan repaired) repaired)
--------------------------------------------------------------------------------
repairHasAttr :: SrcSpan -> AnnHasAttr -> LExpr -> LAttrPath -> RepairM LExpr
repairHasAttr originalSpan ann lhs path = do
lhs' <- repairExprAt (spanStartCursor originalSpan) lhs
let qSpan = preserveGapSpan (getLoc lhs) (expectTokenSpan "has-attr question" (ahaQuestion ann)) lhs'
path' <- repairAttrPathAt (preserveGapTarget (expectTokenSpan "has-attr question" (ahaQuestion ann)) (getLoc path) qSpan) path
let span' = getLoc lhs' `combineSrcSpans` attrPathSpan (unLoc path')
ann' = setAnnSpan span' (prepareHasAttrLayout (ann {ahaQuestion = (ahaQuestion ann) {annTokenPos = AnnSpan qSpan}}) (unLoc lhs') (unLoc path'))
pure (L span' (NixHasAttr ann' lhs' path'))
--------------------------------------------------------------------------------
repairSelect :: SrcSpan -> AnnSelect -> LExpr -> LAttrPath -> Maybe LExpr -> RepairM LExpr
repairSelect originalSpan ann lhs path def = do
-- repair lhs from the original root
lhs' <- repairExprAt (spanStartCursor originalSpan) lhs
-- move path relative to the repaired lhs
path' <- repairAttrPathAt (preserveGapTarget (getLoc lhs) (getLoc path) (getLoc lhs')) path
-- if def exists, repair it relative to the repaired or
def' <- traverse (repairExprAtSelect ann path path') def
-- compute new or span from repaired path
let annWithOr = case (aslOr ann, def, def') of
(Just orTok, Just _, Just _) ->
let orSpan = preserveGapSpan (attrPathRenderSpan (unLoc path)) (expectTokenSpan "select or" orTok) path'
in ann {aslOr = Just (orTok {annTokenPos = AnnSpan orSpan})}
_ -> ann
ann' = setAnnSpan finalSpan (prepareSelectLayout annWithOr (unLoc lhs') (unLoc path') def')
finalSpan = maybe baseSpan (combineSrcSpans baseSpan . getLoc) def'
baseSpan = getLoc lhs' `combineSrcSpans` attrPathSpan (unLoc path')
pure (L finalSpan (NixSelect ann' lhs' path' def'))
--------------------------------------------------------------------------------
repairIf :: SrcSpan -> AnnIfNode -> LExpr -> LExpr -> LExpr -> RepairM LExpr
repairIf originalSpan ann cond thenExpr elseExpr = do
let ifSpan = tokenSpanAt (spanStartCursor originalSpan) (aifIf ann)
cond' <- repairExprAt (preserveGapTarget (expectTokenSpan "if keyword" (aifIf ann)) (getLoc cond) ifSpan) cond
let thenSpan = preserveGapSpan (getLoc cond) (expectTokenSpan "then keyword" (aifThen ann)) cond'
then' <- repairExprAt (preserveGapTarget (expectTokenSpan "then keyword" (aifThen ann)) (getLoc thenExpr) thenSpan) thenExpr
let elseSpan = preserveGapSpan (getLoc thenExpr) (expectTokenSpan "else keyword" (aifElse ann)) then'
else' <- repairExprAt (preserveGapTarget (expectTokenSpan "else keyword" (aifElse ann)) (getLoc elseExpr) elseSpan) elseExpr
let ann0 = ann {aifIf = (aifIf ann) {annTokenPos = AnnSpan ifSpan}, aifThen = (aifThen ann) {annTokenPos = AnnSpan thenSpan}, aifElse = (aifElse ann) {annTokenPos = AnnSpan elseSpan}}
span' = ifSpan `combineSrcSpans` getLoc else'
ann' = setAnnSpan span' (prepareIfLayout ann0 (unLoc cond') (unLoc then') (unLoc else'))
pure (L span' (NixIf ann' cond' then' else'))
--------------------------------------------------------------------------------
repairWith :: SrcSpan -> AnnWithNode -> LExpr -> LExpr -> RepairM LExpr
repairWith originalSpan ann scope body = do
let withSpan = tokenSpanAt (spanStartCursor originalSpan) (awWith ann)
scope' <- repairExprAt (preserveGapTarget (expectTokenSpan "with keyword" (awWith ann)) (getLoc scope) withSpan) scope
let semiSpan = preserveGapSpan (getLoc scope) (expectTokenSpan "with semicolon" (awSemicolon ann)) scope'
body' <- repairExprAt (preserveGapTarget (expectTokenSpan "with semicolon" (awSemicolon ann)) (getLoc body) semiSpan) body
let ann0 = ann {awWith = (awWith ann) {annTokenPos = AnnSpan withSpan}, awSemicolon = (awSemicolon ann) {annTokenPos = AnnSpan semiSpan}}
span' = withSpan `combineSrcSpans` getLoc body'
ann' = setAnnSpan span' (prepareWithLayout ann0 (unLoc scope') (unLoc body'))
pure (L span' (NixWith ann' scope' body'))
--------------------------------------------------------------------------------
repairAssert :: SrcSpan -> AnnAssertNode -> LExpr -> LExpr -> RepairM LExpr
repairAssert originalSpan ann assertion body = do
let assertSpan = tokenSpanAt (spanStartCursor originalSpan) (aaAssert ann)
assertion' <- repairExprAt (preserveGapTarget (expectTokenSpan "assert keyword" (aaAssert ann)) (getLoc assertion) assertSpan) assertion
let semiSpan = preserveGapSpan (getLoc assertion) (expectTokenSpan "assert semicolon" (aaSemicolon ann)) assertion'
body' <- repairExprAt (preserveGapTarget (expectTokenSpan "assert semicolon" (aaSemicolon ann)) (getLoc body) semiSpan) body
let ann0 = ann {aaAssert = (aaAssert ann) {annTokenPos = AnnSpan assertSpan}, aaSemicolon = (aaSemicolon ann) {annTokenPos = AnnSpan semiSpan}}
span' = assertSpan `combineSrcSpans` getLoc body'
ann' = setAnnSpan span' (prepareAssertLayout ann0 (unLoc assertion') (unLoc body'))
pure (L span' (NixAssert ann' assertion' body'))
--------------------------------------------------------------------------------
repairBinding :: LBinding -> RepairM LBinding
repairBinding (L originalSpan node) =
case node of
NixNormalBinding ann path expr -> repairNormalBinding originalSpan ann path expr
NixInheritBinding ann mScope names -> repairInheritBinding originalSpan ann mScope names
repairNormalBinding :: SrcSpan -> AnnNormalBinding -> LAttrPath -> LExpr -> RepairM LBinding
repairNormalBinding originalSpan ann path expr = do
path' <- repairAttrPathAt (spanStartCursor originalSpan) path
let eqSpan = preserveGapSpan (attrPathSpan (unLoc path)) (tokenSpanFromAnchor "binding equals" (attrPathSpan (unLoc path')) (anbEqual ann)) path'
expr' <- repairExprAt (preserveGapTarget (tokenSpanFromAnchor "binding equals" (attrPathSpan (unLoc path')) (anbEqual ann)) (getLoc expr) eqSpan) expr
let semiSpan = preserveGapSpan (getLoc expr) (tokenSpanFromAnchor "binding semicolon" (getLoc expr') (anbSemicolon ann)) expr'
ann' = setAnnSpan span' ann {anbEqual = (anbEqual ann) {annTokenPos = AnnSpan eqSpan}, anbSemicolon = (anbSemicolon ann) {annTokenPos = AnnSpan semiSpan}}
span' = attrPathSpan (unLoc path') `combineSrcSpans` semiSpan
pure (L span' (NixNormalBinding ann' path' expr'))
repairInheritBinding :: SrcSpan -> AnnInheritBinding -> Maybe LExpr -> [LAttrKey] -> RepairM LBinding
repairInheritBinding originalSpan ann mScope names = do
let inheritSpan = tokenSpanAt (spanStartCursor originalSpan) (aibInherit ann)
scope' <- case mScope of
Nothing -> pure Nothing
Just scopeExpr ->
Just
<$> repairExprAt
(preserveGapTarget (expectTokenSpan "inherit keyword" (aibInherit ann)) (getLoc scopeExpr) inheritSpan)
scopeExpr
names' <- repairInheritNames inheritSpan mScope scope' names
let anchorOld = maybe (maybe (expectTokenSpan "inherit keyword" (aibInherit ann)) getLoc (lastMay names)) getLoc mScope
anchorNew = maybe (maybe inheritSpan getLoc (lastMay names')) getLoc scope'
semiSpan = preserveGapSpan anchorOld (expectTokenSpan "inherit semicolon" (aibSemicolon ann)) (L anchorNew ())
span' = foldr combineSrcSpans (inheritSpan `combineSrcSpans` semiSpan) (maybe [] ((: []) . getLoc) scope' <> fmap getLoc names')
ann' = setAnnSpan span' ann {aibInherit = (aibInherit ann) {annTokenPos = AnnSpan inheritSpan}, aibSemicolon = (aibSemicolon ann) {annTokenPos = AnnSpan semiSpan}}
pure (L span' (NixInheritBinding ann' scope' names'))
--------------------------------------------------------------------------------
repairAttrPath :: LAttrPath -> RepairM LAttrPath
repairAttrPath path = repairAttrPathAt (spanStartCursor (getLoc path)) path
repairAttrPathAt :: RenderCursor -> LAttrPath -> RepairM LAttrPath
repairAttrPathAt cursor (L _ (NixAttrPath ann keys)) =
withRepairCursor cursor $
case keys of
[] -> liftEPResult (Left EmptyAttrPathEdit)
firstKey : restKeys -> repairAttrPathHead ann keys firstKey restKeys
repairAttrPathHead :: AnnAttrPath -> [LAttrKey] -> LAttrKey -> [LAttrKey] -> RepairM LAttrPath
repairAttrPathHead ann keys firstKey restKeys = do
cursor <- currentRepairCursor
case (leadingDot, dotTokens) of
(True, firstDot : restDots) -> do
let firstDotSpan = tokenSpanAt cursor firstDot
firstKey' <- repairAttrKeyAt (preserveGapTarget (expectTokenSpan "attr path dot" firstDot) (getLoc firstKey) firstDotSpan) firstKey
(dots', keys') <- repairAttrTail restDots restKeys (getLoc firstKey) firstKey'
let ann' = setAnnSpan span' ann {aapDots = firstDot {annTokenPos = AnnSpan firstDotSpan} : dots'}
span' = firstDotSpan `combineSrcSpans` foldr1 combineSrcSpans (getLoc firstKey' : fmap getLoc keys')
pure (L span' (NixAttrPath ann' (firstKey' : keys')))
_ -> do
firstKey' <- repairAttrKeyAt cursor firstKey
(dots', keys') <- repairAttrTail dotTokens restKeys (getLoc firstKey) firstKey'
let span' = foldr1 combineSrcSpans (getLoc firstKey' : fmap getLoc keys')
ann' = setAnnSpan span' ann {aapDots = dots'}
pure (L span' (NixAttrPath ann' (firstKey' : keys')))
where
leadingDot = length (aapDots ann) == length keys && not (null (aapDots ann))
dotTokens = aapDots ann
--------------------------------------------------------------------------------
repairFuncPat :: LFuncPat -> RepairM LFuncPat
repairFuncPat pat = repairFuncPatAt (spanStartCursor (getLoc pat)) pat
repairFuncPatAt :: RenderCursor -> LFuncPat -> RepairM LFuncPat
repairFuncPatAt cursor (L _ node) =
withRepairCursor cursor $
case node of
NixVarPat ann ident ->
let ident' = repairLocatedTextAt cursor ident
span' = getLoc ident'
ann' = setAnnSpan span' ann {avpId = span'}
in pure (L span' (NixVarPat ann' ident'))
NixSetPat ann ellipses mAs bindings -> repairSetPat ann ellipses mAs bindings
repairSetPat :: AnnSetPatNode -> NixSetPatEllipses -> Maybe LSetPatAs -> [LSetPatBinding] -> RepairM LFuncPat
repairSetPat ann ellipses mAs bindings = do
cursor <- currentRepairCursor
let openSpan = tokenSpanAt cursor (aspOpenC ann)
mAs' <- traverse (repairSetPatAsAt cursor) mAs
let entryCursor = setPatEntryCursor openSpan mAs'
bindings' <- repairSetPatBindingsAt ann entryCursor bindings
let closeSpan = repairSetPatCloseSpan ann bindings' ellipses
ann' = setAnnSpan patSpan ann {aspOpenC = (aspOpenC ann) {annTokenPos = AnnSpan openSpan}, aspCloseC = (aspCloseC ann) {annTokenPos = AnnSpan closeSpan}}
patNode = NixSetPat ann' ellipses mAs' bindings'
patSpan = funcPatBodySpan patNode
pure (L patSpan patNode)
setPatEntryCursor :: SrcSpan -> Maybe LSetPatAs -> RenderCursor
setPatEntryCursor openSpan = \case
Just asPat@(L _ NixSetPatAs {nspaLocation = NixSetPatAsLeading}) -> spanStartCursor (getLoc asPat)
_ -> RenderCursor (srcSpanStartLine openSpan) (srcSpanEndColumn openSpan)
--------------------------------------------------------------------------------
repairAttrKeyAt :: RenderCursor -> LAttrKey -> RepairM LAttrKey
repairAttrKeyAt cursor (L _ key) =
let span' = case key of
NixStaticAttrKey _ ident -> textSpanAt (cursorFile ident) cursor (unLoc ident)
NixDynamicStringAttrKey _ _ -> textSpanAt cursorFallbackFile cursor (renderToText key)
NixDynamicInterpolAttrKey _ _ -> textSpanAt cursorFallbackFile cursor (renderToText key)
key' = case key of
NixStaticAttrKey ann ident -> NixStaticAttrKey ann (repairLocatedTextAt cursor ident)
other -> other
in pure (L span' key')
--------------------------------------------------------------------------------
repairLocatedLitAt :: RenderCursor -> LLit -> LLit
repairLocatedLitAt cursor (L _ lit) = L (textSpanAt cursorFallbackFile cursor (renderToText lit)) lit
repairLocatedStringAt :: RenderCursor -> LNString -> LNString
repairLocatedStringAt cursor (L _ str) = L (textSpanAt cursorFallbackFile cursor (renderStringText str)) str
where
renderStringText = \case
NixDoubleQuotesString src _ -> renderDoubleQuotedSourceText src
NixDoubleSingleQuotesString src _ -> renderIndentedStringSourceText src
repairLocatedPathAt :: RenderCursor -> LPath -> LPath
repairLocatedPathAt cursor (L _ path) = L (textSpanAt cursorFallbackFile cursor (renderToText path)) path
repairLocatedTextAt :: RenderCursor -> Located Text -> Located Text
repairLocatedTextAt cursor (L _ txt) = L (textSpanAt cursorFallbackFile cursor txt) txt
--------------------------------------------------------------------------------
repairSetPatAsAt :: RenderCursor -> LSetPatAs -> RepairM LSetPatAs
repairSetPatAsAt cursor (L _ asPat@NixSetPatAs {..}) =
let var' = repairLocatedTextAt cursor nspaVar
atSpan = case nspaLocation of
NixSetPatAsLeading -> tokenSpanAt (spanEndCursor (getLoc var')) (aspaAt nspaAnn)
NixSetPatAsTrailing -> tokenSpanAt cursor (aspaAt nspaAnn)
span' = setPatAsRenderSpan (nspaAnn {aspaAt = (aspaAt nspaAnn) {annTokenPos = AnnSpan atSpan}}) var' nspaLocation
ann' = setAnnSpan span' nspaAnn {aspaAt = (aspaAt nspaAnn) {annTokenPos = AnnSpan atSpan}}
in pure (L span' asPat {nspaAnn = ann', nspaVar = var'})
repairSetPatBindingsAt :: AnnSetPatNode -> RenderCursor -> [LSetPatBinding] -> RepairM [LSetPatBinding]
repairSetPatBindingsAt ann startCursor bindings = reverse . snd <$> foldM step (startCursor, []) (zip [0 ..] bindings)
where
step (!cursor, repaired) (idx, binding) = do
binding' <- repairSetPatBindingAt ann idx cursor binding
let next = advanceCursor (spanStartCursor (getLoc binding')) (renderToText (unLoc binding'))
pure (next, binding' : repaired)
repairSetPatBindingAt :: AnnSetPatNode -> Int -> RenderCursor -> LSetPatBinding -> RepairM LSetPatBinding
repairSetPatBindingAt _ _ cursor (L _ binding@NixSetPatBinding {..}) = do
let var' = repairLocatedTextAt cursor nspbVar
def' <- case nspbDefault of
Nothing -> pure Nothing
Just defExpr ->
Just
<$> repairExprAt
(preserveGapTargetForSetPat binding var' defExpr)
defExpr
let qTok' = case (aspbQuestion nspbAnn, nspbDefault, def') of
(Just qTok, Just _, Just _) ->
let qSpan = preserveGapSpan (getLoc nspbVar) (expectTokenSpan "set pattern question" qTok) var'
in Just (qTok {annTokenPos = AnnSpan qSpan})
_ -> aspbQuestion nspbAnn
binding' = NixSetPatBinding (setAnnSpan span' nspbAnn {aspbQuestion = qTok'}) var' def'
span' = maybe (getLoc var') (combineSrcSpans (getLoc var') . getLoc) def'
pure (L span' binding')
--------------------------------------------------------------------------------
repairAttrTail :: [AnnToken] -> [LAttrKey] -> SrcSpan -> LAttrKey -> RepairM ([AnnToken], [LAttrKey])
repairAttrTail [] [] _ _ = pure ([], [])
repairAttrTail (dotTok : dotToks) (key : keys) oldPrev newPrev = do
let dotSpan = preserveGapSpan oldPrev (expectTokenSpan "attr path dot" dotTok) (L (getLoc newPrev) ())
key' <- repairAttrKeyAt (preserveGapTarget dotSpan (getLoc key) dotSpan) key
(dots', keys') <- repairAttrTail dotToks keys (getLoc key) key'
pure (dotTok {annTokenPos = AnnSpan dotSpan} : dots', key' : keys')
repairAttrTail dots keys _ _ = liftEPResult (Left (IndexOutOfRange (length dots) (length keys)))
--------------------------------------------------------------------------------
repairInheritNames :: SrcSpan -> Maybe LExpr -> Maybe LExpr -> [LAttrKey] -> RepairM [LAttrKey]
repairInheritNames inheritSpan oldScope newScope names = third <$> foldM step (oldStartAnchor, startAnchor, []) names
where
third (_, _, repaired) = repaired
startAnchor = maybe inheritSpan getLoc newScope
oldStartAnchor = maybe inheritSpan getLoc oldScope
step (prevOld, prevNew, repaired) name = do
name' <- repairAttrKeyAt (preserveGapTarget prevOld (getLoc name) prevNew) name
pure (getLoc name, getLoc name', repaired <> [name'])
--------------------------------------------------------------------------------
tokenSpanFromAnchor :: Text -> SrcSpan -> AnnToken -> SrcSpan
tokenSpanFromAnchor label anchor tok =
case annTokenSrcSpan tok of
Just span' -> span'
Nothing -> case annTokenDelta tok of
Just delta -> applyDeltaToAnchor anchor delta
Nothing -> error (T.unpack label <> ": missing token span")
--------------------------------------------------------------------------------
repairExprAtSelect :: AnnSelect -> LAttrPath -> LAttrPath -> LExpr -> RepairM LExpr
repairExprAtSelect ann oldPath newPath oldDef =
case aslOr ann of
Just orTok ->
let orSpan = preserveGapSpan (attrPathRenderSpan (unLoc oldPath)) (expectTokenSpan "select or" orTok) newPath
in repairExprAt (preserveGapTarget (expectTokenSpan "select or" orTok) (getLoc oldDef) orSpan) oldDef
Nothing -> repairExpr oldDef
--------------------------------------------------------------------------------
liftEPResult :: EPResult a -> RepairM a
liftEPResult = ReaderT . const
--------------------------------------------------------------------------------
repairSetPatCloseSpan :: AnnSetPatNode -> [LSetPatBinding] -> NixSetPatEllipses -> SrcSpan
repairSetPatCloseSpan ann bindings _ =
case reverse bindings of
lastBinding : _ ->
let endCursor = advanceCursor (spanStartCursor (getLoc lastBinding)) (renderToText (unLoc lastBinding))
in tokenSpanAt endCursor (aspCloseC ann)
[] -> expectTokenSpan "set pattern close" (aspCloseC ann)