module Unison.Merge.TwoWay
  ( TwoWay (..),
    bothWays,
    justTheTerms,
    justTheTypes,
    or,
    sequenceDefns,
    swap,
    twoWay,
    unzipMap,
    who_,
  )
where

import Control.Lens (Lens')
import Data.Semialign (Semialign, alignWith)
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Data.These (These (These))
import Data.Zip (Unzip, Zip, unzipWith, zipWith)
import Unison.Merge.EitherWay (EitherWay (..))
import Unison.Prelude
import Unison.Util.Defns (Defns (..), DefnsF)
import Prelude hiding (or, zipWith)

data TwoWay a = TwoWay
  { forall a. TwoWay a -> a
alice :: a,
    forall a. TwoWay a -> a
bob :: a
  }
  deriving stock ((forall m. Monoid m => TwoWay m -> m)
-> (forall m a. Monoid m => (a -> m) -> TwoWay a -> m)
-> (forall m a. Monoid m => (a -> m) -> TwoWay a -> m)
-> (forall a b. (a -> b -> b) -> b -> TwoWay a -> b)
-> (forall a b. (a -> b -> b) -> b -> TwoWay a -> b)
-> (forall b a. (b -> a -> b) -> b -> TwoWay a -> b)
-> (forall b a. (b -> a -> b) -> b -> TwoWay a -> b)
-> (forall a. (a -> a -> a) -> TwoWay a -> a)
-> (forall a. (a -> a -> a) -> TwoWay a -> a)
-> (forall a. TwoWay a -> [a])
-> (forall a. TwoWay a -> Bool)
-> (forall a. TwoWay a -> Int)
-> (forall a. Eq a => a -> TwoWay a -> Bool)
-> (forall a. Ord a => TwoWay a -> a)
-> (forall a. Ord a => TwoWay a -> a)
-> (forall a. Num a => TwoWay a -> a)
-> (forall a. Num a => TwoWay a -> a)
-> Foldable TwoWay
forall a. Eq a => a -> TwoWay a -> Bool
forall a. Num a => TwoWay a -> a
forall a. Ord a => TwoWay a -> a
forall m. Monoid m => TwoWay m -> m
forall a. TwoWay a -> Bool
forall a. TwoWay a -> Int
forall a. TwoWay a -> [a]
forall a. (a -> a -> a) -> TwoWay a -> a
forall m a. Monoid m => (a -> m) -> TwoWay a -> m
forall b a. (b -> a -> b) -> b -> TwoWay a -> b
forall a b. (a -> b -> b) -> b -> TwoWay a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => TwoWay m -> m
fold :: forall m. Monoid m => TwoWay m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TwoWay a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> TwoWay a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TwoWay a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> TwoWay a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> TwoWay a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TwoWay a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TwoWay a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TwoWay a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TwoWay a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TwoWay a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TwoWay a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> TwoWay a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> TwoWay a -> a
foldr1 :: forall a. (a -> a -> a) -> TwoWay a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TwoWay a -> a
foldl1 :: forall a. (a -> a -> a) -> TwoWay a -> a
$ctoList :: forall a. TwoWay a -> [a]
toList :: forall a. TwoWay a -> [a]
$cnull :: forall a. TwoWay a -> Bool
null :: forall a. TwoWay a -> Bool
$clength :: forall a. TwoWay a -> Int
length :: forall a. TwoWay a -> Int
$celem :: forall a. Eq a => a -> TwoWay a -> Bool
elem :: forall a. Eq a => a -> TwoWay a -> Bool
$cmaximum :: forall a. Ord a => TwoWay a -> a
maximum :: forall a. Ord a => TwoWay a -> a
$cminimum :: forall a. Ord a => TwoWay a -> a
minimum :: forall a. Ord a => TwoWay a -> a
$csum :: forall a. Num a => TwoWay a -> a
sum :: forall a. Num a => TwoWay a -> a
$cproduct :: forall a. Num a => TwoWay a -> a
product :: forall a. Num a => TwoWay a -> a
Foldable, (forall a b. (a -> b) -> TwoWay a -> TwoWay b)
-> (forall a b. a -> TwoWay b -> TwoWay a) -> Functor TwoWay
forall a b. a -> TwoWay b -> TwoWay a
forall a b. (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TwoWay a -> TwoWay b
fmap :: forall a b. (a -> b) -> TwoWay a -> TwoWay b
$c<$ :: forall a b. a -> TwoWay b -> TwoWay a
<$ :: forall a b. a -> TwoWay b -> TwoWay a
Functor, (forall x. TwoWay a -> Rep (TwoWay a) x)
-> (forall x. Rep (TwoWay a) x -> TwoWay a) -> Generic (TwoWay a)
forall x. Rep (TwoWay a) x -> TwoWay a
forall x. TwoWay a -> Rep (TwoWay a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TwoWay a) x -> TwoWay a
forall a x. TwoWay a -> Rep (TwoWay a) x
$cfrom :: forall a x. TwoWay a -> Rep (TwoWay a) x
from :: forall x. TwoWay a -> Rep (TwoWay a) x
$cto :: forall a x. Rep (TwoWay a) x -> TwoWay a
to :: forall x. Rep (TwoWay a) x -> TwoWay a
Generic, Int -> TwoWay a -> ShowS
[TwoWay a] -> ShowS
TwoWay a -> String
(Int -> TwoWay a -> ShowS)
-> (TwoWay a -> String) -> ([TwoWay a] -> ShowS) -> Show (TwoWay a)
forall a. Show a => Int -> TwoWay a -> ShowS
forall a. Show a => [TwoWay a] -> ShowS
forall a. Show a => TwoWay a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TwoWay a -> ShowS
showsPrec :: Int -> TwoWay a -> ShowS
$cshow :: forall a. Show a => TwoWay a -> String
show :: TwoWay a -> String
$cshowList :: forall a. Show a => [TwoWay a] -> ShowS
showList :: [TwoWay a] -> ShowS
Show, Functor TwoWay
Foldable TwoWay
(Functor TwoWay, Foldable TwoWay) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> TwoWay a -> f (TwoWay b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TwoWay (f a) -> f (TwoWay a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TwoWay a -> m (TwoWay b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TwoWay (m a) -> m (TwoWay a))
-> Traversable TwoWay
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => TwoWay (m a) -> m (TwoWay a)
forall (f :: * -> *) a.
Applicative f =>
TwoWay (f a) -> f (TwoWay a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TwoWay a -> m (TwoWay b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TwoWay a -> f (TwoWay b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TwoWay a -> f (TwoWay b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TwoWay a -> f (TwoWay b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TwoWay (f a) -> f (TwoWay a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
TwoWay (f a) -> f (TwoWay a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TwoWay a -> m (TwoWay b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TwoWay a -> m (TwoWay b)
$csequence :: forall (m :: * -> *) a. Monad m => TwoWay (m a) -> m (TwoWay a)
sequence :: forall (m :: * -> *) a. Monad m => TwoWay (m a) -> m (TwoWay a)
Traversable)
  deriving (Semigroup (TwoWay a)
TwoWay a
Semigroup (TwoWay a) =>
TwoWay a
-> (TwoWay a -> TwoWay a -> TwoWay a)
-> ([TwoWay a] -> TwoWay a)
-> Monoid (TwoWay a)
[TwoWay a] -> TwoWay a
TwoWay a -> TwoWay a -> TwoWay a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (TwoWay a)
forall a. Monoid a => TwoWay a
forall a. Monoid a => [TwoWay a] -> TwoWay a
forall a. Monoid a => TwoWay a -> TwoWay a -> TwoWay a
$cmempty :: forall a. Monoid a => TwoWay a
mempty :: TwoWay a
$cmappend :: forall a. Monoid a => TwoWay a -> TwoWay a -> TwoWay a
mappend :: TwoWay a -> TwoWay a -> TwoWay a
$cmconcat :: forall a. Monoid a => [TwoWay a] -> TwoWay a
mconcat :: [TwoWay a] -> TwoWay a
Monoid, NonEmpty (TwoWay a) -> TwoWay a
TwoWay a -> TwoWay a -> TwoWay a
(TwoWay a -> TwoWay a -> TwoWay a)
-> (NonEmpty (TwoWay a) -> TwoWay a)
-> (forall b. Integral b => b -> TwoWay a -> TwoWay a)
-> Semigroup (TwoWay a)
forall b. Integral b => b -> TwoWay a -> TwoWay a
forall a. Semigroup a => NonEmpty (TwoWay a) -> TwoWay a
forall a. Semigroup a => TwoWay a -> TwoWay a -> TwoWay a
forall a b. (Semigroup a, Integral b) => b -> TwoWay a -> TwoWay a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a. Semigroup a => TwoWay a -> TwoWay a -> TwoWay a
<> :: TwoWay a -> TwoWay a -> TwoWay a
$csconcat :: forall a. Semigroup a => NonEmpty (TwoWay a) -> TwoWay a
sconcat :: NonEmpty (TwoWay a) -> TwoWay a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> TwoWay a -> TwoWay a
stimes :: forall b. Integral b => b -> TwoWay a -> TwoWay a
Semigroup) via (GenericSemigroupMonoid (TwoWay a))

instance Applicative TwoWay where
  pure :: forall a. a -> TwoWay a
pure a
x = a -> a -> TwoWay a
forall a. a -> a -> TwoWay a
TwoWay a
x a
x
  TwoWay a -> b
f a -> b
g <*> :: forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
<*> TwoWay a
x a
y = b -> b -> TwoWay b
forall a. a -> a -> TwoWay a
TwoWay (a -> b
f a
x) (a -> b
g a
y)

instance Semialign TwoWay where
  alignWith :: (These a b -> c) -> TwoWay a -> TwoWay b -> TwoWay c
  alignWith :: forall a b c. (These a b -> c) -> TwoWay a -> TwoWay b -> TwoWay c
alignWith These a b -> c
f =
    (a -> b -> c) -> TwoWay a -> TwoWay b -> TwoWay c
forall a b c. (a -> b -> c) -> TwoWay a -> TwoWay b -> TwoWay c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith \a
x b
y -> These a b -> c
f (a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y)

instance Unzip TwoWay where
  unzipWith :: (c -> (a, b)) -> TwoWay c -> (TwoWay a, TwoWay b)
  unzipWith :: forall c a b. (c -> (a, b)) -> TwoWay c -> (TwoWay a, TwoWay b)
unzipWith c -> (a, b)
f (TwoWay c
cx c
cy) =
    let (a
ax, b
bx) = c -> (a, b)
f c
cx
        (a
ay, b
by) = c -> (a, b)
f c
cy
     in (a -> a -> TwoWay a
forall a. a -> a -> TwoWay a
TwoWay a
ax a
ay, b -> b -> TwoWay b
forall a. a -> a -> TwoWay a
TwoWay b
bx b
by)

instance Zip TwoWay where
  zipWith :: (a -> b -> c) -> TwoWay a -> TwoWay b -> TwoWay c
  zipWith :: forall a b c. (a -> b -> c) -> TwoWay a -> TwoWay b -> TwoWay c
zipWith a -> b -> c
f (TwoWay a
x1 a
x2) (TwoWay b
y1 b
y2) =
    c -> c -> TwoWay c
forall a. a -> a -> TwoWay a
TwoWay (a -> b -> c
f a
x1 b
y1) (a -> b -> c
f a
x2 b
y2)

bothWays :: a -> TwoWay a
bothWays :: forall a. a -> TwoWay a
bothWays a
x =
  a -> a -> TwoWay a
forall a. a -> a -> TwoWay a
TwoWay a
x a
x

justTheTerms :: TwoWay (Defns terms types) -> TwoWay terms
justTheTerms :: forall terms types. TwoWay (Defns terms types) -> TwoWay terms
justTheTerms =
  (Defns terms types -> terms)
-> TwoWay (Defns terms types) -> TwoWay terms
forall a b. (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting terms (Defns terms types) terms
-> Defns terms types -> terms
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting terms (Defns terms types) terms
#terms)

justTheTypes :: TwoWay (Defns terms types) -> TwoWay types
justTheTypes :: forall terms types. TwoWay (Defns terms types) -> TwoWay types
justTheTypes =
  (Defns terms types -> types)
-> TwoWay (Defns terms types) -> TwoWay types
forall a b. (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting types (Defns terms types) types
-> Defns terms types -> types
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting types (Defns terms types) types
#types)

or :: TwoWay Bool -> Bool
or :: TwoWay Bool -> Bool
or =
  (Bool -> Bool -> Bool) -> TwoWay Bool -> Bool
forall a b. (a -> a -> b) -> TwoWay a -> b
twoWay Bool -> Bool -> Bool
(||)

sequenceDefns :: TwoWay (Defns terms types) -> DefnsF TwoWay terms types
sequenceDefns :: forall terms types.
TwoWay (Defns terms types) -> DefnsF TwoWay terms types
sequenceDefns TwoWay (Defns terms types)
defns =
  TwoWay terms -> TwoWay types -> Defns (TwoWay terms) (TwoWay types)
forall terms types. terms -> types -> Defns terms types
Defns (TwoWay (Defns terms types) -> TwoWay terms
forall terms types. TwoWay (Defns terms types) -> TwoWay terms
justTheTerms TwoWay (Defns terms types)
defns) (TwoWay (Defns terms types) -> TwoWay types
forall terms types. TwoWay (Defns terms types) -> TwoWay types
justTheTypes TwoWay (Defns terms types)
defns)

-- | Swap who's considered Alice and who's considered Bob. Usually nonsense, but sometimes what you need!
swap :: TwoWay a -> TwoWay a
swap :: forall a. TwoWay a -> TwoWay a
swap (TwoWay a
x a
y) =
  a -> a -> TwoWay a
forall a. a -> a -> TwoWay a
TwoWay a
y a
x

twoWay :: (a -> a -> b) -> TwoWay a -> b
twoWay :: forall a b. (a -> a -> b) -> TwoWay a -> b
twoWay a -> a -> b
f TwoWay {a
$sel:alice:TwoWay :: forall a. TwoWay a -> a
alice :: a
alice, a
$sel:bob:TwoWay :: forall a. TwoWay a -> a
bob :: a
bob} =
  a -> a -> b
f a
alice a
bob

-- | Unzip a @Map k (TwoWay v)@ into a @TwoWay (Map k v)@.
unzipMap :: (Ord k) => Map k (TwoWay v) -> TwoWay (Map k v)
unzipMap :: forall k v. Ord k => Map k (TwoWay v) -> TwoWay (Map k v)
unzipMap =
  (Map k v, Map k v) -> TwoWay (Map k v)
forall a. (a, a) -> TwoWay a
fromPair ((Map k v, Map k v) -> TwoWay (Map k v))
-> (Map k (TwoWay v) -> (Map k v, Map k v))
-> Map k (TwoWay v)
-> TwoWay (Map k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TwoWay v -> (v, v)) -> Map k (TwoWay v) -> (Map k v, Map k v)
forall c a b. (c -> (a, b)) -> Map k c -> (Map k a, Map k b)
forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith (\TwoWay {v
$sel:alice:TwoWay :: forall a. TwoWay a -> a
alice :: v
alice, v
$sel:bob:TwoWay :: forall a. TwoWay a -> a
bob :: v
bob} -> (v
alice, v
bob))

who_ :: EitherWay x -> Lens' (TwoWay a) a
who_ :: forall x a. EitherWay x -> Lens' (TwoWay a) a
who_ = \case
  Alice x
_ -> (a -> f a) -> TwoWay a -> f (TwoWay a)
#alice
  Bob x
_ -> (a -> f a) -> TwoWay a -> f (TwoWay a)
#bob

--

fromPair :: (a, a) -> TwoWay a
fromPair :: forall a. (a, a) -> TwoWay a
fromPair (a
alice, a
bob) =
  TwoWay {a
$sel:alice:TwoWay :: a
alice :: a
alice, a
$sel:bob:TwoWay :: a
bob :: a
bob}