diff --git a/ROADMAP.md b/ROADMAP.md index 9e36f6aa3..3bed09a9e 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -1,5 +1,7 @@ # Roadmap +This is the long form version of our [roadmap project][]. + ## Things we are currently doing: 1. [Diff summaries][] for C & JavaScript. Q3 2016 or so. @@ -34,6 +36,7 @@ 2. Collect data on our heuristics &c. and refine them via e.g. ML. 3. Diffs as a [service][]. +[roadmap project]: https://github.com/github/semantic-diff/projects/5 [Diff summaries]: https://github.com/github/semantic-diff/milestones/Summer%20Eyes [Semantic diffs]: https://github.com/github/semantic-diff/milestones/Dot%20Calm [Ruby]: https://github.com/github/semantic-diff/issues/282 diff --git a/src/Alignment.hs b/src/Alignment.hs index 1513ec0d2..5bdea0da6 100644 --- a/src/Alignment.hs +++ b/src/Alignment.hs @@ -38,15 +38,15 @@ numberedRows = countUp (both 1 1) nextLineNumbers from row = modifyJoin (fromThese identity identity) (succ <$ row) <*> from -- | Determine whether a line contains any patches. -hasChanges :: SplitDiff leaf annotation -> Bool +hasChanges :: (Prologue.Foldable f, Functor f) => SplitDiff f annotation -> Bool hasChanges = or . (True <$) -- | Align a Diff into a list of Join These SplitDiffs representing the (possibly blank) lines on either side. -alignDiff :: HasField fields Range => Both (Source Char) -> Diff leaf (Record fields) -> [Join These (SplitDiff leaf (Record fields))] +alignDiff :: HasField fields Range => Both (Source Char) -> SyntaxDiff leaf fields -> [Join These (SplitSyntaxDiff leaf fields)] alignDiff sources diff = iter (alignSyntax (runBothWith ((Join .) . These)) wrap getRange sources) (alignPatch sources <$> diff) -- | Align the contents of a patch into a list of lines on the corresponding side(s) of the diff. -alignPatch :: forall fields leaf. HasField fields Range => Both (Source Char) -> Patch (Term leaf (Record fields)) -> [Join These (SplitDiff leaf (Record fields))] +alignPatch :: forall fields leaf. HasField fields Range => Both (Source Char) -> Patch (SyntaxTerm leaf fields) -> [Join These (SplitSyntaxDiff leaf fields)] alignPatch sources patch = case patch of Delete term -> fmap (pure . SplitDelete) <$> alignSyntax' this (fst sources) term Insert term -> fmap (pure . SplitInsert) <$> alignSyntax' that (snd sources) term @@ -54,13 +54,13 @@ alignPatch sources patch = case patch of (alignSyntax' this (fst sources) term1) (alignSyntax' that (snd sources) term2) where getRange = characterRange . extract - alignSyntax' :: (forall a. Identity a -> Join These a) -> Source Char -> Term leaf (Record fields) -> [Join These (Term leaf (Record fields))] + alignSyntax' :: (forall a. Identity a -> Join These a) -> Source Char -> SyntaxTerm leaf fields -> [Join These (SyntaxTerm leaf fields)] alignSyntax' side source term = hylo (alignSyntax side cofree getRange (Identity source)) runCofree (Identity <$> term) this = Join . This . runIdentity that = Join . That . runIdentity -- | The Applicative instance f is either Identity or Both. Identity is for Terms in Patches, Both is for Diffs in unchanged portions of the diff. -alignSyntax :: (Applicative f, HasField fields Range) => (forall a. f a -> Join These a) -> (CofreeF (Syntax leaf) (Record fields) term -> term) -> (term -> Range) -> f (Source Char) -> CofreeF (Syntax leaf) (f (Record fields)) [Join These term] -> [Join These term] +alignSyntax :: (Applicative f, HasField fields Range) => (forall a. f a -> Join These a) -> (SyntaxTermF leaf fields term -> term) -> (term -> Range) -> f (Source Char) -> TermF (Syntax leaf) (f (Record fields)) [Join These term] -> [Join These term] alignSyntax toJoinThese toNode getRange sources (infos :< syntax) = catMaybes $ case syntax of Leaf s -> wrapInBranch (const (Leaf s)) <$> alignBranch getRange [] bothRanges Syntax.Comment a -> wrapInBranch (const (Syntax.Comment a)) <$> alignBranch getRange [] bothRanges diff --git a/src/Diff.hs b/src/Diff.hs index ec56caac7..ec28dd2a4 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -6,35 +6,39 @@ import Prologue import Data.Functor.Foldable as Foldable import Data.Functor.Both as Both import Data.Mergeable +import Data.Record import Patch import Syntax import Term -- | An annotated series of patches of terms. -type DiffF leaf annotation = FreeF (CofreeF (Syntax leaf) (Both annotation)) (Patch (Term leaf annotation)) -type Diff a annotation = Free (CofreeF (Syntax a) (Both annotation)) (Patch (Term a annotation)) +type DiffF f annotation = FreeF (TermF f (Both annotation)) (Patch (Term f annotation)) +type Diff f annotation = Free (TermF f (Both annotation)) (Patch (Term f annotation)) + +type SyntaxDiff leaf fields = Diff (Syntax leaf) (Record fields) + type instance Base (Free f a) = FreeF f a instance Functor f => Foldable.Foldable (Free f a) where project = runFree instance Functor f => Foldable.Unfoldable (Free f a) where embed = free -diffSum :: (Patch (Term a annotation) -> Int) -> Diff a annotation -> Int +diffSum :: (Prologue.Foldable f, Functor f) => (Patch (Term f annotation) -> Int) -> Diff f annotation -> Int diffSum patchCost diff = sum $ fmap patchCost diff -- | The sum of the node count of the diff’s patches. -diffCost :: Diff a annotation -> Int +diffCost :: (Prologue.Foldable f, Functor f) => Diff f annotation -> Int diffCost = diffSum $ patchSum termSize -- | Merge a diff using a function to provide the Term (in Maybe, to simplify recovery of the before/after state) for every Patch. -mergeMaybe :: (Patch (Term leaf annotation) -> Maybe (Term leaf annotation)) -> Diff leaf annotation -> Maybe (Term leaf annotation) +mergeMaybe :: (Functor f, Mergeable f) => (Patch (Term f annotation) -> Maybe (Term f annotation)) -> Diff f annotation -> Maybe (Term f annotation) mergeMaybe transform = iter algebra . fmap transform - where algebra :: CofreeF (Syntax leaf) (Both annotation) (Maybe (Term leaf annotation)) -> Maybe (Term leaf annotation) + where algebra :: Mergeable f => TermF f (Both annotation) (Maybe (Term f annotation)) -> Maybe (Term f annotation) algebra (annotations :< syntax) = cofree . (Both.fst annotations :<) <$> sequenceAlt syntax -- | Recover the before state of a diff. -beforeTerm :: Diff leaf annotation -> Maybe (Term leaf annotation) +beforeTerm :: (Functor f, Mergeable f) => Diff f annotation -> Maybe (Term f annotation) beforeTerm = mergeMaybe before -- | Recover the after state of a diff. -afterTerm :: Diff leaf annotation -> Maybe (Term leaf annotation) +afterTerm :: (Functor f, Mergeable f) => Diff f annotation -> Maybe (Term f annotation) afterTerm = mergeMaybe after diff --git a/src/Diff/Arbitrary.hs b/src/Diff/Arbitrary.hs index b6fd009a4..66b5c2db3 100644 --- a/src/Diff/Arbitrary.hs +++ b/src/Diff/Arbitrary.hs @@ -3,11 +3,13 @@ module Diff.Arbitrary where import Diff import Data.Bifunctor.Join import Data.Bifunctor.Join.Arbitrary () +import Data.Functor.Both import Data.Functor.Foldable (unfold) import Patch import Patch.Arbitrary () import Syntax import Prologue +import Term import Term.Arbitrary import Test.QuickCheck hiding (Fixed) @@ -16,11 +18,11 @@ data ArbitraryDiff leaf annotation | ArbitraryPure (Patch (ArbitraryTerm leaf annotation)) deriving (Show, Eq, Generic) -unArbitraryDiff :: ArbitraryDiff leaf annotation -> FreeF (CofreeF (Syntax leaf) (Join (,) annotation)) (Patch (ArbitraryTerm leaf annotation)) (ArbitraryDiff leaf annotation) +unArbitraryDiff :: ArbitraryDiff leaf annotation -> FreeF (TermF (Syntax leaf) (Both annotation)) (Patch (ArbitraryTerm leaf annotation)) (ArbitraryDiff leaf annotation) unArbitraryDiff (ArbitraryFree a s) = Free (a :< s) unArbitraryDiff (ArbitraryPure p) = Pure p -toDiff :: ArbitraryDiff leaf annotation -> Diff leaf annotation +toDiff :: ArbitraryDiff leaf annotation -> Diff (Syntax leaf) annotation toDiff = fmap (fmap toTerm) . unfold unArbitraryDiff diffOfSize :: (Arbitrary leaf, Arbitrary annotation) => Int -> Gen (ArbitraryDiff leaf annotation) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index c6f64a6f9..0dbae5c48 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -24,7 +24,7 @@ import Source data Identifiable a = Identifiable a | Unidentifiable a -isIdentifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Bool +isIdentifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => SyntaxTerm leaf fields -> Bool isIdentifiable term = case unwrap term of S.FunctionCall _ _ -> True @@ -38,7 +38,7 @@ isIdentifiable term = S.Leaf _ -> True _ -> False -identifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Identifiable (Term leaf (Record fields)) +identifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => SyntaxTerm leaf fields -> Identifiable (SyntaxTerm leaf fields) identifiable term = if isIdentifiable term then Identifiable term else Unidentifiable term data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text } @@ -54,7 +54,7 @@ data DiffSummary a = DiffSummary { } deriving (Eq, Functor, Show, Generic) -- Returns a list of diff summary texts given two source blobs and a diff. -diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both SourceBlob -> Diff leaf (Record fields) -> [Either Text Text] +diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both SourceBlob -> SyntaxDiff leaf fields -> [Either Text Text] diffSummaries blobs diff = summaryToTexts =<< diffToDiffSummaries (source <$> blobs) diff -- Takes a 'DiffSummary' and returns a list of summary texts representing the LeafInfos @@ -63,7 +63,7 @@ summaryToTexts :: DiffSummary DiffInfo -> [Either Text Text] summaryToTexts DiffSummary{..} = runJoin . fmap (show . (P.<> maybeParentContext parentAnnotation)) <$> (Join <$> summaries patch) -- Returns a list of 'DiffSummary' given two source blobs and a diff. -diffToDiffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both (Source Char) -> Diff leaf (Record fields) -> [DiffSummary DiffInfo] +diffToDiffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both (Source Char) -> SyntaxDiff leaf fields -> [DiffSummary DiffInfo] diffToDiffSummaries sources = para $ \diff -> let diff' = free (Prologue.fst <$> diff) annotateWithCategory :: [(Diff leaf (Record fields), [DiffSummary DiffInfo])] -> [DiffSummary DiffInfo] @@ -104,7 +104,7 @@ toLeafInfos BranchInfo{..} = toLeafInfos =<< branches toLeafInfos err@ErrorInfo{} = pure (pretty err) -- Returns a text representing a specific term given a source and a term. -toTermName :: forall leaf fields. (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> Term leaf (Record fields) -> Text +toTermName :: forall leaf fields. (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> SyntaxTerm leaf fields -> Text toTermName source term = case unwrap term of S.AnonymousFunction _ _ -> "anonymous" S.Fixed children -> fromMaybe "branch" $ (toCategoryName . category) . extract <$> head children @@ -162,7 +162,7 @@ toTermName source term = case unwrap term of termNameFromSource term = termNameFromRange (range term) termNameFromRange range = toText $ Source.slice range source range = characterRange . extract - toArgName :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Text + toArgName :: (HasCategory leaf, HasField fields Category, HasField fields Range) => SyntaxTerm leaf fields -> Text toArgName arg = case identifiable arg of Identifiable arg -> toTermName' arg Unidentifiable _ -> "..." @@ -174,7 +174,7 @@ maybeParentContext = maybe "" (\annotation -> toDoc :: Text -> Doc toDoc = string . toS -termToDiffInfo :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> Term leaf (Record fields) -> DiffInfo +termToDiffInfo :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> SyntaxTerm leaf fields -> DiffInfo termToDiffInfo blob term = case unwrap term of Leaf _ -> LeafInfo (toCategoryName term) (toTermName' term) S.AnonymousFunction _ _ -> LeafInfo (toCategoryName term) ("anonymous") @@ -193,7 +193,7 @@ termToDiffInfo blob term = case unwrap term of where toTermName' = toTermName blob termToDiffInfo' = termToDiffInfo blob -prependSummary :: (HasCategory leaf, HasField fields Range, HasField fields Category) => Source Char -> Term leaf (Record fields) -> DiffSummary DiffInfo -> DiffSummary DiffInfo +prependSummary :: (HasCategory leaf, HasField fields Range, HasField fields Category) => Source Char -> SyntaxTerm leaf fields -> DiffSummary DiffInfo -> DiffSummary DiffInfo prependSummary source term summary = case (parentAnnotation summary, identifiable term) of (Nothing, Identifiable term) -> summary { parentAnnotation = Just (category . extract $ term, toTermName source term) } @@ -270,7 +270,7 @@ instance HasCategory Category where C.CommaOperator -> "comma operator" C.Empty -> "empty statement" -instance (HasCategory leaf, HasField fields Category) => HasCategory (Term leaf (Record fields)) where +instance (HasCategory leaf, HasField fields Category) => HasCategory (SyntaxTerm leaf fields) where toCategoryName = toCategoryName . category . extract instance Arbitrary Branch where diff --git a/src/Diffing.hs b/src/Diffing.hs index 9e8ac983e..fa0f1eef3 100644 --- a/src/Diffing.hs +++ b/src/Diffing.hs @@ -93,7 +93,7 @@ parserForFilepath path blob = decorateTerm termCostDecorator <$> do pure $! breakDownLeavesByWord (source blob) parsed -- | Replace every string leaf with leaves of the words in the string. -breakDownLeavesByWord :: (HasField fields Category, HasField fields Range) => Source Char -> Term Text (Record fields) -> Term Text (Record fields) +breakDownLeavesByWord :: (HasField fields Category, HasField fields Range) => Source Char -> Term (Syntax Text) (Record fields) -> Term (Syntax Text) (Record fields) breakDownLeavesByWord source = cata replaceIn where replaceIn (info :< syntax) = cofree $ info :< syntax' @@ -133,11 +133,11 @@ termCostDecorator :: (Prologue.Foldable f, Functor f) => TermDecorator f a Cost termCostDecorator c = 1 + sum (cost <$> tailF c) -- | Determine whether two terms are comparable based on the equality of their categories. -compareCategoryEq :: HasField fields Category => Term leaf (Record fields) -> Term leaf (Record fields) -> Bool +compareCategoryEq :: Functor f => HasField fields Category => Term f (Record fields) -> Term f (Record fields) -> Bool compareCategoryEq = (==) `on` category . extract -- | The sum of the node count of the diff’s patches. -diffCostWithCachedTermCosts :: HasField fields Cost => Diff leaf (Record fields) -> Int +diffCostWithCachedTermCosts :: Functor f => HasField fields Cost => Diff f (Record fields) -> Int diffCostWithCachedTermCosts diff = unCost $ case runFree diff of Free (info :< _) -> sum (cost <$> info) Pure patch -> sum (cost . extract <$> patch) diff --git a/src/Interpreter.hs b/src/Interpreter.hs index daf9eb6a8..74dc25408 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -19,23 +19,23 @@ import Syntax as S import Term -- | Returns whether two terms are comparable -type Comparable leaf annotation = Term leaf annotation -> Term leaf annotation -> Bool +type Comparable f annotation = Term f annotation -> Term f annotation -> Bool -- | Constructs a diff from the CofreeF containing its annotation and syntax. This function has the opportunity to, for example, cache properties in the annotation. -type DiffConstructor leaf annotation = CofreeF (Syntax leaf) (Both annotation) (Diff leaf annotation) -> Diff leaf annotation +type DiffConstructor f annotation = TermF f (Both annotation) (Diff f annotation) -> Diff f annotation -- | Diff two terms recursively, given functions characterizing the diffing. diffTerms :: (Eq leaf, Eq (Record fields), HasField fields Category, HasField fields (Vector.Vector Double)) - => DiffConstructor leaf (Record fields) -- ^ A function to wrap up & possibly annotate every produced diff. - -> Comparable leaf (Record fields) -- ^ A function to determine whether or not two terms should even be compared. - -> SES.Cost (Diff leaf (Record fields)) -- ^ A function to compute the cost of a given diff node. - -> Term leaf (Record fields) -- ^ A term representing the old state. - -> Term leaf (Record fields) -- ^ A term representing the new state. - -> Diff leaf (Record fields) + => DiffConstructor (Syntax leaf) (Record fields) -- ^ A function to wrap up & possibly annotate every produced diff. + -> Comparable (Syntax leaf) (Record fields) -- ^ A function to determine whether or not two terms should even be compared. + -> SES.Cost (SyntaxDiff leaf fields) -- ^ A function to compute the cost of a given diff node. + -> SyntaxTerm leaf fields -- ^ A term representing the old state. + -> SyntaxTerm leaf fields -- ^ A term representing the new state. + -> SyntaxDiff leaf fields diffTerms construct comparable cost a b = fromMaybe (replacing a b) $ diffComparableTerms construct comparable cost a b -- | Diff two terms recursively, given functions characterizing the diffing. If the terms are incomparable, returns 'Nothing'. -diffComparableTerms :: (Eq leaf, Eq (Record fields), HasField fields Category, HasField fields (Vector.Vector Double)) => DiffConstructor leaf (Record fields) -> Comparable leaf (Record fields) -> SES.Cost (Diff leaf (Record fields)) -> Term leaf (Record fields) -> Term leaf (Record fields) -> Maybe (Diff leaf (Record fields)) +diffComparableTerms :: (Eq leaf, Eq (Record fields), HasField fields Category, HasField fields (Vector.Vector Double)) => DiffConstructor (Syntax leaf) (Record fields) -> Comparable (Syntax leaf) (Record fields) -> SES.Cost (SyntaxDiff leaf fields) -> SyntaxTerm leaf fields -> SyntaxTerm leaf fields -> Maybe (SyntaxDiff leaf fields) diffComparableTerms construct comparable cost = recur where recur a b | (category <$> a) == (category <$> b) = hylo construct runCofree <$> zipTerms a b @@ -43,7 +43,7 @@ diffComparableTerms construct comparable cost = recur | otherwise = Nothing -- | Construct an algorithm to diff a pair of terms. -algorithmWithTerms :: (TermF leaf (Both a) diff -> diff) -> Term leaf a -> Term leaf a -> Algorithm (Term leaf a) diff diff +algorithmWithTerms :: (TermF (Syntax leaf) (Both a) diff -> diff) -> Term (Syntax leaf) a -> Term (Syntax leaf) a -> Algorithm (Term (Syntax leaf) a) diff diff algorithmWithTerms construct t1 t2 = case (unwrap t1, unwrap t2) of (Indexed a, Indexed b) -> branch Indexed a b (S.FunctionCall identifierA argsA, S.FunctionCall identifierB argsB) -> do diff --git a/src/Language.hs b/src/Language.hs index 754ff2850..387db2570 100644 --- a/src/Language.hs +++ b/src/Language.hs @@ -43,8 +43,8 @@ termConstructor -> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance). -> Text -- ^ The name of the production for this node. -> Range -- ^ The character range that the term occupies. - -> [Term Text (Record '[Range, Category])] -- ^ The child nodes of the term. - -> IO (Term Text (Record '[Range, Category])) -- ^ The resulting term, in IO. + -> [Term (S.Syntax Text) (Record '[Range, Category])] -- ^ The child nodes of the term. + -> IO (Term (S.Syntax Text) (Record '[Range, Category])) -- ^ The resulting term, in IO. termConstructor source sourceSpan name range children = withDefaultInfo <$> case (name, children) of ("ERROR", _) -> S.Error <$> sourceSpan <*> pure children diff --git a/src/Language/C.hs b/src/Language/C.hs index 81c0f4575..0cf8d2d52 100644 --- a/src/Language/C.hs +++ b/src/Language/C.hs @@ -6,6 +6,7 @@ import Info import Prologue import Source import SourceSpan +import Syntax import qualified Syntax as S import Term @@ -14,8 +15,8 @@ termConstructor -> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance). -> Text -- ^ The name of the production for this node. -> Range -- ^ The character range that the term occupies. - -> [Term Text (Record '[Range, Category])] -- ^ The child nodes of the term. - -> IO (Term Text (Record '[Range, Category])) -- ^ The resulting term, in IO. + -> [Term (Syntax Text) (Record '[Range, Category])] -- ^ The child nodes of the term. + -> IO (Term (Syntax Text) (Record '[Range, Category])) -- ^ The resulting term, in IO. termConstructor source sourceSpan name range children | name == "ERROR" = sourceSpan >>= withDefaultInfo . (`S.Error` children) | otherwise = withDefaultInfo $ case (name, children) of diff --git a/src/Language/JavaScript.hs b/src/Language/JavaScript.hs index e38a5aee5..5be276759 100644 --- a/src/Language/JavaScript.hs +++ b/src/Language/JavaScript.hs @@ -23,8 +23,8 @@ termConstructor -> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance). -> Text -- ^ The name of the production for this node. -> Range -- ^ The character range that the term occupies. - -> [Term Text (Record '[Range, Category])] -- ^ The child nodes of the term. - -> IO (Term Text (Record '[Range, Category])) -- ^ The resulting term, in IO. + -> [Term (S.Syntax Text) (Record '[Range, Category])] -- ^ The child nodes of the term. + -> IO (Term (S.Syntax Text) (Record '[Range, Category])) -- ^ The resulting term, in IO. termConstructor source sourceSpan name range children | name == "ERROR" = sourceSpan >>= withDefaultInfo . (`S.Error` children) | otherwise = withDefaultInfo $ case (name, children) of @@ -141,10 +141,10 @@ categoryForJavaScriptProductionName name = case name of "rel_op" -> RelationalOperator _ -> Other name -toVarDecl :: (HasField fields Category) => Term Text (Record fields) -> Term Text (Record fields) +toVarDecl :: (HasField fields Category) => Term (S.Syntax Text) (Record fields) -> Term (S.Syntax Text) (Record fields) toVarDecl child = cofree $ (setCategory (extract child) VarDecl :< S.VarDecl child) -toTuple :: Term Text (Record fields) -> [Term Text (Record fields)] +toTuple :: Term (S.Syntax Text) (Record fields) -> [Term (S.Syntax Text) (Record fields)] toTuple child | S.Indexed [key,value] <- unwrap child = [cofree (extract child :< S.Pair key value)] toTuple child | S.Fixed [key,value] <- unwrap child = [cofree (extract child :< S.Pair key value)] toTuple child | S.Leaf c <- unwrap child = [cofree (extract child :< S.Comment c)] diff --git a/src/Renderer.hs b/src/Renderer.hs index 76a478517..22fe93452 100644 --- a/src/Renderer.hs +++ b/src/Renderer.hs @@ -1,16 +1,17 @@ module Renderer (Renderer, DiffArguments(..), Output(..), concatOutputs, toSummaryKey, Format(..)) where -import Prologue -import Data.Functor.Both -import Diff -import Source (SourceBlob) -import Data.Text as T (intercalate) import Data.Aeson (Value, toEncoding) import Data.Aeson.Encoding (encodingToLazyByteString) +import Data.Functor.Both import Data.Map as Map hiding (null) +import Data.Text as T (intercalate) +import Diff +import Prologue +import Source (SourceBlob) +import Syntax -- | A function that will render a diff, given the two source blobs. -type Renderer annotation = Both SourceBlob -> Diff Text annotation -> Output +type Renderer annotation = Both SourceBlob -> Diff (Syntax Text) annotation -> Output data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath } deriving (Show) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 7292fac1f..04d25ec37 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -32,7 +32,7 @@ json blobs diff = JSONOutput $ Map.fromList [ -- | A numbered 'a'. newtype NumberedLine a = NumberedLine (Int, a) -instance (HasField fields Category, HasField fields Range) => ToJSON (NumberedLine (SplitDiff leaf (Record fields))) where +instance (HasField fields Category, HasField fields Range) => ToJSON (NumberedLine (SplitSyntaxDiff leaf fields)) where toJSON (NumberedLine (n, a)) = object (lineFields n a (getRange a)) toEncoding (NumberedLine (n, a)) = pairs $ mconcat (lineFields n a (getRange a)) instance ToJSON Category where @@ -40,24 +40,24 @@ instance ToJSON Category where toJSON s = String . T.pack $ show s instance ToJSON Range where toJSON (Range start end) = A.Array . Vector.fromList $ toJSON <$> [ start, end ] - toEncoding (Range start end) = foldable [ start, end ] + toEncoding (Range start end) = foldable [ start, end ] instance ToJSON a => ToJSON (Join These a) where toJSON (Join vs) = A.Array . Vector.fromList $ toJSON <$> these pure pure (\ a b -> [ a, b ]) vs toEncoding = foldable instance ToJSON a => ToJSON (Join (,) a) where toJSON (Join (a, b)) = A.Array . Vector.fromList $ toJSON <$> [ a, b ] -instance (HasField fields Category, HasField fields Range) => ToJSON (SplitDiff leaf (Record fields)) where +instance (HasField fields Category, HasField fields Range) => ToJSON (SplitSyntaxDiff leaf fields) where toJSON splitDiff = case runFree splitDiff of (Free (info :< syntax)) -> object (termFields info syntax) (Pure patch) -> object (patchFields patch) toEncoding splitDiff = case runFree splitDiff of (Free (info :< syntax)) -> pairs $ mconcat (termFields info syntax) (Pure patch) -> pairs $ mconcat (patchFields patch) -instance (HasField fields Category, HasField fields Range) => ToJSON (Term leaf (Record fields)) where +instance (HasField fields Category, HasField fields Range) => ToJSON (SyntaxTerm leaf fields) where toJSON term | (info :< syntax) <- runCofree term = object (termFields info syntax) toEncoding term | (info :< syntax) <- runCofree term = pairs $ mconcat (termFields info syntax) -lineFields :: (HasField fields Category, HasField fields Range) => KeyValue kv => Int -> SplitDiff leaf (Record fields) -> Range -> [kv] +lineFields :: (HasField fields Category, HasField fields Range) => KeyValue kv => Int -> SplitSyntaxDiff leaf fields -> Range -> [kv] lineFields n term range = [ "number" .= n , "terms" .= [ term ] , "range" .= range @@ -102,7 +102,7 @@ termFields info syntax = "range" .= characterRange info : "category" .= category S.Method identifier params definitions -> [ "methodIdentifier" .= identifier ] <> [ "params" .= params ] <> [ "definitions" .= definitions ] where childrenFields c = [ "children" .= c ] -patchFields :: (KeyValue kv, HasField fields Category, HasField fields Range) => SplitPatch (Term leaf (Record fields)) -> [kv] +patchFields :: (KeyValue kv, HasField fields Category, HasField fields Range) => SplitPatch (SyntaxTerm leaf fields) -> [kv] patchFields patch = case patch of SplitInsert term -> fields "insert" term SplitDelete term -> fields "delete" term diff --git a/src/Renderer/Patch.hs b/src/Renderer/Patch.hs index 27857ece7..afe474c42 100644 --- a/src/Renderer/Patch.hs +++ b/src/Renderer/Patch.hs @@ -53,7 +53,7 @@ rowIncrement :: Join These a -> Both (Sum Int) rowIncrement = Join . fromThese (Sum 0) (Sum 0) . runJoin . (Sum 1 <$) -- | Given the before and after sources, render a hunk to a string. -showHunk :: HasField fields Range => Both SourceBlob -> Hunk (SplitDiff a (Record fields)) -> String +showHunk :: Functor f => HasField fields Range => Both SourceBlob -> Hunk (SplitDiff f (Record fields)) -> String showHunk blobs hunk = maybeOffsetHeader <> concat (showChange sources <$> changes hunk) <> showLines (snd sources) ' ' (maybeSnd . runJoin <$> trailingContext hunk) @@ -66,18 +66,18 @@ showHunk blobs hunk = maybeOffsetHeader <> (offsetA, offsetB) = runJoin . fmap (show . getSum) $ offset hunk -- | Given the before and after sources, render a change to a string. -showChange :: HasField fields Range => Both (Source Char) -> Change (SplitDiff a (Record fields)) -> String +showChange :: Functor f => HasField fields Range => Both (Source Char) -> Change (SplitDiff f (Record fields)) -> String showChange sources change = showLines (snd sources) ' ' (maybeSnd . runJoin <$> context change) <> deleted <> inserted where (deleted, inserted) = runJoin $ pure showLines <*> sources <*> both '-' '+' <*> Join (unzip (fromThese Nothing Nothing . runJoin . fmap Just <$> contents change)) -- | Given a source, render a set of lines to a string with a prefix. -showLines :: HasField fields Range => Source Char -> Char -> [Maybe (SplitDiff leaf (Record fields))] -> String +showLines :: Functor f => HasField fields Range => Source Char -> Char -> [Maybe (SplitDiff f (Record fields))] -> String showLines source prefix lines = fromMaybe "" . mconcat $ fmap prepend . showLine source <$> lines where prepend "" = "" prepend source = prefix : source -- | Given a source, render a line to a string. -showLine :: HasField fields Range => Source Char -> Maybe (SplitDiff leaf (Record fields)) -> Maybe String +showLine :: Functor f => HasField fields Range => Source Char -> Maybe (SplitDiff f (Record fields)) -> Maybe String showLine source line | Just line <- line = Just . toString . (`slice` source) $ getRange line | otherwise = Nothing @@ -116,7 +116,7 @@ emptyHunk :: Hunk (SplitDiff a annotation) emptyHunk = Hunk { offset = mempty, changes = [], trailingContext = [] } -- | Render a diff as a series of hunks. -hunks :: HasField fields Range => Diff a (Record fields) -> Both SourceBlob -> [Hunk (SplitDiff a (Record fields))] +hunks :: HasField fields Range => SyntaxDiff leaf fields -> Both SourceBlob -> [Hunk (SplitSyntaxDiff leaf fields)] hunks _ blobs | sources <- source <$> blobs , sourcesEqual <- runBothWith (==) sources , sourcesNull <- runBothWith (&&) (null <$> sources) @@ -126,14 +126,14 @@ hunks diff blobs = hunksInRows (pure 1) $ alignDiff (source <$> blobs) diff -- | Given beginning line numbers, turn rows in a split diff into hunks in a -- | patch. -hunksInRows :: Both (Sum Int) -> [Join These (SplitDiff a annotation)] -> [Hunk (SplitDiff a annotation)] +hunksInRows :: (Prologue.Foldable f, Functor f) => Both (Sum Int) -> [Join These (SplitDiff f annotation)] -> [Hunk (SplitDiff f annotation)] hunksInRows start rows = case nextHunk start rows of Nothing -> [] Just (hunk, rest) -> hunk : hunksInRows (offset hunk <> hunkLength hunk) rest -- | Given beginning line numbers, return the next hunk and the remaining rows -- | of the split diff. -nextHunk :: Both (Sum Int) -> [Join These (SplitDiff a annotation)] -> Maybe (Hunk (SplitDiff a annotation), [Join These (SplitDiff a annotation)]) +nextHunk :: (Prologue.Foldable f, Functor f) => Both (Sum Int) -> [Join These (SplitDiff f annotation)] -> Maybe (Hunk (SplitDiff f annotation), [Join These (SplitDiff f annotation)]) nextHunk start rows = case nextChange start rows of Nothing -> Nothing Just (offset, change, rest) -> let (changes, rest') = contiguousChanges rest in Just (Hunk offset (change : changes) $ take 3 rest', drop 3 rest') @@ -145,7 +145,7 @@ nextHunk start rows = case nextChange start rows of -- | Given beginning line numbers, return the number of lines to the next -- | the next change, and the remaining rows of the split diff. -nextChange :: Both (Sum Int) -> [Join These (SplitDiff a annotation)] -> Maybe (Both (Sum Int), Change (SplitDiff a annotation), [Join These (SplitDiff a annotation)]) +nextChange :: (Prologue.Foldable f, Functor f) => Both (Sum Int) -> [Join These (SplitDiff f annotation)] -> Maybe (Both (Sum Int), Change (SplitDiff f annotation), [Join These (SplitDiff f annotation)]) nextChange start rows = case changeIncludingContext leadingContext afterLeadingContext of Nothing -> Nothing Just (change, afterChanges) -> Just (start <> mconcat (rowIncrement <$> skippedContext), change, afterChanges) @@ -155,12 +155,12 @@ nextChange start rows = case changeIncludingContext leadingContext afterLeadingC -- | Return a Change with the given context and the rows from the begginning of -- | the given rows that have changes, or Nothing if the first row has no -- | changes. -changeIncludingContext :: [Join These (SplitDiff a annotation)] -> [Join These (SplitDiff a annotation)] -> Maybe (Change (SplitDiff a annotation), [Join These (SplitDiff a annotation)]) +changeIncludingContext :: (Prologue.Foldable f, Functor f) => [Join These (SplitDiff f annotation)] -> [Join These (SplitDiff f annotation)] -> Maybe (Change (SplitDiff f annotation), [Join These (SplitDiff f annotation)]) changeIncludingContext leadingContext rows = case changes of [] -> Nothing _ -> Just (Change leadingContext changes, afterChanges) where (changes, afterChanges) = span rowHasChanges rows -- | Whether a row has changes on either side. -rowHasChanges :: Join These (SplitDiff a annotation) -> Bool +rowHasChanges :: (Prologue.Foldable f, Functor f) => Join These (SplitDiff f annotation) -> Bool rowHasChanges row = or (hasChanges <$> row) diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index 61fbb5831..40388b5d0 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -142,15 +142,15 @@ wrapIn f p = f p -- Instances -instance (ToMarkup f, HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (CofreeF (Syntax leaf) (Record fields) (f, Range))) where +instance (ToMarkup f, HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SyntaxTermF leaf fields (f, Range))) where toMarkup (Renderable source (info :< syntax)) = classifyMarkup (category info) $ case syntax of Leaf _ -> span . string . toString $ slice (characterRange info) source _ -> ul . mconcat $ wrapIn li <$> contentElements source (characterRange info) (toList syntax) -instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (Term leaf (Record fields))) where +instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SyntaxTerm leaf fields)) where toMarkup (Renderable source term) = Prologue.fst $ cata (\ t -> (toMarkup $ Renderable source t, characterRange (headF t))) term -instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SplitDiff leaf (Record fields))) where +instance (HasField fields Category, HasField fields Cost, HasField fields Range) => ToMarkup (Renderable (SplitSyntaxDiff leaf fields)) where toMarkup (Renderable source diff) = Prologue.fst . iter (\ t -> (toMarkup $ Renderable source t, characterRange (headF t))) $ toMarkupAndRange <$> diff where toMarkupAndRange patch = let term@(info :< _) = runCofree $ getSplitTerm patch in ((div ! patchAttribute patch `withCostAttribute` cost info) . toMarkup $ Renderable source (cofree term), characterRange info) diff --git a/src/SplitDiff.hs b/src/SplitDiff.hs index be23cc521..f78b0ac2d 100644 --- a/src/SplitDiff.hs +++ b/src/SplitDiff.hs @@ -4,7 +4,7 @@ import Data.Record import Info import Prologue import Syntax -import Term (Term) +import Term (Term, TermF) -- | A patch to only one side of a diff. data SplitPatch a = SplitInsert a | SplitDelete a | SplitReplace a @@ -17,10 +17,11 @@ getSplitTerm (SplitDelete a) = a getSplitTerm (SplitReplace a) = a -- | Get the range of a SplitDiff. -getRange :: HasField fields Range => SplitDiff leaf (Record fields) -> Range +getRange :: Functor f => HasField fields Range => SplitDiff f (Record fields) -> Range getRange diff = characterRange $ case runFree diff of Free annotated -> headF annotated Pure patch -> extract (getSplitTerm patch) -- | A diff with only one side’s annotations. -type SplitDiff leaf annotation = Free (CofreeF (Syntax leaf) annotation) (SplitPatch (Term leaf annotation)) +type SplitDiff f annotation = Free (TermF f annotation) (SplitPatch (Term f annotation)) +type SplitSyntaxDiff leaf fields = SplitDiff (Syntax leaf) (Record fields) diff --git a/src/Term.hs b/src/Term.hs index ad7d49e5f..e08e836b9 100644 --- a/src/Term.hs +++ b/src/Term.hs @@ -6,36 +6,40 @@ import Prologue import Data.Align.Generic import Data.Functor.Foldable as Foldable import Data.Functor.Both +import Data.Record import Data.These import Syntax -- | An annotated node (Syntax) in an abstract syntax tree. -type TermF a annotation = CofreeF (Syntax a) annotation -type Term a annotation = Cofree (Syntax a) annotation +type TermF = CofreeF +type Term f = Cofree f -type instance Base (Cofree f a) = CofreeF f a -instance Functor f => Foldable.Foldable (Cofree f a) where project = runCofree -instance Functor f => Foldable.Unfoldable (Cofree f a) where embed = cofree +type SyntaxTermF leaf fields = TermF (Syntax leaf) (Record fields) +type SyntaxTerm leaf fields = Term (Syntax leaf) (Record fields) + +type instance Base (Term f a) = TermF f a +instance Functor f => Foldable.Foldable (Term f a) where project = runCofree +instance Functor f => Foldable.Unfoldable (Term f a) where embed = cofree -- | Zip two terms by combining their annotations into a pair of annotations. -- | If the structure of the two terms don't match, then Nothing will be returned. -zipTerms :: (Eq a, Eq annotation) => Term a annotation -> Term a annotation -> Maybe (Term a (Both annotation)) +zipTerms :: (Eq annotation, Traversable f, GAlign f) => Term f annotation -> Term f annotation -> Maybe (Term f (Both annotation)) zipTerms t1 t2 = iter go (alignCofreeWith galign (const Nothing) both (These t1 t2)) where go (a :< s) = cofree . (a :<) <$> sequenceA s -- | Return the node count of a term. -termSize :: (Prologue.Foldable f, Functor f) => Cofree f annotation -> Int +termSize :: (Prologue.Foldable f, Functor f) => Term f annotation -> Int termSize = cata size where size (_ :< syntax) = 1 + sum syntax -- | Aligns (zips, retaining non-overlapping portions of the structure) a pair of terms. alignCofreeWith :: Functor f => (forall a b. f a -> f b -> Maybe (f (These a b))) -- ^ A function comparing a pair of structures, returning `Just` the combined structure if they are comparable (e.g. if they have the same constructor), and `Nothing` otherwise. The 'Data.Align.Generic.galign' function is usually what you want here. - -> (These (Cofree f a) (Cofree f b) -> contrasted) -- ^ A function mapping a 'These' of incomparable terms into 'Pure' values in the resulting tree. + -> (These (Term f a) (Term f b) -> contrasted) -- ^ A function mapping a 'These' of incomparable terms into 'Pure' values in the resulting tree. -> (a -> b -> combined) -- ^ A function mapping the input terms’ annotations into annotations in the 'Free' values in the resulting tree. - -> These (Cofree f a) (Cofree f b) -- ^ The input terms. - -> Free (CofreeF f combined) contrasted + -> These (Term f a) (Term f b) -- ^ The input terms. + -> Free (TermF f combined) contrasted alignCofreeWith compare contrast combine = go where go terms = fromMaybe (pure (contrast terms)) $ case terms of These t1 t2 -> wrap . (combine (extract t1) (extract t2) :<) . fmap go <$> compare (unwrap t1) (unwrap t2) diff --git a/src/Term/Arbitrary.hs b/src/Term/Arbitrary.hs index c79b572b7..2f34c8454 100644 --- a/src/Term/Arbitrary.hs +++ b/src/Term/Arbitrary.hs @@ -11,10 +11,10 @@ import Test.QuickCheck hiding (Fixed) data ArbitraryTerm leaf annotation = ArbitraryTerm { annotation :: annotation, syntax :: Syntax leaf (ArbitraryTerm leaf annotation)} deriving (Show, Eq, Generic) -unArbitraryTerm :: ArbitraryTerm leaf annotation -> TermF leaf annotation (ArbitraryTerm leaf annotation) +unArbitraryTerm :: ArbitraryTerm leaf annotation -> TermF (Syntax leaf) annotation (ArbitraryTerm leaf annotation) unArbitraryTerm (ArbitraryTerm a s) = a :< s -toTerm :: ArbitraryTerm leaf annotation -> Term leaf annotation +toTerm :: ArbitraryTerm leaf annotation -> Term (Syntax leaf) annotation toTerm = unfold unArbitraryTerm termOfSize :: (Arbitrary leaf, Arbitrary annotation) => Int -> Gen (ArbitraryTerm leaf annotation) @@ -26,7 +26,7 @@ arbitraryTermSize = cata (succ . sum) . toTerm -- Instances -type instance Base (ArbitraryTerm leaf annotation) = TermF leaf annotation +type instance Base (ArbitraryTerm leaf annotation) = TermF (Syntax leaf) annotation instance Unfoldable (ArbitraryTerm leaf annotation) where embed (a :< s) = ArbitraryTerm a s instance (Eq leaf, Eq annotation, Arbitrary leaf, Arbitrary annotation) => Arbitrary (ArbitraryTerm leaf annotation) where diff --git a/test/AlignmentSpec.hs b/test/AlignmentSpec.hs index e9f4f2e07..3a64abdca 100644 --- a/test/AlignmentSpec.hs +++ b/test/AlignmentSpec.hs @@ -32,7 +32,7 @@ spec :: Spec spec = parallel $ do describe "alignBranch" $ do it "produces symmetrical context" $ - alignBranch getRange ([] :: [Join These (SplitDiff String (Record '[Range]))]) (both [Range 0 2, Range 2 4] [Range 0 2, Range 2 4]) `shouldBe` + alignBranch getRange ([] :: [Join These (SplitDiff (Syntax String) (Record '[Range]))]) (both [Range 0 2, Range 2 4] [Range 0 2, Range 2 4]) `shouldBe` [ Join (These (Range 0 2, []) (Range 0 2, [])) , Join (These (Range 2 4, []) @@ -40,7 +40,7 @@ spec = parallel $ do ] it "produces asymmetrical context" $ - alignBranch getRange ([] :: [Join These (SplitDiff String (Record '[Range]))]) (both [Range 0 2, Range 2 4] [Range 0 1]) `shouldBe` + alignBranch getRange ([] :: [Join These (SplitDiff (Syntax String) (Record '[Range]))]) (both [Range 0 2, Range 2 4] [Range 0 1]) `shouldBe` [ Join (These (Range 0 2, []) (Range 0 1, [])) , Join (This (Range 2 4, [])) @@ -231,7 +231,7 @@ toAlignBranchInputs elements = (sources, join . (`evalState` both 0 0) . travers branchElementContents (Margin contents) = contents keysOfAlignedChildren :: [Join These (Range, [(String, Range)])] -> [String] -keysOfAlignedChildren lines = lines >>= these identity identity (++) . runJoin . fmap (fmap Prologue.fst . Prologue.snd) +keysOfAlignedChildren lines = lines >>= these identity identity (<>) . runJoin . fmap (fmap Prologue.fst . Prologue.snd) joinCrosswalk :: Bicrosswalk p => Align f => (a -> f b) -> Join p a -> f (Join p b) joinCrosswalk f = fmap Join . bicrosswalk f f . runJoin @@ -257,13 +257,13 @@ instance Arbitrary BranchElement where counts :: [Join These (Int, a)] -> Both Int counts numbered = fromMaybe 0 . getLast . mconcat . fmap Last <$> Join (unalign (runJoin . fmap Prologue.fst <$> numbered)) -align :: Both (Source.Source Char) -> ConstructibleFree (Patch (Term String (Record '[Range]))) (Both (Record '[Range])) -> PrettyDiff (SplitDiff String (Record '[Range])) +align :: Both (Source.Source Char) -> ConstructibleFree (Patch (Term (Syntax String) (Record '[Range]))) (Both (Record '[Range])) -> PrettyDiff (SplitDiff (Syntax String) (Record '[Range])) align sources = PrettyDiff sources . fmap (fmap (getRange &&& identity)) . alignDiff sources . deconstruct info :: Int -> Int -> Record '[Range] info start end = Range start end .: RNil -prettyDiff :: Both (Source.Source Char) -> [Join These (ConstructibleFree (SplitPatch (Term String (Record '[Range]))) (Record '[Range]))] -> PrettyDiff (SplitDiff String (Record '[Range])) +prettyDiff :: Both (Source.Source Char) -> [Join These (ConstructibleFree (SplitPatch (Term (Syntax String) (Record '[Range]))) (Record '[Range]))] -> PrettyDiff (SplitDiff (Syntax String) (Record '[Range])) prettyDiff sources = PrettyDiff sources . fmap (fmap ((getRange &&& identity) . deconstruct)) data PrettyDiff a = PrettyDiff { unPrettySources :: Both (Source.Source Char), unPrettyLines :: [Join These (Range, a)] } @@ -273,23 +273,23 @@ instance Show a => Show (PrettyDiff a) where showsPrec _ (PrettyDiff sources lines) = (prettyPrinted ++) -- . (("\n" ++ show lines) ++) where prettyPrinted = showLine (maximum (0 : (maximum . fmap length <$> shownLines))) <$> shownLines >>= ('\n':) shownLines = catMaybes $ toBoth <$> lines - showLine n line = uncurry ((++) . (++ " | ")) (fromThese (replicate n ' ') (replicate n ' ') (runJoin (pad n <$> line))) + showLine n line = uncurry ((<>) . (++ " | ")) (fromThese (replicate n ' ') (replicate n ' ') (runJoin (pad n <$> line))) showDiff (range, _) = filter (/= '\n') . toList . Source.slice range - pad n string = (++) (take n string) (replicate (max 0 (n - length string)) ' ') + pad n string = (<>) (take n string) (replicate (max 0 (n - length string)) ' ') toBoth them = showDiff <$> them `applyThese` modifyJoin (uncurry These) sources newtype ConstructibleFree patch annotation = ConstructibleFree { deconstruct :: Free (CofreeF (Syntax String) annotation) patch } class PatchConstructible p where - insert :: Term String (Record '[Range]) -> p - delete :: Term String (Record '[Range]) -> p + insert :: Term (Syntax String) (Record '[Range]) -> p + delete :: Term (Syntax String) (Record '[Range]) -> p -instance PatchConstructible (Patch (Term String (Record '[Range]))) where +instance PatchConstructible (Patch (Term (Syntax String) (Record '[Range]))) where insert = Insert delete = Delete -instance PatchConstructible (SplitPatch (Term String (Record '[Range]))) where +instance PatchConstructible (SplitPatch (Term (Syntax String) (Record '[Range]))) where insert = SplitInsert delete = SplitDelete diff --git a/test/Data/RandomWalkSimilarity/Spec.hs b/test/Data/RandomWalkSimilarity/Spec.hs index 118e72898..66e68f006 100644 --- a/test/Data/RandomWalkSimilarity/Spec.hs +++ b/test/Data/RandomWalkSimilarity/Spec.hs @@ -21,14 +21,14 @@ spec = parallel $ do let positively = succ . abs describe "pqGramDecorator" $ do prop "produces grams with stems of the specified length" $ - \ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (toTerm term :: Term Text (Record '[Text])) `shouldSatisfy` all ((== (positively p)) . length . stem . rhead) + \ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (toTerm term :: Term (Syntax Text) (Record '[Text])) `shouldSatisfy` all ((== (positively p)) . length . stem . rhead) prop "produces grams with bases of the specified width" $ - \ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (toTerm term :: Term Text (Record '[Text])) `shouldSatisfy` all ((== (positively q)) . length . base . rhead) + \ (term, p, q) -> pqGramDecorator (rhead . headF) (positively p) (positively q) (toTerm term :: Term (Syntax Text) (Record '[Text])) `shouldSatisfy` all ((== (positively q)) . length . base . rhead) describe "featureVectorDecorator" $ do prop "produces a vector of the specified dimension" $ - \ (term, p, q, d) -> featureVectorDecorator (rhead . headF) (positively p) (positively q) (positively d) (toTerm term :: Term Text (Record '[Text])) `shouldSatisfy` all ((== (positively d)) . length . rhead) + \ (term, p, q, d) -> featureVectorDecorator (rhead . headF) (positively p) (positively q) (positively d) (toTerm term :: Term (Syntax Text) (Record '[Text])) `shouldSatisfy` all ((== (positively d)) . length . rhead) describe "rws" $ do let decorate = defaultFeatureVectorDecorator (category . headF) diff --git a/test/DiffSummarySpec.hs b/test/DiffSummarySpec.hs index d0d950dbf..f96bb5eed 100644 --- a/test/DiffSummarySpec.hs +++ b/test/DiffSummarySpec.hs @@ -26,7 +26,7 @@ arrayInfo = ArrayLiteral .: Range 0 3 .: RNil literalInfo :: Record '[Category, Range] literalInfo = StringLiteral .: Range 1 2 .: RNil -testDiff :: Diff Text (Record '[Category, Range]) +testDiff :: Diff (Syntax Text) (Record '[Category, Range]) testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "a")) ]) testSummary :: DiffSummary DiffInfo @@ -67,7 +67,7 @@ spec = parallel $ do extractLeaves (BranchInfo children _ _) = join $ extractLeaves <$> children extractLeaves leaf = [ leaf ] - extractDiffLeaves :: Term Text (Record '[Category, Range]) -> [ Term Text (Record '[Category, Range]) ] + extractDiffLeaves :: Term (Syntax Text) (Record '[Category, Range]) -> [ Term (Syntax Text) (Record '[Category, Range]) ] extractDiffLeaves term = case unwrap term of (Indexed children) -> join $ extractDiffLeaves <$> children (Fixed children) -> join $ extractDiffLeaves <$> children @@ -81,7 +81,7 @@ spec = parallel $ do in length listOfLeaves `shouldBe` length listOfDiffLeaves -isIndexedOrFixed :: Patch (Term a annotation) -> Bool +isIndexedOrFixed :: Patch (Term (Syntax a) annotation) -> Bool isIndexedOrFixed = any (isIndexedOrFixed' . unwrap) isIndexedOrFixed' :: Syntax a f -> Bool diff --git a/vendor/text-icu b/vendor/text-icu index 6d07c2b20..3ba9cfc43 160000 --- a/vendor/text-icu +++ b/vendor/text-icu @@ -1 +1 @@ -Subproject commit 6d07c2b2034f2bfdcd038de0d6a3ceca445f0221 +Subproject commit 3ba9cfc432eb9ee9193e453120b200fa01d6c664