From 75677fa8aa9a7f664d9c40213f59bf4f6705969d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 Mar 2016 17:12:39 -0400 Subject: [PATCH 1/3] Add a module for Info. --- semantic-diff.cabal | 1 + src/Info.hs | 1 + 2 files changed, 2 insertions(+) create mode 100644 src/Info.hs diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 06d64ab32..bcc76d21d 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -29,6 +29,7 @@ library , Diff , Diffing , DiffOutput + , Info , Interpreter , Language , Line diff --git a/src/Info.hs b/src/Info.hs new file mode 100644 index 000000000..f61759018 --- /dev/null +++ b/src/Info.hs @@ -0,0 +1 @@ +module Info where From e8fbe8c78971a86ec83675c8abd0ea8d30f6eb44 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 Mar 2016 17:26:52 -0400 Subject: [PATCH 2/3] Move Info into its own module. --- src/Alignment.hs | 5 +++-- src/Diff.hs | 11 ----------- src/Diffing.hs | 2 +- src/Info.hs | 12 ++++++++++++ src/Parser.hs | 2 +- src/Renderer.hs | 1 + src/Renderer/JSON.hs | 1 + src/Renderer/Patch.hs | 1 + src/Renderer/Split.hs | 1 + 9 files changed, 21 insertions(+), 15 deletions(-) diff --git a/src/Alignment.hs b/src/Alignment.hs index 681fcfa42..a77a4f0f0 100644 --- a/src/Alignment.hs +++ b/src/Alignment.hs @@ -25,6 +25,7 @@ import Data.Monoid import qualified Data.OrderedMap as Map import qualified Data.Text as T import Diff +import Info import Line import Patch import Prelude hiding (fst, snd) @@ -63,7 +64,7 @@ splitPatchByLines sources patch = wrapTermInPatch <$> splitAndFoldTerm (unPatch -- | Split a term comprised of an Info & Syntax up into one `outTerm` (abstracted by an alignment function & constructor) per line in `Source`. splitAbstractedTerm :: (Applicative f, Coalescent (f (Line (Maybe (Identity outTerm), Range))), Coalescent (f (Line (Maybe (T.Text, outTerm), Range))), Foldable f, TotalCrosswalk f) => (Info -> Syntax leaf outTerm -> outTerm) -> f (Source Char) -> f Info -> Syntax leaf (Adjoined (f (Line (outTerm, Range)))) -> Adjoined (f (Line (outTerm, Range))) splitAbstractedTerm makeTerm sources infos syntax = case syntax of - Leaf a -> tsequenceL (pure mempty) $ fmap <$> ((\ categories -> fmap (\ range -> (makeTerm (Info range categories) (Leaf a), range))) <$> (Diff.categories <$> infos)) <*> (linesInRangeOfSource <$> (characterRange <$> infos) <*> sources) + Leaf a -> tsequenceL (pure mempty) $ fmap <$> ((\ categories -> fmap (\ range -> (makeTerm (Info range categories) (Leaf a), range))) <$> (Info.categories <$> infos)) <*> (linesInRangeOfSource <$> (characterRange <$> infos) <*> sources) Indexed children -> adjoinChildren sources infos (constructor (Indexed . fmap runIdentity)) (Identity <$> children) Fixed children -> adjoinChildren sources infos (constructor (Fixed . fmap runIdentity)) (Identity <$> children) Keyed children -> adjoinChildren sources infos (constructor (Keyed . Map.fromList)) (Map.toList children) @@ -74,7 +75,7 @@ adjoinChildren :: (Copointed c, Functor c, Applicative f, Coalescent (f (Line (M adjoinChildren sources infos constructor children = wrap <$> leadingContext <> lines where (lines, next) = foldr (childLines sources) (mempty, end <$> ranges) children ranges = characterRange <$> infos - categories = Diff.categories <$> infos + categories = Info.categories <$> infos leadingContext = tsequenceL (pure mempty) $ makeContextLines <$> (linesInRangeOfSource <$> (Range <$> (start <$> ranges) <*> next) <*> sources) wrap = (wrapLineContents <$> (makeBranchTerm constructor <$> categories <*> next) <*>) makeBranchTerm constructor categories next children = let range = unionRangesFrom (rangeAt next) $ Prelude.snd <$> children in diff --git a/src/Diff.hs b/src/Diff.hs index e281f944c..213dde7a0 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -1,11 +1,8 @@ module Diff where -import Category import Control.Monad.Free import Data.Functor.Both -import Data.Set import Patch -import Range import Syntax import Term @@ -13,14 +10,6 @@ import Term data Annotated a annotation f = Annotated { annotation :: !annotation, syntax :: !(Syntax a f) } deriving (Functor, Eq, Show, Foldable) --- | An annotation for a source file, including the source range and semantic --- | categories. -data Info = Info { characterRange :: !Range, categories :: !(Set Category) } - deriving (Eq, Show) - -instance Categorizable Info where - categories = Diff.categories - -- | An annotated series of patches of terms. type Diff a annotation = Free (Annotated a (Both annotation)) (Patch (Term a annotation)) diff --git a/src/Diffing.hs b/src/Diffing.hs index 60d92d053..63730807b 100644 --- a/src/Diffing.hs +++ b/src/Diffing.hs @@ -1,6 +1,6 @@ module Diffing where -import Diff +import Info import Interpreter import Language import Parser diff --git a/src/Info.hs b/src/Info.hs index f61759018..0f99ad09e 100644 --- a/src/Info.hs +++ b/src/Info.hs @@ -1 +1,13 @@ module Info where + +import Category +import Data.Set +import Range + +-- | An annotation for a source file, including the source range and semantic +-- | categories. +data Info = Info { characterRange :: !Range, categories :: !(Set Category) } + deriving (Eq, Show) + +instance Categorizable Info where + categories = Info.categories diff --git a/src/Parser.hs b/src/Parser.hs index f6fc2662d..77d27fda7 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -1,7 +1,7 @@ module Parser where import Category -import Diff +import Info import Range import Syntax import Term diff --git a/src/Renderer.hs b/src/Renderer.hs index ac8dc73c1..ea381c406 100644 --- a/src/Renderer.hs +++ b/src/Renderer.hs @@ -2,6 +2,7 @@ module Renderer where import Data.Functor.Both import Diff +import Info import Source -- | A function that will render a diff, given the two source files. diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 496d838c3..d553f18d9 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -17,6 +17,7 @@ import Data.OrderedMap hiding (fromList) import qualified Data.Text as T import Data.Vector hiding (toList) import Diff +import Info import Line import Range import Renderer diff --git a/src/Renderer/Patch.hs b/src/Renderer/Patch.hs index a41d831be..f3969222f 100644 --- a/src/Renderer/Patch.hs +++ b/src/Renderer/Patch.hs @@ -6,6 +6,7 @@ module Renderer.Patch ( import Alignment import Diff +import Info import Line import Prelude hiding (fst, snd) import qualified Prelude diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index c899de5ec..98827dec3 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -10,6 +10,7 @@ import Data.Functor.Both import Data.Monoid import qualified Data.Text.Lazy as TL import Diff +import Info import Line import Prelude hiding (div, head, span, fst, snd) import qualified Prelude From 20bb94bf5e7c40087341a627462af34dd0559cdb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 Mar 2016 17:33:07 -0400 Subject: [PATCH 3/3] Also, tests. --- test/AlignmentSpec.hs | 1 + test/ArbitraryTerm.hs | 1 + test/InterpreterSpec.hs | 2 +- test/PatchOutputSpec.hs | 5 +++-- 4 files changed, 6 insertions(+), 3 deletions(-) diff --git a/test/AlignmentSpec.hs b/test/AlignmentSpec.hs index f7df8e64d..fed7f3646 100644 --- a/test/AlignmentSpec.hs +++ b/test/AlignmentSpec.hs @@ -14,6 +14,7 @@ import Data.Adjoined import Data.Copointed import Data.Functor.Both as Both import Diff +import Info import qualified Data.Maybe as Maybe import Data.Functor.Identity import Line diff --git a/test/ArbitraryTerm.hs b/test/ArbitraryTerm.hs index db649a2bb..ca04e869a 100644 --- a/test/ArbitraryTerm.hs +++ b/test/ArbitraryTerm.hs @@ -9,6 +9,7 @@ import qualified Data.List as List import qualified Data.Set as Set import Data.Text.Arbitrary () import Diff +import Info import Line import Patch import Prelude hiding (fst, snd) diff --git a/test/InterpreterSpec.hs b/test/InterpreterSpec.hs index cbcc50c5c..0f137c700 100644 --- a/test/InterpreterSpec.hs +++ b/test/InterpreterSpec.hs @@ -6,7 +6,7 @@ import Syntax import Control.Comonad.Cofree import Control.Monad.Free import Patch -import Diff +import Info import Category import Test.Hspec diff --git a/test/PatchOutputSpec.hs b/test/PatchOutputSpec.hs index 892394c3c..108a3f063 100644 --- a/test/PatchOutputSpec.hs +++ b/test/PatchOutputSpec.hs @@ -1,12 +1,13 @@ module PatchOutputSpec where +import Control.Monad.Free import Data.Functor.Both import Diff -import Renderer.Patch +import Info import Range +import Renderer.Patch import Source import Syntax -import Control.Monad.Free import Test.Hspec spec :: Spec