github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

Generalize adjoinRowsBy to any Applicative with an aligning function.

Browse Source
This commit is contained in:
Rob Rix 2016-03-09 04:13:09 -05:00
parent 8c36e46452
commit 73aa926bdc
2 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Alignment.hs
View File

@ -115,6 +115,6 @@ openRange source range = (at source <$> maybeLastIndex range) /= Just '\n'
type Row a = Both (Line a)
-- | Merge open lines and prepend closed lines (as determined by a pair of functions) onto a list of rows.
adjoinRowsBy :: Both (a -> Bool) -> Both (Line a) -> [Both (Line a)] -> [Both (Line a)]
adjoinRowsBy _ row [] = [ row ]
adjoinRowsBy f row (nextRow : rows) = zipDefaults mempty (coalesceLinesBy <$> f <*> row <*> nextRow) ++ rows
adjoinRowsBy :: Applicative f => f (a -> Bool) -> (f [Line a] -> [f (Line a)]) -> f (Line a) -> [f (Line a)] -> [f (Line a)]
adjoinRowsBy _ _ row [] = [ row ]
adjoinRowsBy f align row (nextRow : rows) = align (coalesceLinesBy <$> f <*> row <*> nextRow) ++ rows

10
test/AlignmentSpec.hs
View File

@ -69,20 +69,20 @@ spec = parallel $ do
describe "adjoinRowsBy" $ do
prop "is identity on top of no rows" $ forAll (arbitrary `suchThat` (not . isEmptyRow)) $
\ a -> adjoinRowsBy (pure Maybe.isJust) a [] `shouldBe` [ a :: Row (Maybe Bool) ]
\ a -> adjoinRowsBy (pure Maybe.isJust) (zipDefaults mempty) a [] `shouldBe` [ a :: Row (Maybe Bool) ]
prop "prunes empty rows" $
\ a -> adjoinRowsBy (pure Maybe.isJust) (both mempty mempty) [ a ] `shouldBe` [ a :: Row (Maybe Bool) ]
\ a -> adjoinRowsBy (pure Maybe.isJust) (zipDefaults mempty) (both mempty mempty) [ a ] `shouldBe` [ a :: Row (Maybe Bool) ]
prop "merges open rows" $
forAll ((arbitrary `suchThat` (and . fmap (isOpenLineBy Maybe.isJust))) >>= \ a -> (,) a <$> arbitrary) $
\ (a, b) -> adjoinRowsBy (pure Maybe.isJust) a [ b ] `shouldBe` [ mappend <$> a <*> b :: Row (Maybe Bool) ]
\ (a, b) -> adjoinRowsBy (pure Maybe.isJust) (zipDefaults mempty) a [ b ] `shouldBe` [ mappend <$> a <*> b :: Row (Maybe Bool) ]
prop "prepends closed rows" $
\ a -> adjoinRowsBy (pure Maybe.isJust) (both (pure Nothing) (pure Nothing)) [ both (pure a) (pure a) ] `shouldBe` [ (both (pure Nothing) (pure Nothing)), both (pure a) (pure a) :: Row (Maybe Bool) ]
\ a -> adjoinRowsBy (pure Maybe.isJust) (zipDefaults mempty) (both (pure Nothing) (pure Nothing)) [ both (pure a) (pure a) ] `shouldBe` [ (both (pure Nothing) (pure Nothing)), both (pure a) (pure a) :: Row (Maybe Bool) ]
it "aligns closed lines" $
foldr (adjoinRowsBy (pure (/= '\n'))) [] (Prelude.zipWith (both) (pure <$> "[ bar ]\nquux") (pure <$> "[\nbar\n]\nquux")) `shouldBe`
foldr (adjoinRowsBy (pure (/= '\n')) (zipDefaults mempty)) [] (Prelude.zipWith (both) (pure <$> "[ bar ]\nquux") (pure <$> "[\nbar\n]\nquux")) `shouldBe`
[ both (Line "[ bar ]\n") (Line "[\n")
, both mempty (Line "bar\n")
, both mempty (Line "]\n")