mirror of
https://github.com/github/semantic.git
synced 2024-11-24 08:54:07 +03:00
52 lines
2.3 KiB
Haskell
52 lines
2.3 KiB
Haskell
module Unified (unified) where
|
|
|
|
import Diff
|
|
import Patch
|
|
import Syntax
|
|
import Term
|
|
import Control.Arrow
|
|
import Control.Monad.Free
|
|
import Control.Comonad.Cofree
|
|
import Data.List hiding (foldl)
|
|
import qualified Data.Map as Map
|
|
import Rainbow
|
|
|
|
unified :: Diff a Info -> String -> String -> IO ByteString
|
|
unified diff before after = do
|
|
renderer <- byteStringMakerFromEnvironment
|
|
return . mconcat . chunksToByteStrings renderer . pure . fst $ iter g mapped where
|
|
mapped = fmap (unifiedPatch &&& range) diff
|
|
g (Annotated (_, info) syntax) = f info syntax
|
|
f (Info range _) (Leaf _) = (substring range after, Just range)
|
|
f (Info range _) (Indexed i) = (unifiedRange range i after, Just range)
|
|
f (Info range _) (Fixed f) = (unifiedRange range f after, Just range)
|
|
f (Info range _) (Keyed k) = (unifiedRange range (sort $ snd <$> Map.toList k) after, Just range)
|
|
|
|
unifiedPatch :: Patch (Term a Info) -> Chunk String
|
|
unifiedPatch patch = (beforeChunk & fore red & bold) <> (afterChunk & fore green & bold) where
|
|
beforeChunk = maybe (chunk "") (change "-" . unifiedTerm before) $ Patch.before patch
|
|
afterChunk = maybe (chunk "") (change "+" . unifiedTerm after) $ Patch.after patch
|
|
|
|
unifiedTerm :: String -> Term a Info -> Chunk String
|
|
unifiedTerm source term = fst $ cata f term
|
|
|
|
unifiedRange :: Range -> [(Chunk String, Maybe Range)] -> String -> Chunk String
|
|
unifiedRange range children source = out <> substring Range { start = previous, end = end range } after where
|
|
(out, previous) = foldl accumulateContext (chunk "", start range) children
|
|
accumulateContext (out, previous) (child, Just range) = (mconcat [ out, substring Range { start = previous, end = start range } source, child ], end range)
|
|
accumulateContext (out, previous) (child, _) = (out <> child, previous)
|
|
|
|
substring :: Range -> String -> Chunk String
|
|
substring range = chunk . take (end range) . drop (start range)
|
|
|
|
range :: Patch (Term a Info) -> Maybe Range
|
|
range patch = range . extract <$> after patch where
|
|
extract (annotation :< _) = annotation
|
|
range (Info range _) = range
|
|
|
|
change :: String -> Chunk String -> Chunk String
|
|
change bound content = mconcat [ chunk "{", chunk bound, content, chunk bound, chunk "}" ]
|
|
|
|
instance Ord Range where
|
|
a <= b = start a <= start b
|