mirror of
https://github.com/github/semantic.git
synced 2024-12-26 00:12:29 +03:00
Represent Both
as Join (,)
.
This commit is contained in:
parent
60d6cfeb90
commit
06c4759aed
@ -1,20 +1,20 @@
|
|||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
module Data.Functor.Both where
|
module Data.Functor.Both where
|
||||||
|
|
||||||
import Data.Align
|
import Data.Align
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
|
import Data.Bifunctor.Join
|
||||||
import Data.Bifunctor.These
|
import Data.Bifunctor.These
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Prelude hiding (zipWith, fst, snd)
|
import Prelude hiding (zipWith, fst, snd)
|
||||||
import qualified Prelude
|
import qualified Prelude
|
||||||
|
|
||||||
-- | A computation over both sides of a pair.
|
-- | A computation over both sides of a pair.
|
||||||
newtype Both a = Both { runBoth :: (a, a) }
|
type Both a = Join (,) a
|
||||||
deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
|
|
||||||
|
|
||||||
-- | Given two operands returns a functor operating on `Both`. This is a curried synonym for Both.
|
-- | Given two operands returns a functor operating on `Both`. This is a curried synonym for Both.
|
||||||
both :: a -> a -> Both a
|
both :: a -> a -> Both a
|
||||||
both = curry Both
|
both = curry Join
|
||||||
|
|
||||||
-- | Construct Both with These values & defaults.
|
-- | Construct Both with These values & defaults.
|
||||||
bothOfThese :: Both a -> These a a -> Both a
|
bothOfThese :: Both a -> These a a -> Both a
|
||||||
@ -30,6 +30,10 @@ maybeBothOfThese = bothOfThese (pure Nothing) . bimap Just Just
|
|||||||
pairWithThese :: Both a -> These b c -> These (a, b) (a, c)
|
pairWithThese :: Both a -> These b c -> These (a, b) (a, c)
|
||||||
pairWithThese = uncurry bimap . bimap (,) (,) . runBoth
|
pairWithThese = uncurry bimap . bimap (,) (,) . runBoth
|
||||||
|
|
||||||
|
-- | Extract `Both` sides of a computation.
|
||||||
|
runBoth :: Both a -> (a, a)
|
||||||
|
runBoth = runJoin
|
||||||
|
|
||||||
-- | Apply a function to `Both` sides of a computation.
|
-- | Apply a function to `Both` sides of a computation.
|
||||||
runBothWith :: (a -> a -> b) -> Both a -> b
|
runBothWith :: (a -> a -> b) -> Both a -> b
|
||||||
runBothWith f = uncurry f . runBoth
|
runBothWith f = uncurry f . runBoth
|
||||||
@ -44,16 +48,12 @@ snd = Prelude.snd . runBoth
|
|||||||
|
|
||||||
unzip :: [Both a] -> Both [a]
|
unzip :: [Both a] -> Both [a]
|
||||||
unzip = foldr pair (pure [])
|
unzip = foldr pair (pure [])
|
||||||
where pair (Both (a, b)) (Both (as, bs)) = Both (a : as, b : bs)
|
where pair (Join (a, b)) (Join (as, bs)) = Join (a : as, b : bs)
|
||||||
|
|
||||||
instance Applicative Both where
|
instance Monoid a => Monoid (Join (,) a) where
|
||||||
pure a = Both (a, a)
|
|
||||||
Both (f, g) <*> Both (a, b) = Both (f a, g b)
|
|
||||||
|
|
||||||
instance Monoid a => Monoid (Both a) where
|
|
||||||
mempty = pure mempty
|
mempty = pure mempty
|
||||||
mappend a b = mappend <$> a <*> b
|
mappend a b = mappend <$> a <*> b
|
||||||
|
|
||||||
|
|
||||||
instance TotalCrosswalk Both where
|
instance TotalCrosswalk (Join (,)) where
|
||||||
tsequenceL d = runBothWith (alignWith (\ these -> fromMaybe <$> d <*> maybeBothOfThese these))
|
tsequenceL d = runBothWith (alignWith (\ these -> fromMaybe <$> d <*> maybeBothOfThese these))
|
||||||
|
@ -9,6 +9,7 @@ import Category
|
|||||||
import Control.Comonad.Cofree
|
import Control.Comonad.Cofree
|
||||||
import Control.Monad.Free
|
import Control.Monad.Free
|
||||||
import Data.Aeson hiding (json)
|
import Data.Aeson hiding (json)
|
||||||
|
import Data.Bifunctor.Join
|
||||||
import Data.ByteString.Builder
|
import Data.ByteString.Builder
|
||||||
import Data.ByteString.Lazy
|
import Data.ByteString.Lazy
|
||||||
import Data.Functor.Both
|
import Data.Functor.Both
|
||||||
@ -46,7 +47,7 @@ instance ToJSON Range where
|
|||||||
toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ]
|
toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ]
|
||||||
toEncoding (Range start end) = foldable [ start, end ]
|
toEncoding (Range start end) = foldable [ start, end ]
|
||||||
instance ToJSON a => ToJSON (Both a) where
|
instance ToJSON a => ToJSON (Both a) where
|
||||||
toJSON (Both (a, b)) = Array . fromList $ toJSON <$> [ a, b ]
|
toJSON (Join (a, b)) = Array . fromList $ toJSON <$> [ a, b ]
|
||||||
toEncoding = foldable
|
toEncoding = foldable
|
||||||
instance ToJSON (SplitDiff leaf Info) where
|
instance ToJSON (SplitDiff leaf Info) where
|
||||||
toJSON (Free (Annotated info syntax)) = object (termFields info syntax)
|
toJSON (Free (Annotated info syntax)) = object (termFields info syntax)
|
||||||
|
@ -16,6 +16,7 @@ import Source hiding ((++), break)
|
|||||||
import SplitDiff
|
import SplitDiff
|
||||||
import Control.Comonad.Cofree
|
import Control.Comonad.Cofree
|
||||||
import Control.Monad.Free
|
import Control.Monad.Free
|
||||||
|
import Data.Bifunctor.Join
|
||||||
import Data.Functor.Both as Both
|
import Data.Functor.Both as Both
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
@ -114,7 +115,7 @@ hunks _ blobs | sources <- source <$> blobs
|
|||||||
, sourcesNull <- runBothWith (&&) (null <$> sources)
|
, sourcesNull <- runBothWith (&&) (null <$> sources)
|
||||||
, sourcesEqual || sourcesNull
|
, sourcesEqual || sourcesNull
|
||||||
= [Hunk { offset = mempty, changes = [], trailingContext = [] }]
|
= [Hunk { offset = mempty, changes = [], trailingContext = [] }]
|
||||||
hunks diff blobs = hunksInRows (Both (1, 1)) $ fmap (fmap Prelude.fst) <$> splitDiffByLines (source <$> blobs) diff
|
hunks diff blobs = hunksInRows (Join (1, 1)) $ fmap (fmap Prelude.fst) <$> splitDiffByLines (source <$> blobs) diff
|
||||||
|
|
||||||
-- | Given beginning line numbers, turn rows in a split diff into hunks in a
|
-- | Given beginning line numbers, turn rows in a split diff into hunks in a
|
||||||
-- | patch.
|
-- | patch.
|
||||||
|
@ -1,8 +1,10 @@
|
|||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
module ArbitraryTerm where
|
module ArbitraryTerm where
|
||||||
|
|
||||||
import Category
|
import Category
|
||||||
import Control.Comonad.Cofree
|
import Control.Comonad.Cofree
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Data.Bifunctor.Join
|
||||||
import Data.Functor.Both
|
import Data.Functor.Both
|
||||||
import qualified Data.OrderedMap as Map
|
import qualified Data.OrderedMap as Map
|
||||||
import qualified Data.List as List
|
import qualified Data.List as List
|
||||||
@ -55,7 +57,7 @@ instance Categorizable CategorySet where
|
|||||||
instance Arbitrary CategorySet where
|
instance Arbitrary CategorySet where
|
||||||
arbitrary = elements [ A, B, C, D ]
|
arbitrary = elements [ A, B, C, D ]
|
||||||
|
|
||||||
instance Arbitrary a => Arbitrary (Both a) where
|
instance Arbitrary a => Arbitrary (Join (,) a) where
|
||||||
arbitrary = both <$> arbitrary <*> arbitrary
|
arbitrary = both <$> arbitrary <*> arbitrary
|
||||||
shrink b = both <$> (shrink (fst b)) <*> (shrink (snd b))
|
shrink b = both <$> (shrink (fst b)) <*> (shrink (snd b))
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user