github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-30 18:36:27 +03:00
Code Issues Projects Releases Wiki Activity

Define fixity and precedence for applyToBoth.

Browse Source
This commit is contained in:
Rob Rix 2016-05-27 10:22:51 -04:00
parent 41d532dd2d
commit 5dd24a96ea
1 changed files with 2 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Alignment.hs
View File

@ -211,6 +211,8 @@ applyThese :: Join These (a -> b) -> Join These a -> Maybe (Join These b)
applyThese (Join fg) (Join ab) = fmap Join . uncurry maybeThese $ uncurry (***) (bimap (<*>) (<*>) (unpack fg)) (unpack ab) applyThese (Join fg) (Join ab) = fmap Join . uncurry maybeThese $ uncurry (***) (bimap (<*>) (<*>) (unpack fg)) (unpack ab)
where unpack = fromThese Nothing Nothing . bimap Just Just where unpack = fromThese Nothing Nothing . bimap Just Just
infixl 4 `applyToBoth`
-- | Like `<*>`, but it takes a `Both` on the right to ensure that it can always return a value. -- | Like `<*>`, but it takes a `Both` on the right to ensure that it can always return a value.
applyToBoth :: Join These (a -> b) -> Both a -> Join These b applyToBoth :: Join These (a -> b) -> Both a -> Join These b
applyToBoth (Join fg) (Join (a, b)) = Join $ these (This . ($ a)) (That . ($ b)) (\ f g -> These (f a) (g b)) fg applyToBoth (Join fg) (Join (a, b)) = Join $ these (This . ($ a)) (That . ($ b)) (\ f g -> These (f a) (g b)) fg