From 3f608573212111c9d2ef662db72a7141cf18084d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 19 Jan 2017 16:00:12 -0500 Subject: [PATCH] Merge branch 'better-record-pattern-matches' into consolidate-common-term-assignment-patterns --- src/Data/RandomWalkSimilarity.hs | 18 +++++----- src/Data/Record.hs | 36 +++++++++----------- src/FDoc/RecursionSchemes.hs | 46 +++++++++++++------------- src/FDoc/Term.hs | 8 ++--- src/Language.hs | 2 +- src/Language/C.hs | 2 +- src/Language/Go.hs | 4 +-- src/Language/JavaScript.hs | 4 +-- src/Language/Markdown.hs | 2 +- src/Language/Ruby.hs | 2 +- src/Parse.hs | 6 ++-- src/Range.hs | 2 +- test/AlignmentSpec.hs | 2 +- test/Data/RandomWalkSimilarity/Spec.hs | 6 ++-- test/DiffSummarySpec.hs | 4 +-- test/InterpreterSpec.hs | 12 +++---- test/PatchOutputSpec.hs | 2 +- 17 files changed, 77 insertions(+), 81 deletions(-) diff --git a/src/Data/RandomWalkSimilarity.hs b/src/Data/RandomWalkSimilarity.hs index deded9cbe..c944b3304 100644 --- a/src/Data/RandomWalkSimilarity.hs +++ b/src/Data/RandomWalkSimilarity.hs @@ -74,18 +74,18 @@ rws compare getLabel as bs (featurizedAs, featurizedBs, _, _, countersAndDiffs, allDiffs) = foldl' (\(as, bs, counterA, counterB, diffs, allDiffs) diff -> case runFree diff of Pure (Right (Delete term)) -> - (as <> pure (featurize counterA term), bs, succ counterA, counterB, diffs, allDiffs <> pure Nil) + (as <> pure (featurize counterA term), bs, succ counterA, counterB, diffs, allDiffs <> pure None) Pure (Right (Insert term)) -> (as, bs <> pure (featurize counterB term), counterA, succ counterB, diffs, allDiffs <> pure (Term (featurize counterB term))) syntax -> let diff' = free syntax >>= either identity pure in (as, bs, succ counterA, succ counterB, diffs <> pure (These counterA counterB, diff'), allDiffs <> pure (Index counterA)) ) ([], [], 0, 0, [], []) sesDiffs - findNearestNeighbourToDiff :: TermOrIndexOrNil (UnmappedTerm f fields) + findNearestNeighbourToDiff :: TermOrIndexOrNone (UnmappedTerm f fields) -> State (Int, UnmappedTerms f fields, UnmappedTerms f fields) (Maybe (These Int Int, Diff f (Record fields))) findNearestNeighbourToDiff termThing = case termThing of - Nil -> pure Nothing + None -> pure Nothing Term term -> Just <$> findNearestNeighbourTo term Index i -> do (_, unA, unB) <- get @@ -224,7 +224,7 @@ data UnmappedTerm f fields = UnmappedTerm { } -- | Either a `term`, an index of a matched term, or nil. -data TermOrIndexOrNil term = Term term | Index Int | Nil +data TermOrIndexOrNone term = Term term | Index Int | None -- | An IntMap of unmapped terms keyed by their position in a list of terms. type UnmappedTerms f fields = IntMap (UnmappedTerm f fields) @@ -244,8 +244,8 @@ defaultFeatureVectorDecorator getLabel = featureVectorDecorator getLabel default -- | Annotates a term with a feature vector at each node, parameterized by stem length, base width, and feature vector dimensions. featureVectorDecorator :: (Hashable label, Traversable f) => Label f fields label -> Int -> Int -> Int -> Term f (Record fields) -> Term f (Record (Vector.Vector Double ': fields)) featureVectorDecorator getLabel p q d - = cata (\ (RCons gram rest :< functor) -> - cofree ((foldr (Vector.zipWith (+) . getField . extract) (unitVector d (hash gram)) functor .: rest) :< functor)) + = cata (\ ((gram :. rest) :< functor) -> + cofree ((foldr (Vector.zipWith (+) . getField . extract) (unitVector d (hash gram)) functor :. rest) :< functor)) . pqGramDecorator getLabel p q -- | Annotates a term with the corresponding p,q-gram at each node. @@ -259,7 +259,7 @@ pqGramDecorator pqGramDecorator getLabel p q = cata algebra where algebra term = let label = getLabel term in - cofree ((gram label .: headF term) :< assignParentAndSiblingLabels (tailF term) label) + cofree ((gram label :. headF term) :< assignParentAndSiblingLabels (tailF term) label) gram label = Gram (padToSize p []) (padToSize q (pure (Just label))) assignParentAndSiblingLabels functor label = (`evalState` (replicate (q `div` 2) Nothing <> siblingLabels functor)) (for functor (assignLabels label)) @@ -267,10 +267,10 @@ pqGramDecorator getLabel p q = cata algebra -> Term f (Record (Gram label ': fields)) -> State [Maybe label] (Term f (Record (Gram label ': fields))) assignLabels label a = case runCofree a of - RCons gram rest :< functor -> do + (gram :. rest) :< functor -> do labels <- get put (drop 1 labels) - pure $! cofree ((gram { stem = padToSize p (Just label : stem gram), base = padToSize q labels } .: rest) :< functor) + pure $! cofree ((gram { stem = padToSize p (Just label : stem gram), base = padToSize q labels } :. rest) :< functor) siblingLabels :: Traversable f => f (Term f (Record (Gram label ': fields))) -> [Maybe label] siblingLabels = foldMap (base . rhead . extract) padToSize n list = take n (list <> repeat empty) diff --git a/src/Data/Record.hs b/src/Data/Record.hs index 4c5f68bd1..bb645fb37 100644 --- a/src/Data/Record.hs +++ b/src/Data/Record.hs @@ -17,22 +17,18 @@ type DefaultFields fields = (HasField fields Category, HasField fields Range, Ha -- | -- | This is heavily inspired by Aaron Levin’s [Extensible Effects in the van Laarhoven Free Monad](http://aaronlevin.ca/post/136494428283/extensible-effects-in-the-van-laarhoven-free-monad). data Record :: [*] -> * where - RNil :: Record '[] - RCons :: h -> Record t -> Record (h ': t) + Nil :: Record '[] + (:.) :: h -> Record t -> Record (h ': t) -infixr 0 .: - --- | Infix synonym for `RCons`: `a .: b .: RNil == RCons a (RCons b RNil)`. -(.:) :: h -> Record t -> Record (h ': t) -(.:) = RCons +infixr 0 :. -- | Get the first element of a non-empty record. rhead :: Record (head ': tail) -> head -rhead (RCons head _) = head +rhead (head :. _) = head -- | Get the first element of a non-empty record. rtail :: Record (head ': tail) -> Record tail -rtail (RCons _ tail) = tail +rtail (_ :. tail) = tail -- Classes @@ -48,19 +44,19 @@ class HasField (fields :: [*]) (field :: *) where -- OVERLAPPABLE is required for the HasField instances so that we can handle the two cases: either the head of the non-empty h-list is the requested field, or it isn’t. The third possible case (the h-list is empty) is rejected at compile-time. instance {-# OVERLAPPABLE #-} HasField fields field => HasField (notIt ': fields) field where - getField (RCons _ t) = getField t - setField (RCons h t) f = RCons h (setField t f) + getField (_ :. t) = getField t + setField (h :. t) f = h :. setField t f instance {-# OVERLAPPABLE #-} HasField (field ': fields) field where - getField (RCons h _) = h - setField (RCons _ t) f = RCons f t + getField (h :. _) = h + setField (_ :. t) f = f :. t instance (Show h, Show (Record t)) => Show (Record (h ': t)) where - showsPrec n (RCons h t) = showParen (n > 0) $ showsPrec 1 h . (" .: " <>) . shows t + showsPrec n (h :. t) = showParen (n > 0) $ showsPrec 1 h . (" :. " <>) . shows t instance Show (Record '[]) where - showsPrec n RNil = showParen (n > 0) ("RNil" <>) + showsPrec n Nil = showParen (n > 0) ("Nil" <>) instance (ToJSON h, ToJSONList (Record t)) => ToJSON (Record (h ': t)) where toJSON r = toJSONList (toJSONValues r) @@ -72,21 +68,21 @@ class ToJSONList t where toJSONValues :: t -> [Value] instance (ToJSON h, ToJSONList (Record t)) => ToJSONList (Record (h ': t)) where - toJSONValues (RCons h t) = toJSON h : toJSONValues t + toJSONValues (h :. t) = toJSON h : toJSONValues t instance ToJSONList (Record '[]) where toJSONValues _ = [] instance (Eq h, Eq (Record t)) => Eq (Record (h ': t)) where - RCons h1 t1 == RCons h2 t2 = h1 == h2 && t1 == t2 + (h1 :. t1) == (h2 :. t2) = h1 == h2 && t1 == t2 instance Eq (Record '[]) where _ == _ = True instance (Ord h, Ord (Record t)) => Ord (Record (h ': t)) where - RCons h1 t1 `compare` RCons h2 t2 = let h = h1 `compare` h2 in + (h1 :. t1) `compare` (h2 :. t2) = let h = h1 `compare` h2 in if h == EQ then t1 `compare` t2 else h instance Ord (Record '[]) where @@ -94,7 +90,7 @@ instance Ord (Record '[]) where instance (Listable head, Listable (Record tail)) => Listable (Record (head ': tail)) where - tiers = cons2 RCons + tiers = cons2 (:.) instance Listable (Record '[]) where - tiers = cons0 RNil + tiers = cons0 Nil diff --git a/src/FDoc/RecursionSchemes.hs b/src/FDoc/RecursionSchemes.hs index b9c149513..772c6677c 100644 --- a/src/FDoc/RecursionSchemes.hs +++ b/src/FDoc/RecursionSchemes.hs @@ -28,7 +28,7 @@ The example below adds a new field to the `Record` fields. indexedTermAna :: [leaf] -> Term (Syntax leaf) (Record '[NewField, Range, Category]) indexedTermAna childrenLeaves = ana coalgebra (indexedTerm childrenLeaves) where - coalgebra term = (NewField .: (extract term)) :< unwrap term + coalgebra term = (NewField :. (extract term)) :< unwrap term {- Catamorphism example -- add a new field to each term's Record fields @@ -47,7 +47,7 @@ indexedTermCata :: [leaf] -> Term (Syntax leaf) (Record '[NewField, Range, Categ indexedTermCata childrenLeaves = cata algebra (indexedTerm childrenLeaves) where algebra :: CofreeF f (Record t) (Cofree f (Record (NewField : t))) -> Cofree f (Record (NewField : t)) - algebra term = cofree $ (NewField .: (headF term)) :< tailF term + algebra term = cofree $ (NewField :. (headF term)) :< tailF term {- Anamorphism -- construct a Term from a string @@ -58,25 +58,25 @@ representation. Example usage: stringToTermAna "indexed" => - CofreeT (Identity ( (Range {start = 1, end = 10} .: MethodCall .: RNil) + CofreeT (Identity ( (Range {start = 1, end = 10} :. MethodCall :. Nil) :< Indexed - [ CofreeT (Identity ( (Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf1" ) ) - , CofreeT (Identity ( (Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf2" ) ) - , CofreeT (Identity ( (Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf3" ) ) + [ CofreeT (Identity ( (Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf1" ) ) + , CofreeT (Identity ( (Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf2" ) ) + , CofreeT (Identity ( (Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf3" ) ) ] )) First step is to match against the "indexed" string and begin building up a Cofree Indexed structure: - CofreeT (Identity ( (Range 1 10 .: Category.MethodCall .: RNil) :< Indexed ["leaf1", "leaf2", "leaf3"] ) ) + CofreeT (Identity ( (Range 1 10 :. Category.MethodCall :. Nil) :< Indexed ["leaf1", "leaf2", "leaf3"] ) ) While building up the `Indexed` structure, we continue to recurse over the `Indexed` terms ["leaf1", "leaf2", "leaf3"]. These are pattern matched using the catch all `_` and default to `Leaf` Syntax shapes: - CofreeT (Identity ( (Range 1 10 .: Category.MethodCall .: RNil) :< Leaf "leaf1" ) ) - CofreeT (Identity ( (Range 1 10 .: Category.MethodCall .: RNil) :< Leaf "leaf2" ) ) - CofreeT (Identity ( (Range 1 10 .: Category.MethodCall .: RNil) :< Leaf "leaf3" ) ) + CofreeT (Identity ( (Range 1 10 :. Category.MethodCall :. Nil) :< Leaf "leaf1" ) ) + CofreeT (Identity ( (Range 1 10 :. Category.MethodCall :. Nil) :< Leaf "leaf2" ) ) + CofreeT (Identity ( (Range 1 10 :. Category.MethodCall :. Nil) :< Leaf "leaf3" ) ) These structures are substituted in place of ["leaf1", "leaf2", "leaf3"] in the new cofree `Indexed` structure, resulting in a expansion of all possible @@ -86,8 +86,8 @@ stringToTermAna :: String -> Term (Syntax String) (Record '[Range, Category]) stringToTermAna = ana coalgebra where coalgebra representation = case representation of - "indexed" -> (Range 1 10 .: Category.MethodCall .: RNil) :< Indexed ["leaf1", "leaf2", "leaf3"] - _ -> (Range 1 10 .: Category.MethodCall .: RNil) :< Leaf representation + "indexed" -> (Range 1 10 :. Category.MethodCall :. Nil) :< Indexed ["leaf1", "leaf2", "leaf3"] + _ -> (Range 1 10 :. Category.MethodCall :. Nil) :< Leaf representation {- Catamorphism -- construct a list of Strings from a recursive Term structure. @@ -131,8 +131,8 @@ stringTermHylo = hylo algebra coalgebra (_ :< Indexed values) -> ["indexed"] <> Prologue.concat values _ -> ["unknown"] coalgebra stringRepresentation = case stringRepresentation of - "indexed" -> (Range 1 10 .: Category.MethodCall .: RNil) :< Indexed ["leaf1", "leaf2", "leaf3"] - _ -> (Range 1 10 .: Category.MethodCall .: RNil) :< Leaf stringRepresentation + "indexed" -> (Range 1 10 :. Category.MethodCall :. Nil) :< Indexed ["leaf1", "leaf2", "leaf3"] + _ -> (Range 1 10 :. Category.MethodCall :. Nil) :< Leaf stringRepresentation {- Paramorphism -- primitive recursion that maintains a reference to the original value and its computed value. @@ -158,22 +158,22 @@ Example Usage: let terms = indexedTerm ["leaf1", "leaf2", "leaf3"] termPara terms = Recurse over the structure to start at the leaves (bottom up traversal): -tuple3 = ( CofreeT (Identity ((Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf3")), "leaf3" ) : [] +tuple3 = ( CofreeT (Identity ((Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf3")), "leaf3" ) : [] Continue the traversal from leaves to root: -tuple2:3 = ( CofreeT (Identity ((Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf2")), "leaf2") : tuple3 +tuple2:3 = ( CofreeT (Identity ((Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf2")), "leaf2") : tuple3 -tuple1:2:3 = ( CofreeT (Identity ((Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf1" )), "leaf1") : tuple2:3 +tuple1:2:3 = ( CofreeT (Identity ((Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf1" )), "leaf1") : tuple2:3 Compute the root: -tupleIndexed:1:2:3 = ( CofreeT (Identity ((Range {start = 1, end = 10} .: MethodCall .: RNil) :< Indexed [])), "indexed" ) : tuple1:2:3 +tupleIndexed:1:2:3 = ( CofreeT (Identity ((Range {start = 1, end = 10} :. MethodCall :. Nil) :< Indexed [])), "indexed" ) : tuple1:2:3 Final shape: -[ (CofreeT (Identity ((Range {start = 1, end = 10} .: MethodCall .: RNil) :< Indexed [])) , "indexed") -, (CofreeT (Identity ((Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf1")), "leaf1") -, (CofreeT (Identity ((Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf2")), "leaf2") -, (CofreeT (Identity ((Range {start = 1, end = 10} .: MethodCall .: RNil) :< Leaf "leaf3")), "leaf3") +[ (CofreeT (Identity ((Range {start = 1, end = 10} :. MethodCall :. Nil) :< Indexed [])) , "indexed") +, (CofreeT (Identity ((Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf1")), "leaf1") +, (CofreeT (Identity ((Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf2")), "leaf2") +, (CofreeT (Identity ((Range {start = 1, end = 10} :. MethodCall :. Nil) :< Leaf "leaf3")), "leaf3") ] -} @@ -183,4 +183,4 @@ termPara = para algebra algebra term = case term of (annotation :< Leaf representation) -> [(cofree (annotation :< Leaf representation), representation)] (annotation :< Indexed values) -> [(cofree (annotation :< Indexed []), "indexed")] <> (values >>= Prelude.snd) - _ -> [(cofree ((Range 1 10 .: Category.MethodCall .: RNil) :< Leaf "unknown"), "unknown")] + _ -> [(cofree ((Range 1 10 :. Category.MethodCall :. Nil) :< Leaf "unknown"), "unknown")] diff --git a/src/FDoc/Term.hs b/src/FDoc/Term.hs index 288c2fcbd..5f894f486 100644 --- a/src/FDoc/Term.hs +++ b/src/FDoc/Term.hs @@ -26,14 +26,14 @@ Example (from GHCi): > let leaf = leafTermF "example" > headF leaf -> Range {start = 1, end = 10} .: MethodCall .: RNil +> Range {start = 1, end = 10} :. MethodCall :. Nil > tailF leaf > Leaf "example" -} leafTermF :: leaf -> TermF (Syntax leaf) (Record '[Range, Category]) b -leafTermF leaf = (Range 1 10 .: Category.MethodCall .: RNil) :< Leaf leaf +leafTermF leaf = (Range 1 10 :. Category.MethodCall :. Nil) :< Leaf leaf {- @@ -52,7 +52,7 @@ Example (from GHCi): > let leaf = leafTerm "example" > extract leaf -> Range {start = 1, end = 10} .: MethodCall .: RNil +> Range {start = 1, end = 10} :. MethodCall :. Nil > unwrap leaf > Leaf "example" @@ -61,7 +61,7 @@ leafTerm :: leaf -> Cofree (Syntax leaf) (Record '[Range, Category]) leafTerm = cofree . leafTermF indexedTermF :: [leaf] -> TermF (Syntax leaf) (Record '[Range, Category]) (Term (Syntax leaf) (Record '[Range, Category])) -indexedTermF leaves = (Range 1 10 .: Category.MethodCall .: RNil) :< (Indexed (leafTerm <$> leaves)) +indexedTermF leaves = (Range 1 10 :. Category.MethodCall :. Nil) :< (Indexed (leafTerm <$> leaves)) indexedTerm :: [leaf] -> Term (Syntax leaf) (Record '[Range, Category]) indexedTerm leaves = cofree $ indexedTermF leaves diff --git a/src/Language.hs b/src/Language.hs index 4a395f484..49527f14f 100644 --- a/src/Language.hs +++ b/src/Language.hs @@ -56,7 +56,7 @@ termConstructor source sourceSpan category range children _ = _ -> S.Indexed children where withDefaultInfo syntax = - pure $! cofree ((range .: category .: sourceSpan .: RNil) :< syntax) + pure $! cofree ((range :. category :. sourceSpan :. Nil) :< syntax) 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 Nothing diff --git a/src/Language/C.hs b/src/Language/C.hs index cca133032..313752222 100644 --- a/src/Language/C.hs +++ b/src/Language/C.hs @@ -22,7 +22,7 @@ termConstructor source sourceSpan category range children _ [] -> S.Leaf . toText $ slice range source _ -> S.Indexed children where - withDefaultInfo syntax = pure $! cofree ((range .: category .: sourceSpan .: RNil) :< syntax) + withDefaultInfo syntax = pure $! cofree ((range :. category :. sourceSpan :. Nil) :< syntax) categoryForCProductionName :: Text -> Category categoryForCProductionName = Other diff --git a/src/Language/Go.hs b/src/Language/Go.hs index e6768a990..25896a25f 100644 --- a/src/Language/Go.hs +++ b/src/Language/Go.hs @@ -236,10 +236,10 @@ termConstructor source sourceSpan category range children _ = pure $! case categ let ranges' = getField . extract <$> terms sourceSpans' = getField . extract <$> terms in - cofree ((unionRangesFrom originalRange ranges' .: category' .: unionSourceSpansFrom sourceSpan sourceSpans' .: RNil) :< syntax) + cofree ((unionRangesFrom originalRange ranges' :. category' :. unionSourceSpansFrom sourceSpan sourceSpans' :. Nil) :< syntax) withCategory category syntax = - cofree ((range .: category .: sourceSpan .: RNil) :< syntax) + cofree ((range :. category :. sourceSpan :. Nil) :< syntax) withDefaultInfo = withCategory category diff --git a/src/Language/JavaScript.hs b/src/Language/JavaScript.hs index b2eb1b4a9..588435129 100644 --- a/src/Language/JavaScript.hs +++ b/src/Language/JavaScript.hs @@ -105,8 +105,8 @@ termConstructor source sourceSpan category range children allChildren where withDefaultInfo syntax = pure $! case syntax of - S.MethodCall{} -> cofree ((range .: MethodCall .: sourceSpan .: RNil) :< syntax) - _ -> cofree ((range .: category .: sourceSpan .: RNil) :< syntax) + S.MethodCall{} -> cofree ((range :. MethodCall :. sourceSpan :. Nil) :< syntax) + _ -> cofree ((range :. category :. sourceSpan :. Nil) :< syntax) categoryForJavaScriptProductionName :: Text -> Category categoryForJavaScriptProductionName name = case name of diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs index 62ed99fcb..3d314459c 100644 --- a/src/Language/Markdown.hs +++ b/src/Language/Markdown.hs @@ -19,7 +19,7 @@ cmarkParser SourceBlob{..} = pure . toTerm (totalRange source) (rangeToSourceSpa range = maybe within (sourceSpanToRange source . toSpan) position span = maybe withinSpan toSpan position in - cofree $ (range .: toCategory t .: span .: RNil) :< case t of + cofree $ (range :. toCategory t :. span :. Nil) :< case t of -- Leaves CODE text -> Leaf text TEXT text -> Leaf text diff --git a/src/Language/Ruby.hs b/src/Language/Ruby.hs index c1e71e1c3..c6cff83b3 100644 --- a/src/Language/Ruby.hs +++ b/src/Language/Ruby.hs @@ -124,7 +124,7 @@ termConstructor source sourceSpan category range children allChildren where withRecord record syntax = cofree (record :< syntax) withCategory category syntax = - cofree ((range .: category .: sourceSpan .: RNil) :< syntax) + cofree ((range :. category :. sourceSpan :. Nil) :< syntax) withDefaultInfo syntax = case syntax of S.MethodCall{} -> withCategory MethodCall syntax _ -> withCategory category syntax diff --git a/src/Parse.hs b/src/Parse.hs index 184081186..f1730dfef 100644 --- a/src/Parse.hs +++ b/src/Parse.hs @@ -81,7 +81,7 @@ parserForType mediaType = case languageForType mediaType of -- | Decorate a 'Term' using a function to compute the annotation values at every node. decorateTerm :: (Functor f) => TermDecorator f fields field -> Term f (Record fields) -> Term f (Record (field ': fields)) -decorateTerm decorator = cata $ \ term -> cofree ((decorator (extract <$> term) .: headF term) :< tailF term) +decorateTerm decorator = cata $ \ term -> cofree ((decorator (extract <$> term) :. headF term) :< tailF term) -- | A function computing a value to decorate terms with. This can be used to cache synthesized attributes on terms. type TermDecorator f fields field = TermF f (Record fields) (Record (field ': fields)) -> field @@ -101,8 +101,8 @@ lineByLineParser SourceBlob{..} = pure . cofree . root $ case foldl' annotateLea (leaves, _) -> cofree <$> leaves where lines = actualLines source - root children = (Range 0 (length source) .: Program .: rangeToSourceSpan source (Range 0 (length source)) .: RNil) :< Indexed children - leaf charIndex line = (Range charIndex (charIndex + T.length line) .: Program .: rangeToSourceSpan source (Range charIndex (charIndex + T.length line)) .: RNil) :< Leaf line + root children = (Range 0 (length source) :. Program :. rangeToSourceSpan source (Range 0 (length source)) :. Nil) :< Indexed children + leaf charIndex line = (Range charIndex (charIndex + T.length line) :. Program :. rangeToSourceSpan source (Range charIndex (charIndex + T.length line)) :. Nil) :< Leaf line annotateLeaves (accum, charIndex) line = (accum <> [ leaf charIndex (toText line) ] , charIndex + length line) toText = T.pack . Source.toString diff --git a/src/Range.hs b/src/Range.hs index d77fcddd4..73cb4b2b2 100644 --- a/src/Range.hs +++ b/src/Range.hs @@ -38,7 +38,7 @@ rangesAndWordsFrom startIndex string = fromMaybe [] $ take isWord <|> take isPun ([], _) -> Nothing (parsed, rest) -> Just . maybe identity (:) (transform parsed) $ rangesAndWordsFrom (endFor parsed) rest -- | Is this a word character? - -- | Word characters are defined as in [Ruby’s `\p{Word}` syntax](http://ruby-doc.org/core-2.1.1/Regexp.html#class-Regexp-label-Character+Properties), i.e.: + -- | Word characters are defined as in [Ruby’s `\p{Word}` syntax](http://ruby-doc.org/core-2.1.1/Regexp.html#class-Regexp-label-Character+Properties), i.e:. -- | > A member of one of the following Unicode general category _Letter_, _Mark_, _Number_, _Connector_Punctuation_ isWord c = Char.isLetter c || Char.isNumber c || Char.isMark c || Char.generalCategory c == Char.ConnectorPunctuation isPunctuation c = not (Char.isSpace c || isWord c) diff --git a/test/AlignmentSpec.hs b/test/AlignmentSpec.hs index ef57f93a2..7303a232a 100644 --- a/test/AlignmentSpec.hs +++ b/test/AlignmentSpec.hs @@ -260,7 +260,7 @@ align :: Both (Source.Source Char) -> ConstructibleFree (Patch (Term (Syntax Str align sources = PrettyDiff sources . fmap (fmap (getRange &&& identity)) . alignDiff sources . deconstruct info :: Int -> Int -> Record '[Range] -info start end = Range start end .: RNil +info start end = Range start end :. Nil 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)) diff --git a/test/Data/RandomWalkSimilarity/Spec.hs b/test/Data/RandomWalkSimilarity/Spec.hs index e25680b43..79c01aefe 100644 --- a/test/Data/RandomWalkSimilarity/Spec.hs +++ b/test/Data/RandomWalkSimilarity/Spec.hs @@ -36,12 +36,12 @@ spec = parallel $ do prop "produces correct diffs" $ \ (as, bs) -> let tas = decorate <$> (unListableF <$> as :: [SyntaxTerm String '[Category]]) tbs = decorate <$> (unListableF <$> bs :: [SyntaxTerm String '[Category]]) - root = cofree . ((Program .: RNil) :<) . Indexed - diff = wrap (pure (Program .: RNil) :< Indexed (stripDiff <$> rws compare getLabel tas tbs)) in + root = cofree . ((Program :. Nil) :<) . Indexed + diff = wrap (pure (Program :. Nil) :< Indexed (stripDiff <$> rws compare getLabel tas tbs)) in (beforeTerm diff, afterTerm diff) `shouldBe` (Just (root (stripTerm <$> tas)), Just (root (stripTerm <$> tbs))) it "produces unbiased insertions within branches" $ - let (a, b) = (decorate (cofree ((StringLiteral .: RNil) :< Indexed [ cofree ((StringLiteral .: RNil) :< Leaf ("a" :: Text)) ])), decorate (cofree ((StringLiteral .: RNil) :< Indexed [ cofree ((StringLiteral .: RNil) :< Leaf "b") ]))) in + let (a, b) = (decorate (cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf ("a" :: Text)) ])), decorate (cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf "b") ]))) in fmap stripDiff (rws compare getLabel [ b ] [ a, b ]) `shouldBe` fmap stripDiff [ inserting a, copying b ] where compare :: (HasField fields Category, Functor f, Eq (Cofree f Category)) => Term f (Record fields) -> Term f (Record fields) -> Maybe (Diff f (Record fields)) diff --git a/test/DiffSummarySpec.hs b/test/DiffSummarySpec.hs index 5f7e54d57..d1daa1ef4 100644 --- a/test/DiffSummarySpec.hs +++ b/test/DiffSummarySpec.hs @@ -27,10 +27,10 @@ sourceSpanBetween :: (Int, Int) -> (Int, Int) -> SourceSpan sourceSpanBetween (s1, e1) (s2, e2) = SourceSpan (SourcePos s1 e1) (SourcePos s2 e2) arrayInfo :: Record '[Category, Range, SourceSpan] -arrayInfo = ArrayLiteral .: Range 0 3 .: sourceSpanBetween (1, 1) (1, 5) .: RNil +arrayInfo = ArrayLiteral :. Range 0 3 :. sourceSpanBetween (1, 1) (1, 5) :. Nil literalInfo :: Record '[Category, Range, SourceSpan] -literalInfo = StringLiteral .: Range 1 2 .: sourceSpanBetween (1, 2) (1, 4) .: RNil +literalInfo = StringLiteral :. Range 1 2 :. sourceSpanBetween (1, 2) (1, 4) :. Nil testDiff :: Diff (Syntax Text) (Record '[Category, Range, SourceSpan]) testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "\"a\"")) ]) diff --git a/test/InterpreterSpec.hs b/test/InterpreterSpec.hs index 8435314b3..67d8b7f1e 100644 --- a/test/InterpreterSpec.hs +++ b/test/InterpreterSpec.hs @@ -2,7 +2,7 @@ module InterpreterSpec where import Category -import Data.Functor.Foldable +import Data.Functor.Foldable hiding (Nil) import Data.Functor.Listable import Data.RandomWalkSimilarity import Data.Record @@ -25,8 +25,8 @@ spec = parallel $ do let decorate = defaultFeatureVectorDecorator (category . headF) let compare = (==) `on` category . extract it "returns a replacement when comparing two unicode equivalent terms" $ - let termA = cofree $ (StringLiteral .: RNil) :< Leaf ("t\776" :: String) - termB = cofree $ (StringLiteral .: RNil) :< Leaf "\7831" in + let termA = cofree $ (StringLiteral :. Nil) :< Leaf ("t\776" :: String) + termB = cofree $ (StringLiteral :. Nil) :< Leaf "\7831" in stripDiff (diffTerms wrap compare diffCost getLabel (decorate termA) (decorate termB)) `shouldBe` replacing termA termB prop "produces correct diffs" $ @@ -39,6 +39,6 @@ spec = parallel $ do diffCost diff `shouldBe` 0 it "produces unbiased insertions within branches" $ - let term s = decorate (cofree ((StringLiteral .: RNil) :< Indexed [ cofree ((StringLiteral .: RNil) :< Leaf s) ])) - root = cofree . ((pure 0 .: Program .: RNil) :<) . Indexed in - stripDiff (diffTerms wrap compare diffCost getLabel (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` wrap (pure (Program .: RNil) :< Indexed [ inserting (stripTerm (term "a")), cata wrap (fmap pure (stripTerm (term "b"))) ]) + let term s = decorate (cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf s) ])) + root = cofree . ((pure 0 :. Program :. Nil) :<) . Indexed in + stripDiff (diffTerms wrap compare diffCost getLabel (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` wrap (pure (Program :. Nil) :< Indexed [ inserting (stripTerm (term "a")), cata wrap (fmap pure (stripTerm (term "b"))) ]) diff --git a/test/PatchOutputSpec.hs b/test/PatchOutputSpec.hs index fbe164da2..c0d674979 100644 --- a/test/PatchOutputSpec.hs +++ b/test/PatchOutputSpec.hs @@ -14,4 +14,4 @@ spec :: Spec spec = parallel $ do describe "hunks" $ do it "empty diffs have empty hunks" $ - hunks (wrap $ pure (Range 0 0 .: RNil) :< Leaf ("" :: Text)) (both (SourceBlob (fromList "") "abcde" "path2.txt" (Just defaultPlainBlob)) (SourceBlob (fromList "") "xyz" "path2.txt" (Just defaultPlainBlob))) `shouldBe` [Hunk {offset = pure 0, changes = [], trailingContext = []}] + hunks (wrap $ pure (Range 0 0 :. Nil) :< Leaf ("" :: Text)) (both (SourceBlob (fromList "") "abcde" "path2.txt" (Just defaultPlainBlob)) (SourceBlob (fromList "") "xyz" "path2.txt" (Just defaultPlainBlob))) `shouldBe` [Hunk {offset = pure 0, changes = [], trailingContext = []}]