2015-12-03 19:44:28 +03:00
module Main where
2015-12-03 19:38:49 +03:00
2015-12-04 17:16:23 +03:00
import Diff
2015-12-10 23:11:56 +03:00
import Patch
2015-12-04 17:16:23 +03:00
import Range
2015-12-03 19:44:42 +03:00
import Split
2015-12-04 17:16:23 +03:00
import Syntax
2015-12-10 23:11:56 +03:00
import Control.Comonad.Cofree
2015-12-04 18:19:19 +03:00
import Control.Monad.Free
2015-12-04 17:16:23 +03:00
import qualified Data.Set as Set
2015-12-03 19:38:49 +03:00
import Test.Hspec
2015-11-18 01:44:16 +03:00
main :: IO ()
2015-12-03 19:44:42 +03:00
main = hspec $ do
2015-12-04 17:16:23 +03:00
describe " annotatedToRows " $ do
it " outputs one row for single-line unchanged leaves " $
2015-12-08 20:35:40 +03:00
annotatedToRows ( unchanged " a " " leaf " ( Leaf " " ) ) " a " " a " ` shouldBe ` ( [ Row ( Line [ span " a " ] ) ( Line [ span " a " ] ) ] , ( Range 0 1 , Range 0 1 ) )
2015-12-04 17:49:34 +03:00
it " outputs one row for single-line empty unchanged indexed nodes " $
2015-12-08 20:35:40 +03:00
annotatedToRows ( unchanged " [] " " branch " ( Indexed [] ) ) " [] " " [] " ` shouldBe ` ( [ Row ( Line [ Ul ( Just " category-branch " ) [ Text " [] " ] ] ) ( Line [ Ul ( Just " category-branch " ) [ Text " [] " ] ] ) ] , ( Range 0 2 , Range 0 2 ) )
2015-12-04 18:19:19 +03:00
it " outputs one row for single-line non-empty unchanged indexed nodes " $
annotatedToRows ( unchanged " [ a, b ] " " branch " ( Indexed [
2015-12-04 19:37:01 +03:00
Free . offsetAnnotated 2 2 $ unchanged " a " " leaf " ( Leaf " " ) ,
Free . offsetAnnotated 5 5 $ unchanged " b " " leaf " ( Leaf " " )
2015-12-08 20:35:40 +03:00
] ) ) " [ a, b ] " " [ a, b ] " ` shouldBe ` ( [ Row ( Line [ Ul ( Just " category-branch " ) [ Text " [ " , span " a " , Text " , " , span " b " , Text " ] " ] ] ) ( Line [ Ul ( Just " category-branch " ) [ Text " [ " , span " a " , Text " , " , span " b " , Text " ] " ] ] ) ] , ( Range 0 8 , Range 0 8 ) )
2015-12-04 19:37:01 +03:00
it " outputs one row for single-line non-empty formatted indexed nodes " $
annotatedToRows ( formatted " [ a, b ] " " [ a, b ] " " branch " ( Indexed [
Free . offsetAnnotated 2 2 $ unchanged " a " " leaf " ( Leaf " " ) ,
Free . offsetAnnotated 5 6 $ unchanged " b " " leaf " ( Leaf " " )
2015-12-08 20:35:40 +03:00
] ) ) " [ a, b ] " " [ a, b ] " ` shouldBe ` ( [ Row ( Line [ Ul ( Just " category-branch " ) [ Text " [ " , span " a " , Text " , " , span " b " , Text " ] " ] ] ) ( Line [ Ul ( Just " category-branch " ) [ Text " [ " , span " a " , Text " , " , span " b " , Text " ] " ] ] ) ] , ( Range 0 8 , Range 0 9 ) )
2015-12-04 19:37:01 +03:00
2015-12-04 20:02:41 +03:00
it " outputs two rows for two-line non-empty unchanged indexed nodes " $
annotatedToRows ( unchanged " [ a, \ n b ] " " branch " ( Indexed [
Free . offsetAnnotated 2 2 $ unchanged " a " " leaf " ( Leaf " " ) ,
Free . offsetAnnotated 5 5 $ unchanged " b " " leaf " ( Leaf " " )
] ) ) " [ a, \ n b ] " " [ a, \ n b ] " ` shouldBe `
( [
2015-12-10 22:21:50 +03:00
Row ( Line [ Ul ( Just " category-branch " ) [ Text " [ " , span " a " , Text " , " , Break ] ] )
( Line [ Ul ( Just " category-branch " ) [ Text " [ " , span " a " , Text " , " , Break ] ] ) ,
Row ( Line [ Ul ( Just " category-branch " ) [ span " b " , Text " ] " ] ] )
( Line [ Ul ( Just " category-branch " ) [ span " b " , Text " ] " ] ] )
2015-12-04 20:02:41 +03:00
] , ( Range 0 8 , Range 0 8 ) )
2015-12-04 22:18:53 +03:00
it " outputs two rows for two-line non-empty formatted indexed nodes " $
annotatedToRows ( formatted " [ a, \ n b ] " " [ \ n a, \ n b ] " " branch " ( Indexed [
Free . offsetAnnotated 2 2 $ unchanged " a " " leaf " ( Leaf " " ) ,
Free . offsetAnnotated 5 5 $ unchanged " b " " leaf " ( Leaf " " )
] ) ) " [ a, \ n b ] " " [ \ n a, \ n b ] " ` shouldBe `
( [
2015-12-10 22:21:50 +03:00
Row ( Line [ Ul ( Just " category-branch " ) [ Text " [ " , span " a " , Text " , " , Break ] ] )
( Line [ Ul ( Just " category-branch " ) [ Text " [ " , Break ] ] ) ,
2015-12-08 20:35:40 +03:00
Row EmptyLine
2015-12-10 22:21:50 +03:00
( Line [ Ul ( Just " category-branch " ) [ span " a " , Text " , " , Break ] ] ) ,
Row ( Line [ Ul ( Just " category-branch " ) [ span " b " , Text " ] " ] ] )
( Line [ Ul ( Just " category-branch " ) [ span " b " , Text " ] " ] ] )
2015-12-04 22:18:53 +03:00
] , ( Range 0 8 , Range 0 8 ) )
2015-12-09 02:09:45 +03:00
it " " $
let ( sourceA , sourceB ) = ( " [ \ n a \ n , \ n b] " , " [a,b] " ) in
annotatedToRows ( formatted sourceA sourceB " branch " ( Indexed [
Free . offsetAnnotated 2 1 $ unchanged " a " " leaf " ( Leaf " " ) ,
2015-12-09 23:54:31 +03:00
Free . offsetAnnotated 6 3 $ unchanged " b " " leaf " ( Leaf " " )
2015-12-09 02:09:45 +03:00
] ) ) sourceA sourceB ` shouldBe `
( [
2015-12-10 22:21:50 +03:00
Row ( Line [ Ul ( Just " category-branch " ) [ Text " [ " , Break ] ] )
2015-12-09 02:09:45 +03:00
( Line [ Ul ( Just " category-branch " ) [ Text " [ " , span " a " , Text " , " , span " b " , Text " ] " ] ] ) ,
2015-12-10 22:21:50 +03:00
Row ( Line [ Ul ( Just " category-branch " ) [ span " a " , Break ] ] )
2015-12-09 02:09:45 +03:00
EmptyLine ,
2015-12-10 22:21:50 +03:00
Row ( Line [ Ul ( Just " category-branch " ) [ Text " , " , Break ] ] )
2015-12-09 02:09:45 +03:00
EmptyLine ,
2015-12-10 22:21:50 +03:00
Row ( Line [ Ul ( Just " category-branch " ) [ span " b " , Text " ] " ] ] )
2015-12-09 02:09:45 +03:00
EmptyLine
] , ( Range 0 8 , Range 0 5 ) )
2015-12-10 23:11:56 +03:00
it " should split multi-line deletions across multiple rows " $
let ( sourceA , sourceB ) = ( " /* \ n */ \ n a " , " a " ) in
annotatedToRows ( formatted sourceA sourceB " branch " ( Indexed [
Pure . Delete $ ( Info ( Range 0 5 ) ( Range 0 2 ) ( Set . fromList [ " comment " ] ) :< ( Leaf " " ) ) ,
Free . offsetAnnotated 6 0 $ unchanged " a " " leaf " ( Leaf " " )
] ) ) sourceA sourceB ` shouldBe `
( [
Row ( Line [ Ul ( Just " category-branch " ) [ Div ( Just " delete " ) [ span " /* " , Break ] ] ] ) EmptyLine ,
Row ( Line [ Ul ( Just " category-branch " ) [ Div ( Just " delete " ) [ span " */ " ] , Break ] ] ) EmptyLine ,
Row ( Line [ Ul ( Just " category-branch " ) [ span " a " ] ] ) ( Line [ Ul ( Just " category-branch " ) [ span " a " ] ] )
] , ( Range 0 7 , Range 0 1 ) )
2015-12-09 02:09:45 +03:00
describe " adjoin2 " $ do
2015-12-10 22:26:49 +03:00
it " appends appends HTML onto incomplete lines " $
2015-12-10 22:21:50 +03:00
adjoin2 [ rightRowText " [ " ] ( rightRowText " a " ) ` shouldBe `
[ rightRow [ Text " [ " , Text " a " ] ]
2015-12-09 22:47:10 +03:00
2015-12-10 22:26:49 +03:00
it " does not append HTML onto complete lines " $
2015-12-10 19:35:46 +03:00
adjoin2 [ leftRow [ Break ] ] ( leftRowText " , " ) ` shouldBe `
2015-12-10 22:21:50 +03:00
[ leftRowText " , " , leftRow [ Break ] ]
2015-12-09 22:47:10 +03:00
2015-12-10 22:26:49 +03:00
it " appends breaks onto incomplete lines " $
2015-12-10 19:35:46 +03:00
adjoin2 [ leftRowText " a " ] ( leftRow [ Break ] ) ` shouldBe `
2015-12-10 22:21:50 +03:00
[ leftRow [ Text " a " , Break ] ]
2015-12-09 22:56:26 +03:00
2015-12-10 22:21:50 +03:00
it " does not promote HTML through empty lines onto complete lines " $
2015-12-10 19:35:46 +03:00
adjoin2 [ rightRowText " b " , leftRow [ Break ] ] ( leftRowText " a " ) ` shouldBe `
2015-12-10 22:21:50 +03:00
[ leftRowText " a " , rightRowText " b " , leftRow [ Break ] ]
2015-12-10 01:38:40 +03:00
2015-12-10 22:21:50 +03:00
it " promotes breaks through empty lines onto incomplete lines " $
2015-12-10 19:35:46 +03:00
adjoin2 [ rightRowText " c " , rowText " a " " b " ] ( leftRow [ Break ] ) ` shouldBe `
2015-12-10 22:21:50 +03:00
[ rightRowText " c " , Row ( Line [ Text " a " , Break ] ) ( Line [ Text " b " ] ) ]
2015-12-09 22:56:33 +03:00
2015-12-10 23:47:34 +03:00
describe " termToLines " $ do
it " splits multi-line terms into multiple lines " $
2015-12-10 23:48:23 +03:00
termToLines ( Info ( Range 0 5 ) ( Range 0 2 ) ( Set . singleton " leaf " ) :< ( Leaf " " ) ) " /* \ n */ "
2015-12-10 23:47:34 +03:00
` shouldBe `
( [
Line [ span " /* " , Break ] ,
Line [ span " */ " ]
] , Range 0 5 )
2015-12-10 23:41:02 +03:00
2015-12-11 00:29:18 +03:00
describe " openLine " $ do
2015-12-11 00:30:52 +03:00
it " should produce the earliest non-empty line in a list, if open " $
2015-12-11 00:29:18 +03:00
openLine [
Line [ Div ( Just " delete " ) [ span " */ " ] ] ,
Line [ Div ( Just " delete " ) [ span " * Debugging " , Break ] ] ,
Line [ Div ( Just " delete " ) [ span " /* " , Break ] ]
] ` shouldBe ` ( Just $ Line [ Div ( Just " delete " ) [ span " */ " ] ] )
2015-12-11 00:31:00 +03:00
it " should return Nothing if the earliest non-empty line is closed " $
openLine [
Line [ Div ( Just " delete " ) [ span " * Debugging " , Break ] ]
] ` shouldBe ` Nothing
2015-12-04 17:16:23 +03:00
where
2015-12-10 01:29:25 +03:00
rightRowText text = rightRow [ Text text ]
rightRow xs = Row EmptyLine ( Line xs )
leftRowText text = leftRow [ Text text ]
leftRow xs = Row ( Line xs ) EmptyLine
rowText a b = Row ( Line [ Text a ] ) ( Line [ Text b ] )
2015-12-04 17:44:09 +03:00
info source category = Info ( totalRange source ) ( Range 0 0 ) ( Set . fromList [ category ] )
2015-12-04 19:37:01 +03:00
unchanged source category = formatted source source category
formatted source1 source2 category = Annotated ( info source1 category , info source2 category )
2015-12-04 18:26:15 +03:00
offsetInfo by ( Info ( Range start end ) lineRange categories ) = Info ( Range ( start + by ) ( end + by ) ) lineRange categories
2015-12-04 19:37:01 +03:00
offsetAnnotated by1 by2 ( Annotated ( left , right ) syntax ) = Annotated ( offsetInfo by1 left , offsetInfo by2 right ) syntax
2015-12-07 22:39:00 +03:00
span = Span ( Just " category-leaf " )