github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 01:42:43 +03:00
Code Issues Projects Releases Wiki Activity

Sequence coalesced lines by aligning.

Browse Source
This commit is contained in:
Rob Rix 2016-03-15 11:11:27 -04:00
parent 0fc6dd758b
commit 164a4fdd6f
3 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Data/Coalescent.hs
View File

@ -1,12 +1,13 @@
module Data.Coalescent where
import Control.Applicative
import Data.Align
import Data.Functor.Identity
-- | The class of types which can optionally be coalesced together.
class Coalescent a where
-- | Returns the result of coalescing the operands together in an Alternative context. If they cannot be coalesced, they should each be produced individually.
coalesce :: Alternative f => a -> a -> f a
coalesce :: (Align f, Alternative f) => a -> a -> f a
instance Coalescent a => Coalescent (Identity a) where
a `coalesce` b = sequenceA (coalesce <$> a <*> b)

3
src/Line.hs
View File

@ -2,6 +2,7 @@
module Line where
import Control.Applicative
import Data.Align
import Data.Coalescent
import Data.Functor.Both
@ -60,4 +61,4 @@ instance Coalescent (Line a) where
| otherwise = pure a <|> pure b
instance Coalescent (Both (Line a)) where
coalesce as bs = sequenceA (coalesce <$> as <*> bs)
coalesce as bs = tsequenceL (pure (Line [])) (coalesce <$> as <*> bs)

9
test/Data/Functor/Both/Spec.hs
View File

@ -1,5 +1,6 @@
module Data.Functor.Both.Spec (spec) where
import Data.Adjoined
import Data.Coalescent
import Data.Functor.Both
import Line
@ -9,13 +10,13 @@ spec :: Spec
spec = do
describe "Coalescent" $ do
it "should coalesce when both sides coalesce" $
(pure (Line [True]) `coalesce` pure (Line [True]) :: [Both (Line Bool)]) `shouldBe` [pure (Line [True, True])]
(pure (Line [True]) `coalesce` pure (Line [True]) :: Adjoined (Both (Line Bool))) `shouldBe` fromList [pure (Line [True, True])]
it "should not coalesce when neither side coalesces" $
(pure (Closed [True]) `coalesce` pure (Line [True]) :: [Both (Line Bool)]) `shouldBe` [pure (Closed [True]), pure (Line [True])]
(pure (Closed [True]) `coalesce` pure (Line [True]) :: Adjoined (Both (Line Bool))) `shouldBe` fromList [pure (Closed [True]), pure (Line [True])]
it "should coalesce asymmetrically at left" $
(both (Line [True]) (Closed [True]) `coalesce` pure (Line [True]) :: [Both (Line Bool)]) `shouldBe` [both (Line [True, True]) (Closed [True]), both (Line []) (Line [True])]
(both (Line [True]) (Closed [True]) `coalesce` pure (Line [True]) :: Adjoined (Both (Line Bool))) `shouldBe` fromList [both (Line [True, True]) (Closed [True]), both (Line []) (Line [True])]
it "should coalesce asymmetrically at right" $
(both (Closed [True]) (Line [True]) `coalesce` pure (Line [True]) :: [Both (Line Bool)]) `shouldBe` [both (Closed [True]) (Line [True, True]), both (Line [True]) (Line [])]
(both (Closed [True]) (Line [True]) `coalesce` pure (Line [True]) :: Adjoined (Both (Line Bool))) `shouldBe` fromList [both (Closed [True]) (Line [True, True]), both (Line [True]) (Line [])]