From 7d8c0c9a51f4bffde766aaa5e8d8e59c9c504af4 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 11 Sep 2022 15:10:15 -0400 Subject: [PATCH 1/2] Don't add blank lines back into multiline strings. --- src/Stack/ConfigCmd.hs | 5 ++-- src/Stack/YamlUpdate.hs | 59 ++++++++++++++++++++++++++++++----------- 2 files changed, 47 insertions(+), 17 deletions(-) diff --git a/src/Stack/ConfigCmd.hs b/src/Stack/ConfigCmd.hs index b5d45d51fb..9c0bef1406 100644 --- a/src/Stack/ConfigCmd.hs +++ b/src/Stack/ConfigCmd.hs @@ -87,15 +87,16 @@ cfgCmdSet cmd = do \unchanged.") else do let configLines = yamlLines rawConfig + let keys = coerce yamlKeys either throwM (\updated -> do - let redressed = unmkRaw $ redress configLines updated + let redressed = unmkRaw $ redress keys configLines updated writeBinaryFileAtomic configFilePath . byteString $ encodeUtf8 redressed let file = fromString $ toFilePath configFilePath logInfo (file <> " has been updated.")) - (encodeInOrder configLines (coerce yamlKeys) (coerce cmdKey) config') + (encodeInOrder configLines keys (coerce cmdKey) config') cfgCmdSetValue :: (HasConfig env, HasGHCVariant env) diff --git a/src/Stack/YamlUpdate.hs b/src/Stack/YamlUpdate.hs index acc96004d6..bcc89ce8bd 100644 --- a/src/Stack/YamlUpdate.hs +++ b/src/Stack/YamlUpdate.hs @@ -47,6 +47,8 @@ newtype YamlLineComment = YamlLineComment (Int, Text) -- | A mapping from the line number after an encoding that strips blank lines -- and comments to a line number of the original document. newtype YamlLineReindex = YamlLineReindex (Int, Int) +-- | A range of line numbers with a multi-line strings. +newtype YamlMulti = YamlMulti (Int, Int) data YamlLines = YamlLines @@ -82,14 +84,14 @@ yamlLines :: RawYaml -> [RawYamlLine] yamlLines x = RawYamlLine <$> T.lines (coerce x) -- | Puts blank lines and comments from the original lines into the update. -redress :: [RawYamlLine] -> RawYaml -> RawYaml -redress rawLines (RawYaml t) = +redress :: [YamlKey] -> [RawYamlLine] -> RawYaml -> RawYaml +redress keys rawLines (RawYaml t) = let xs = zip [1 ..] (T.lines t) in RawYaml . T.concat $ [ T.unlines . fromMaybe [x] $ do Pegged{newIndex = i', leading, partComments, spanComments} - <- fetchPegged rawLines (i, j) + <- fetchPegged keys rawLines (i, j) let x' = maybe x @@ -104,8 +106,9 @@ redress rawLines (RawYaml t) = | (j, _) <- drop 1 xs ++ [(0, "")] ] -fetchPegged :: [RawYamlLine] -> (Int, Int) -> Maybe Pegged -fetchPegged (pegLines -> yl@YamlLines{reindices}) (i, j) = do +fetchPegged :: [YamlKey] -> [RawYamlLine] -> (Int, Int) -> Maybe Pegged +fetchPegged keys rawLines (i, j) = do + let yl@YamlLines{reindices} = pegLines keys rawLines let reindex = flip L.lookup (coerce reindices) i' <- reindex i @@ -154,9 +157,9 @@ encodeInOrder rawLines keysFound upsertKey@(YamlKey k) yObject = in RawYaml <$> decodeUtf8' (Yaml.encodePretty keyCmp yObject) -endSentinel :: Text -endSentinel = - "ED10F56C-562E-4847-A50B-7541C1732A15: 2986F150-E4A0-41D8-AB9C-8BD82FA12DC4" +endSentinelKey, endSentinel :: Text +endSentinelKey = "ED10F56C-562E-4847-A50B-7541C1732A15" +endSentinel = endSentinelKey <> ": 2986F150-E4A0-41D8-AB9C-8BD82FA12DC4" mkRaw :: Text -> RawYaml mkRaw = addSentinels . RawYaml @@ -196,10 +199,17 @@ dropToComment = T.dropWhile (/= '#') -- | Gather enough information about lines to peg line numbers so that blank -- lines and comments can be reinserted later. -pegLines :: [RawYamlLine] -> YamlLines -pegLines rawLines = - let (ls, rs) = partitionEithers - [ if | y == "" -> Left . Left $ YamlLineBlank i +pegLines :: [YamlKey] -> [RawYamlLine] -> YamlLines +pegLines keys rawLines = + YamlLines blanks wholeLineComments partLineComments reindex + where + inRange xs x = any (\(YamlMulti (i, j)) -> i < x && x < j - 1) xs + multiLineValue = inRange (multiLines keys rawLines) + + (ls, rs) = partitionEithers + [ if | multiLineValue i -> Right $ Right i + + | y == "" -> Left . Left $ YamlLineBlank i | "#" `T.isPrefixOf` T.dropWhile (== ' ') y -> Left . Right $ YamlLineComment (i, y) @@ -215,8 +225,27 @@ pegLines rawLines = (blanks, wholeLineComments) = partitionEithers ls (partLineComments, contentLines) = partitionEithers rs - indexLines = - L.sort $ contentLines ++ (commentLineNumber <$> partLineComments) + indexLines = L.sort $ contentLines ++ (commentLineNumber <$> partLineComments) reindex = zipWith (curry YamlLineReindex) [1 ..] indexLines - in YamlLines blanks wholeLineComments partLineComments reindex +-- | Given top-level keys, finds the line range of multi-line strings. +multiLines :: [YamlKey] -> [RawYamlLine] -> [YamlMulti] +multiLines (fmap (<> ":") . filter (/= endSentinelKey) . coerce -> keys) (coerce -> rawLines) = + [ YamlMulti (start, fromMaybe (length rawLines) end) + | start <- starts + , let end = L.find (> start) fields + ] + where + starts = catMaybes $ + [ if | ": |" `T.isSuffixOf` rawLine -> Just i + | ": <" `T.isSuffixOf` rawLine -> Just i + | otherwise -> Nothing + | rawLine <- rawLines + | i <- [1 ..] + ] + + fields = L.sort . catMaybes $ + [ if any (`T.isPrefixOf` rawLine) keys then Just i else Nothing + | rawLine <- rawLines + | i <- [1 ..] + ] \ No newline at end of file From a16d5c2618d8b0846bd00880f6bf1168f56fe0e6 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 12 Sep 2022 21:51:11 -0400 Subject: [PATCH 2/2] Allow for indentation indicator. --- src/Stack/YamlUpdate.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Stack/YamlUpdate.hs b/src/Stack/YamlUpdate.hs index bcc89ce8bd..9f35e80972 100644 --- a/src/Stack/YamlUpdate.hs +++ b/src/Stack/YamlUpdate.hs @@ -237,8 +237,8 @@ multiLines (fmap (<> ":") . filter (/= endSentinelKey) . coerce -> keys) (coerce ] where starts = catMaybes $ - [ if | ": |" `T.isSuffixOf` rawLine -> Just i - | ": <" `T.isSuffixOf` rawLine -> Just i + [ if | ": |" `T.isInfixOf` rawLine -> Just i + | ": <" `T.isInfixOf` rawLine -> Just i | otherwise -> Nothing | rawLine <- rawLines | i <- [1 ..]