module Descript.Misc.Build.Write.Print.Patch ( Change , CChange , Patch (..) , CPatch (..) , replacePatch , mkCPatch , liftCPatch , apPatch , alignRange , isInsertPatch ) where import Descript.Misc.Loc import Data.Monoid import Core.Data.Group import Data.List hiding ((\\)) import Data.Text (Text) import qualified Data.Text as Text -- | Completely replaces or patches text. type Change = Either Text Patch -- | Completely replaces or patches text. type CChange = Either Text CPatch -- | Replaces parts of text inside a bigger block. data Patch = Patch { cpatches :: [CPatch] -- ^ Continuous blocks which are replaced. Assumed to be in order. , patchOffset :: LocDiff -- ^ The change in size after the patch is applied. } deriving (Eq, Ord, Read, Show) -- | Replaces a continuous block of text inside a bigger block. data CPatch = CPatch { cpatchRange :: Range , cpatchText :: Text } deriving (Eq, Ord, Read, Show) -- | Assumes when 2 patches are appended, the later patch's range is -- after the earlier patch's range. instance Monoid Patch where mempty = Patch { cpatches = [] , patchOffset = mempty } -- | Assumes the later patch's range is after the earlier patch's range. Patch xCPatches xPatchOffset `mappend` Patch yCPatches yPatchOffset = Patch { cpatches = xCPatches ++ yCPatches' , patchOffset = xPatchOffset <> yPatchOffset } where yCPatches' = map (offsetCPatch xPatchOffset) yCPatches -- | Creates a patch which replaces the first text with the second. replacePatch :: Text -> Text -> Patch replacePatch = mkCPatch . textRange -- | Creates a continuous 'Patch', spanning the given range with the -- given text. mkCPatch :: Range -> Text -> Patch mkCPatch range = liftCPatch . CPatch range liftCPatch :: CPatch -> Patch liftCPatch cpatch | isCPatchEmpty cpatch = mempty | otherwise = Patch { cpatches = [cpatch] , patchOffset = cpatchOffset cpatch } isCPatchEmpty :: CPatch -> Bool isCPatchEmpty (CPatch range text) = isSingletonRange range && Text.null text cpatchOffset :: CPatch -> LocDiff cpatchOffset (CPatch range text) = textDiff (line $ start range) text \\ rangeDiff range offsetCPatch :: LocDiff -> CPatch -> CPatch offsetCPatch diff (CPatch range text) = CPatch (offsetRange diff range) text -- | Applies the patch to the text - replaces all patched ranges. apPatch :: Patch -> Text -> Text apPatch patch text = foldl' (flip apCPatch) text $ cpatches patch apCPatch :: CPatch -> Text -> Text apCPatch (CPatch range patch) orig = start range `beforeInText` orig <> patch <> end range `afterInText` orig -- | Adjusts the range in text before the patch so it contains the same -- content (except if deleted) in text after the patch. alignRange :: Patch -> Range -> Range alignRange = alignRangeCs . cpatches alignRangeCs :: [CPatch] -> Range -> Range alignRangeCs = flip $ foldl' $ flip alignRangeC -- | Adjusts the range in text before the patch so it contains the same -- content (except if deleted) in text after the patch. alignRangeC :: CPatch -> Range -> Range alignRangeC (CPatch (Range pStart pEnd) content) (Range xStart xEnd) | pEnd <= xStart = Range { start = xStart `addDiff` coff , end = xEnd `addDiff` coff } | pStart >= xEnd = Range { start = xStart , end = xEnd } | pStart <= xStart && pEnd < xEnd = Range { start = pEnd `addDiff` coff , end = xEnd `addDiff` coff } | pStart <= xStart && pEnd >= xEnd -- Patch completely replaces range = Range -- Both could be `pStart or `offsetRange coff pEnd`, must be same { start = pStart , end = pStart } | pStart > xStart && pEnd < xEnd = Range { start = xStart , end = xEnd `addDiff` coff } | pStart > xStart && pEnd >= xEnd = Range { start = xStart , end = pEnd `addDiff` coff } | otherwise = error "unexpected \"impossible\" location comparison" where coff = textDiff (line pStart) content -- | Whether the patch only inserts text, doesn't remove any. isInsertPatch :: Patch -> Bool isInsertPatch = all isInsertCPatch . cpatches -- | Whether the patch only inserts text, doesn't remove any. isInsertCPatch :: CPatch -> Bool isInsertCPatch (CPatch range _) = isSingletonRange range