From d7ee02449af640903edf276bf2c2fa296f4c9371 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 31 Jul 2018 17:55:47 -0400 Subject: [PATCH] foolish stabs at fixing bugs. I can't brain anymore, enough for today --- src/Reprinting/Algebraic.hs | 2 +- src/Semantic/Util.hs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Reprinting/Algebraic.hs b/src/Reprinting/Algebraic.hs index 513a1b28e..d2dd121a1 100644 --- a/src/Reprinting/Algebraic.hs +++ b/src/Reprinting/Algebraic.hs @@ -149,7 +149,7 @@ descend :: (Reprintable constr, HasField fields History) => SubtermAlgebra const descend t = history >>= \case -- No action is necessary for a pristine node. Pristine _ -> pure () - Generated -> local (\c -> c { rcHistory = Generated}) (whenGenerated (fmap subtermRef t)) + Generated -> whenGenerated (fmap subtermRef t) Modified _ -> whenGenerated (fmap (\x -> into (subterm x) (subtermRef x)) t) Refactored r -> do st <- get @RPState diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 5c261adb0..fca9aa44b 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -134,10 +134,11 @@ testReprinter = do pure (src, tree) let tagged = increaseNumbers (mark Modified tree) - pPrint tagged let toks = reprint src tagged pure toks +testConcrete = concretize (Proxy @'Language.JSON) <$> testReprinter + -- Evaluate a project consisting of the listed paths. evaluateProject proxy parser lang paths = withOptions debugOptions $ \ config logger statter ->