2018-04-26 16:05:18 +03:00
{- # LANGUAGE DataKinds, MonoLocalBinds, TypeOperators # -}
2018-03-09 20:07:34 +03:00
module Rendering.TOC.Spec ( spec ) where
2017-02-14 22:29:24 +03:00
2018-11-08 19:33:26 +03:00
import Analysis.TOCSummary
2018-10-24 17:09:57 +03:00
import Control.Effect
2018-06-18 21:33:26 +03:00
import Data.Aeson hiding ( defaultOptions )
2017-09-14 04:37:23 +03:00
import Data.Bifunctor
2018-04-26 16:05:18 +03:00
import Data.Bifunctor.Join
2017-09-27 19:41:41 +03:00
import Data.Diff
2018-04-26 16:05:18 +03:00
import Data.Functor.Classes
2018-05-16 23:19:18 +03:00
import Data.Hashable.Lifted
2017-09-27 19:29:07 +03:00
import Data.Patch
2018-04-26 16:05:18 +03:00
import Data.Range
2018-09-25 19:18:51 +03:00
import Data.Location
2018-04-26 16:05:18 +03:00
import Data.Span
2018-05-02 19:00:15 +03:00
import Data.Sum
2018-04-26 16:05:18 +03:00
import Data.Term
2017-07-28 21:37:02 +03:00
import Data.Text ( Text )
2017-11-21 23:52:04 +03:00
import Data.Text.Encoding ( encodeUtf8 )
2018-10-29 18:19:40 +03:00
import Diffing.Algorithm hiding ( Diff )
2017-11-27 19:45:08 +03:00
import Diffing.Interpreter
2018-04-18 23:42:29 +03:00
import Prelude
2018-03-13 20:59:20 +03:00
import qualified Data.Syntax as Syntax
import qualified Data.Syntax.Declaration as Declaration
2017-11-27 21:30:38 +03:00
import Rendering.TOC
2018-06-18 21:33:26 +03:00
import Semantic.Config
2018-03-13 20:59:20 +03:00
2017-05-11 17:00:11 +03:00
import SpecHelpers
2017-02-14 22:29:24 +03:00
2018-03-08 20:03:02 +03:00
2017-02-14 22:29:24 +03:00
spec :: Spec
spec = parallel $ do
2017-05-11 00:01:42 +03:00
describe " tableOfContentsBy " $ do
prop " drops all nodes with the constant Nothing function " $
2017-10-10 20:18:11 +03:00
\ diff -> tableOfContentsBy ( const Nothing :: a -> Maybe () ) ( diff :: Diff ListableSyntax () () ) ` shouldBe ` []
2017-05-11 16:27:28 +03:00
2018-09-27 21:05:11 +03:00
prop " produces no entries for identity diffs " $
\ term -> tableOfContentsBy ( Just . termFAnnotation ) ( diffTerms term ( term :: Term ListableSyntax () ) ) ` shouldBe ` []
2017-05-11 23:37:08 +03:00
prop " produces inserted/deleted/replaced entries for relevant nodes within patches " $
2017-11-23 21:21:37 +03:00
\ p -> tableOfContentsBy ( Just . termFAnnotation ) ( patch deleting inserting replacing p )
2017-09-14 04:37:23 +03:00
` shouldBe `
2017-11-22 20:36:34 +03:00
patch ( fmap Deleted ) ( fmap Inserted ) ( \ as bs -> Replaced ( head bs ) : fmap Deleted ( tail as ) <> fmap Inserted ( tail bs ) ) ( bimap ( foldMap pure ) ( foldMap pure ) ( p :: Patch ( Term ListableSyntax Int ) ( Term ListableSyntax Int ) ) )
2017-05-11 20:11:40 +03:00
2017-05-11 20:48:35 +03:00
prop " produces changed entries for relevant nodes containing irrelevant patches " $
2018-03-08 20:03:02 +03:00
\ diff -> do
2018-05-17 01:25:02 +03:00
let diff' = merge ( True , True ) ( inject [ bimap ( const False ) ( const False ) ( diff :: Diff ListableSyntax Bool Bool ) ] )
2018-03-08 20:03:02 +03:00
let toc = tableOfContentsBy ( \ ( n ` In ` _ ) -> if n then Just n else Nothing ) diff'
2018-09-27 21:05:11 +03:00
toc ` shouldBe ` if null ( diffPatches diff' ) then []
else [ Changed True ]
2017-05-11 20:48:35 +03:00
2017-02-23 07:05:20 +03:00
describe " diffTOC " $ do
2017-02-14 22:29:24 +03:00
it " blank if there are no methods " $
2017-07-20 03:01:59 +03:00
diffTOC blankDiff ` shouldBe ` [ ]
2017-02-14 22:29:24 +03:00
2017-02-15 21:15:57 +03:00
it " summarizes changed methods " $ do
2018-04-18 23:42:29 +03:00
sourceBlobs <- blobsForPaths ( both " ruby/toc/methods.A.rb " " ruby/toc/methods.B.rb " )
2017-10-02 17:11:31 +03:00
diff <- runTask $ diffWithParser rubyParser sourceBlobs
2017-07-20 03:01:59 +03:00
diffTOC diff ` shouldBe `
2017-11-22 01:35:12 +03:00
[ TOCSummary " Method " " self.foo " ( Span ( Pos 1 1 ) ( Pos 2 4 ) ) " added "
, TOCSummary " Method " " bar " ( Span ( Pos 4 1 ) ( Pos 6 4 ) ) " modified "
, TOCSummary " Method " " baz " ( Span ( Pos 4 1 ) ( Pos 5 4 ) ) " removed "
2017-10-24 22:15:54 +03:00
]
2017-02-17 02:47:18 +03:00
2018-10-05 19:54:57 +03:00
xit " summarizes changed classes " $ do
2018-04-18 23:42:29 +03:00
sourceBlobs <- blobsForPaths ( both " ruby/toc/classes.A.rb " " ruby/toc/classes.B.rb " )
2017-10-31 21:17:56 +03:00
diff <- runTask $ diffWithParser rubyParser sourceBlobs
diffTOC diff ` shouldBe `
2017-11-22 01:35:12 +03:00
[ TOCSummary " Class " " Baz " ( Span ( Pos 1 1 ) ( Pos 2 4 ) ) " removed "
, TOCSummary " Class " " Foo " ( Span ( Pos 1 1 ) ( Pos 3 4 ) ) " modified "
, TOCSummary " Class " " Bar " ( Span ( Pos 5 1 ) ( Pos 6 4 ) ) " added "
2017-10-31 21:17:56 +03:00
]
2017-02-17 02:47:18 +03:00
2017-02-14 22:53:25 +03:00
it " dedupes changes in same parent method " $ do
2018-04-18 23:42:29 +03:00
sourceBlobs <- blobsForPaths ( both " javascript/toc/duplicate-parent.A.js " " javascript/toc/duplicate-parent.B.js " )
2017-09-11 22:45:56 +03:00
diff <- runTask $ diffWithParser typescriptParser sourceBlobs
2017-07-20 03:01:59 +03:00
diffTOC diff ` shouldBe `
2017-11-22 01:35:12 +03:00
[ TOCSummary " Function " " myFunction " ( Span ( Pos 1 1 ) ( Pos 6 2 ) ) " modified " ]
2017-02-14 22:53:25 +03:00
it " dedupes similar methods " $ do
2018-04-18 23:42:29 +03:00
sourceBlobs <- blobsForPaths ( both " javascript/toc/erroneous-duplicate-method.A.js " " javascript/toc/erroneous-duplicate-method.B.js " )
2017-09-11 22:45:56 +03:00
diff <- runTask $ diffWithParser typescriptParser sourceBlobs
2017-07-20 03:01:59 +03:00
diffTOC diff ` shouldBe `
2017-11-22 01:35:12 +03:00
[ TOCSummary " Function " " performHealthCheck " ( Span ( Pos 8 1 ) ( Pos 29 2 ) ) " modified " ]
2017-02-15 21:15:57 +03:00
2017-02-17 19:45:51 +03:00
it " summarizes Go methods with receivers with special formatting " $ do
2018-04-18 23:42:29 +03:00
sourceBlobs <- blobsForPaths ( both " go/toc/method-with-receiver.A.go " " go/toc/method-with-receiver.B.go " )
2017-10-10 20:14:05 +03:00
diff <- runTask $ diffWithParser goParser sourceBlobs
2017-07-20 03:01:59 +03:00
diffTOC diff ` shouldBe `
2017-11-22 01:35:12 +03:00
[ TOCSummary " Method " " (*apiClient) CheckAuth " ( Span ( Pos 3 1 ) ( Pos 3 101 ) ) " added " ]
2017-02-17 19:45:51 +03:00
2017-02-17 19:09:42 +03:00
it " summarizes Ruby methods that start with two identifiers " $ do
2018-04-18 23:42:29 +03:00
sourceBlobs <- blobsForPaths ( both " ruby/toc/method-starts-with-two-identifiers.A.rb " " ruby/toc/method-starts-with-two-identifiers.B.rb " )
2017-10-02 17:11:31 +03:00
diff <- runTask $ diffWithParser rubyParser sourceBlobs
2017-07-20 03:01:59 +03:00
diffTOC diff ` shouldBe `
2017-11-22 01:35:12 +03:00
[ TOCSummary " Method " " foo " ( Span ( Pos 1 1 ) ( Pos 4 4 ) ) " modified " ]
2017-02-17 19:09:42 +03:00
2017-02-16 19:29:49 +03:00
it " handles unicode characters in file " $ do
2018-04-18 23:42:29 +03:00
sourceBlobs <- blobsForPaths ( both " ruby/toc/unicode.A.rb " " ruby/toc/unicode.B.rb " )
2017-10-02 17:11:31 +03:00
diff <- runTask $ diffWithParser rubyParser sourceBlobs
2017-07-20 03:01:59 +03:00
diffTOC diff ` shouldBe `
2017-11-22 01:35:12 +03:00
[ TOCSummary " Method " " foo " ( Span ( Pos 6 1 ) ( Pos 7 4 ) ) " added " ]
2017-02-16 19:29:49 +03:00
2017-06-14 20:01:12 +03:00
it " properly slices source blob that starts with a newline and has multi-byte chars " $ do
2018-04-18 23:42:29 +03:00
sourceBlobs <- blobsForPaths ( both " javascript/toc/starts-with-newline.js " " javascript/toc/starts-with-newline.js " )
2018-09-26 21:54:16 +03:00
diff <- runTaskWithOptions ( defaultOptions { optionsLogLevel = Nothing } ) $ diffWithParser typescriptParser sourceBlobs
2017-07-20 03:01:59 +03:00
diffTOC diff ` shouldBe ` []
2017-06-14 20:01:12 +03:00
2017-11-22 18:17:32 +03:00
prop " inserts of methods and functions are summarized " . forAll ( ( not . isMethodOrFunction . Prelude . snd ) ` filterT ` tiers ) $
\ ( name , body ) ->
2017-09-09 16:18:08 +03:00
let diff = programWithInsert name body
2017-02-17 01:20:22 +03:00
in numTocSummaries diff ` shouldBe ` 1
2017-02-16 23:23:40 +03:00
2017-11-22 18:17:32 +03:00
prop " deletes of methods and functions are summarized " . forAll ( ( not . isMethodOrFunction . Prelude . snd ) ` filterT ` tiers ) $
\ ( name , body ) ->
2017-09-09 16:18:08 +03:00
let diff = programWithDelete name body
2017-02-17 01:20:22 +03:00
in numTocSummaries diff ` shouldBe ` 1
2017-11-22 18:17:32 +03:00
prop " replacements of methods and functions are summarized " . forAll ( ( not . isMethodOrFunction . Prelude . snd ) ` filterT ` tiers ) $
\ ( name , body ) ->
2017-09-09 16:18:08 +03:00
let diff = programWithReplace name body
2017-05-12 00:09:54 +03:00
in numTocSummaries diff ` shouldBe ` 1
2017-02-16 03:13:34 +03:00
2017-11-22 18:17:32 +03:00
prop " changes inside methods and functions are summarizied " . forAll ( ( ( && ) <$> not . isMethodOrFunction <*> isMeaningfulTerm ) ` filterT ` tiers ) $
2017-02-17 02:22:46 +03:00
\ body ->
2017-09-09 16:18:08 +03:00
let diff = programWithChange body
2017-02-17 02:22:46 +03:00
in numTocSummaries diff ` shouldBe ` 1
2017-02-17 02:41:13 +03:00
prop " other changes don't summarize " . forAll ( ( not . isMethodOrFunction ) ` filterT ` tiers ) $
\ body ->
2017-09-09 16:18:08 +03:00
let diff = programWithChangeOutsideFunction body
2017-02-17 02:41:13 +03:00
in numTocSummaries diff ` shouldBe ` 0
2018-09-27 21:05:11 +03:00
prop " unchanged diffs aren’ t summarized " $
\ term -> diffTOC ( diffTerms term ( term :: Term' ) ) ` shouldBe ` []
2017-10-27 21:15:46 +03:00
describe " TOCSummary " $ do
2017-06-05 18:32:18 +03:00
it " encodes modified summaries to JSON " $ do
2017-11-22 01:35:12 +03:00
let summary = TOCSummary " Method " " foo " ( Span ( Pos 1 1 ) ( Pos 4 4 ) ) " modified "
2017-02-23 07:05:20 +03:00
encode summary ` shouldBe ` " { \ " span \ " :{ \ " start \ " :[1,1], \ " end \ " :[4,4]}, \ " category \ " : \ " Method \ " , \ " term \ " : \ " foo \ " , \ " changeType \ " : \ " modified \ " } "
2017-06-05 18:32:18 +03:00
it " encodes added summaries to JSON " $ do
2017-11-22 01:35:12 +03:00
let summary = TOCSummary " Method " " self.foo " ( Span ( Pos 1 1 ) ( Pos 2 4 ) ) " added "
2017-02-23 07:05:20 +03:00
encode summary ` shouldBe ` " { \ " span \ " :{ \ " start \ " :[1,1], \ " end \ " :[2,4]}, \ " category \ " : \ " Method \ " , \ " term \ " : \ " self.foo \ " , \ " changeType \ " : \ " added \ " } "
2017-09-22 19:47:06 +03:00
describe " diff with ToCDiffRenderer' " $ do
2017-04-21 23:56:19 +03:00
it " produces JSON output " $ do
2018-04-18 23:42:29 +03:00
blobs <- blobsForPaths ( both " ruby/toc/methods.A.rb " " ruby/toc/methods.B.rb " )
2018-05-15 01:39:41 +03:00
output <- runTask ( runDiff ToCDiffRenderer [ blobs ] )
runBuilder output ` shouldBe ` ( " { \ " changes \ " :{ \ " test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.B.rb \ " :[{ \ " span \ " :{ \ " start \ " :[1,1], \ " end \ " :[2,4]}, \ " category \ " : \ " Method \ " , \ " term \ " : \ " self.foo \ " , \ " changeType \ " : \ " added \ " },{ \ " span \ " :{ \ " start \ " :[4,1], \ " end \ " :[6,4]}, \ " category \ " : \ " Method \ " , \ " term \ " : \ " bar \ " , \ " changeType \ " : \ " modified \ " },{ \ " span \ " :{ \ " start \ " :[4,1], \ " end \ " :[5,4]}, \ " category \ " : \ " Method \ " , \ " term \ " : \ " baz \ " , \ " changeType \ " : \ " removed \ " }]}, \ " errors \ " :{}} \ n " :: ByteString )
2017-02-23 07:05:20 +03:00
2017-04-21 23:56:19 +03:00
it " produces JSON output if there are parse errors " $ do
2018-04-18 23:42:29 +03:00
blobs <- blobsForPaths ( both " ruby/toc/methods.A.rb " " ruby/toc/methods.X.rb " )
2018-06-18 21:33:26 +03:00
output <- runTaskWithOptions ( defaultOptions { optionsLogLevel = Nothing } ) ( runDiff ToCDiffRenderer [ blobs ] )
2018-09-17 19:56:39 +03:00
runBuilder output ` shouldBe ` ( " { \ " changes \ " :{ \ " test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb \ " :[{ \ " span \ " :{ \ " start \ " :[1,1], \ " end \ " :[2,4]}, \ " category \ " : \ " Method \ " , \ " term \ " : \ " bar \ " , \ " changeType \ " : \ " removed \ " },{ \ " span \ " :{ \ " start \ " :[4,1], \ " end \ " :[5,4]}, \ " category \ " : \ " Method \ " , \ " term \ " : \ " baz \ " , \ " changeType \ " : \ " removed \ " }]}, \ " errors \ " :{ \ " test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb \ " :[{ \ " span \ " :{ \ " start \ " :[1,1], \ " end \ " :[2,3]}, \ " error \ " : \ " expected end of input nodes, but got ParseError \ " , \ " language \ " : \ " Ruby \ " }]}} \ n " :: ByteString )
2017-02-23 07:05:20 +03:00
2017-08-29 04:06:09 +03:00
it " ignores anonymous functions " $ do
2018-04-18 23:42:29 +03:00
blobs <- blobsForPaths ( both " ruby/toc/lambda.A.rb " " ruby/toc/lambda.B.rb " )
2018-05-15 01:39:41 +03:00
output <- runTask ( runDiff ToCDiffRenderer [ blobs ] )
runBuilder output ` shouldBe ` ( " { \ " changes \ " :{}, \ " errors \ " :{}} \ n " :: ByteString )
2017-02-23 07:05:20 +03:00
2017-07-10 22:54:03 +03:00
it " summarizes Markdown headings " $ do
2018-04-18 23:42:29 +03:00
blobs <- blobsForPaths ( both " markdown/toc/headings.A.md " " markdown/toc/headings.B.md " )
2018-05-15 01:39:41 +03:00
output <- runTask ( runDiff ToCDiffRenderer [ blobs ] )
2018-09-27 21:05:11 +03:00
runBuilder output ` shouldBe ` ( " { \ " changes \ " :{ \ " test/fixtures/markdown/toc/headings.A.md -> test/fixtures/markdown/toc/headings.B.md \ " :[{ \ " span \ " :{ \ " start \ " :[1,1], \ " end \ " :[3,16]}, \ " category \ " : \ " Heading 1 \ " , \ " term \ " : \ " Introduction \ " , \ " changeType \ " : \ " removed \ " },{ \ " span \ " :{ \ " start \ " :[5,1], \ " end \ " :[7,4]}, \ " category \ " : \ " Heading 2 \ " , \ " term \ " : \ " Two \ " , \ " changeType \ " : \ " modified \ " },{ \ " span \ " :{ \ " start \ " :[9,1], \ " end \ " :[11,10]}, \ " category \ " : \ " Heading 3 \ " , \ " term \ " : \ " This heading is new \ " , \ " changeType \ " : \ " added \ " },{ \ " span \ " :{ \ " start \ " :[13,1], \ " end \ " :[14,4]}, \ " category \ " : \ " Heading 1 \ " , \ " term \ " : \ " Final \ " , \ " changeType \ " : \ " added \ " }]}, \ " errors \ " :{}} \ n " :: ByteString )
2017-07-10 22:54:03 +03:00
2018-09-26 21:54:16 +03:00
type Diff' = Diff ListableSyntax ( Maybe Declaration ) ( Maybe Declaration )
type Term' = Term ListableSyntax ( Maybe Declaration )
2017-02-17 01:20:22 +03:00
numTocSummaries :: Diff' -> Int
2017-07-20 03:01:59 +03:00
numTocSummaries diff = length $ filter isValidSummary ( diffTOC diff )
2017-02-17 01:20:22 +03:00
2017-02-17 02:41:13 +03:00
-- Return a diff where body is inserted in the expressions of a function. The function is present in both sides of the diff.
2017-02-17 02:22:46 +03:00
programWithChange :: Term' -> Diff'
2018-09-26 21:54:16 +03:00
programWithChange body = merge ( Nothing , Nothing ) ( inject [ function' ] )
2017-02-17 02:22:46 +03:00
where
2018-09-26 21:54:16 +03:00
function' = merge ( Just ( FunctionDeclaration " foo " mempty lowerBound Ruby ) , Just ( FunctionDeclaration " foo " mempty lowerBound Ruby ) ) ( inject ( Declaration . Function [] name' [] ( merge ( Nothing , Nothing ) ( inject [ inserting body ] ) ) ) )
name' = merge ( Nothing , Nothing ) ( inject ( Syntax . Identifier ( name " foo " ) ) )
2017-02-17 02:41:13 +03:00
-- Return a diff where term is inserted in the program, below a function found on both sides of the diff.
programWithChangeOutsideFunction :: Term' -> Diff'
2018-09-26 21:54:16 +03:00
programWithChangeOutsideFunction term = merge ( Nothing , Nothing ) ( inject [ function' , term' ] )
2017-02-17 02:41:13 +03:00
where
2018-09-26 21:54:16 +03:00
function' = merge ( Nothing , Nothing ) ( inject ( Declaration . Function [] name' [] ( merge ( Nothing , Nothing ) ( inject [] ) ) ) )
name' = merge ( Nothing , Nothing ) ( inject ( Syntax . Identifier ( name " foo " ) ) )
2017-05-10 23:08:39 +03:00
term' = inserting term
2017-02-17 02:22:46 +03:00
2017-05-08 22:08:01 +03:00
programWithInsert :: Text -> Term' -> Diff'
2017-05-11 20:49:25 +03:00
programWithInsert name body = programOf $ inserting ( functionOf name body )
2017-02-17 01:20:22 +03:00
2017-05-08 22:08:01 +03:00
programWithDelete :: Text -> Term' -> Diff'
2017-05-11 20:49:25 +03:00
programWithDelete name body = programOf $ deleting ( functionOf name body )
2017-02-16 23:23:40 +03:00
2017-05-08 22:08:01 +03:00
programWithReplace :: Text -> Term' -> Diff'
2017-05-11 20:49:25 +03:00
programWithReplace name body = programOf $ replacing ( functionOf name body ) ( functionOf ( name <> " 2 " ) body )
2017-02-16 23:23:40 +03:00
2017-05-11 20:49:25 +03:00
programOf :: Diff' -> Diff'
2018-09-26 21:54:16 +03:00
programOf diff = merge ( Nothing , Nothing ) ( inject [ diff ] )
2017-02-16 23:23:40 +03:00
2017-05-08 22:08:01 +03:00
functionOf :: Text -> Term' -> Term'
2018-09-26 21:54:16 +03:00
functionOf n body = termIn ( Just ( FunctionDeclaration n mempty lowerBound Unknown ) ) ( inject ( Declaration . Function [] name' [] ( termIn Nothing ( inject [ body ] ) ) ) )
2017-02-17 02:22:46 +03:00
where
2018-09-26 21:54:16 +03:00
name' = termIn Nothing ( inject ( Syntax . Identifier ( name n ) ) )
2017-02-16 03:13:34 +03:00
2017-02-17 02:41:13 +03:00
-- Filter tiers for terms that we consider "meaniningful" in TOC summaries.
2017-11-21 23:52:04 +03:00
isMeaningfulTerm :: Term ListableSyntax a -> Bool
2017-10-10 20:34:50 +03:00
isMeaningfulTerm a
2018-05-17 01:25:02 +03:00
| Just ( _ : _ ) <- project ( termOut a ) = False
| Just [] <- project ( termOut a ) = False
2018-09-27 00:54:48 +03:00
| otherwise = True
2017-02-16 03:13:34 +03:00
2017-02-17 02:41:13 +03:00
-- Filter tiers for terms if the Syntax is a Method or a Function.
2017-11-22 18:13:33 +03:00
isMethodOrFunction :: Term' -> Bool
2017-11-21 23:52:04 +03:00
isMethodOrFunction a
2018-05-17 01:25:02 +03:00
| Just Declaration . Method { } <- project ( termOut a ) = True
| Just Declaration . Function { } <- project ( termOut a ) = True
2018-09-27 00:54:48 +03:00
| any isJust ( foldMap ( : [] ) a ) = True
2018-09-26 21:54:16 +03:00
| otherwise = False
2017-02-17 02:41:13 +03:00
2017-12-10 19:46:17 +03:00
blobsForPaths :: Both FilePath -> IO BlobPair
2018-04-18 23:42:29 +03:00
blobsForPaths = readFilePair . fmap ( " test/fixtures " </> )
2017-02-14 22:29:24 +03:00
2017-05-11 22:53:22 +03:00
blankDiff :: Diff'
2018-09-26 21:54:16 +03:00
blankDiff = merge ( Nothing , Nothing ) ( inject [ inserting ( termIn Nothing ( inject ( Syntax . Identifier ( name " \ " a \ " " ) ) ) ) ] )
2018-04-26 16:05:18 +03:00
-- Diff helpers
2018-09-25 19:18:51 +03:00
diffWithParser :: ( Eq1 syntax
2018-04-26 16:05:18 +03:00
, Show1 syntax
, Traversable syntax
, Diffable syntax
, HasDeclaration syntax
2018-05-16 23:19:18 +03:00
, Hashable1 syntax
2018-10-24 17:09:57 +03:00
, Member Distribute sig
, Member Task sig
, Carrier sig m
, Monad m
2018-04-26 16:05:18 +03:00
)
2018-09-25 19:18:51 +03:00
=> Parser ( Term syntax Location )
2018-04-26 16:05:18 +03:00
-> BlobPair
2018-10-24 17:09:57 +03:00
-> m ( Diff syntax ( Maybe Declaration ) ( Maybe Declaration ) )
2018-06-22 20:52:21 +03:00
diffWithParser parser blobs = distributeFor blobs ( \ blob -> parse parser blob >>= decorate ( declarationAlgebra blob ) ) >>= SpecHelpers . diff . runJoin