{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Agda.Utils.Tuple
  ( (-*-)
  , mapFst
  , mapSnd
  , (/\)
  , fst3
  , snd3
  , thd3
  , swap
  , uncurry3
  , uncurry4
  , mapPairM
  , mapFstM
  , mapSndM
  , List2(..)
  ) where

import Control.Arrow  ((&&&))
import Data.Bifunctor (bimap, first, second)
import Data.Tuple (swap)

infix 2 -*-
infix 3 /\ -- backslashes at EOL interact badly with CPP...

-- | Bifunctoriality for pairs.
(-*-) :: (a -> c) -> (b -> d) -> (a,b) -> (c,d)
-*- :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)
(-*-) = (a -> c) -> (b -> d) -> (a, b) -> (c, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap

-- | @mapFst f = f -*- id@
mapFst :: (a -> c) -> (a,b) -> (c,b)
mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst = (a -> c) -> (a, b) -> (c, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first

-- | @mapSnd g = id -*- g@
mapSnd :: (b -> d) -> (a,b) -> (a,d)
mapSnd :: (b -> d) -> (a, b) -> (a, d)
mapSnd = (b -> d) -> (a, b) -> (a, d)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second

-- | Lifted pairing.
(/\) :: (a -> b) -> (a -> c) -> a -> (b,c)
/\ :: (a -> b) -> (a -> c) -> a -> (b, c)
(/\) = (a -> b) -> (a -> c) -> a -> (b, c)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&)

-- * Triple (stolen from Data.Tuple.HT)

{-# INLINE fst3 #-}
fst3 :: (a,b,c) -> a
fst3 :: (a, b, c) -> a
fst3 ~(a
x,b
_,c
_) = a
x

{-# INLINE snd3 #-}
snd3 :: (a,b,c) -> b
snd3 :: (a, b, c) -> b
snd3 ~(a
_,b
x,c
_) = b
x

{-# INLINE thd3 #-}
thd3 :: (a,b,c) -> c
thd3 :: (a, b, c) -> c
thd3 ~(a
_,b
_,c
x) = c
x

{-# INLINE uncurry3 #-}
uncurry3 :: (a -> b -> c -> d) -> (a,b,c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
f ~(a
x,b
y,c
z) = a -> b -> c -> d
f a
x b
y c
z

{-# INLINE uncurry4 #-}
uncurry4 :: (a -> b -> c -> d -> e) -> (a,b,c,d) -> e
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 a -> b -> c -> d -> e
f ~(a
w,b
x,c
y,d
z) = a -> b -> c -> d -> e
f a
w b
x c
y d
z

-- | Monadic version of '-*-'.
mapPairM :: (Applicative m) => (a -> m c) -> (b -> m d) -> (a,b) -> m (c,d)
mapPairM :: (a -> m c) -> (b -> m d) -> (a, b) -> m (c, d)
mapPairM a -> m c
f b -> m d
g ~(a
a,b
b) = (,) (c -> d -> (c, d)) -> m c -> m (d -> (c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m c
f a
a m (d -> (c, d)) -> m d -> m (c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m d
g b
b

-- | Monadic 'mapFst'.
mapFstM :: (Applicative m) => (a -> m c) -> (a,b) -> m (c,b)
mapFstM :: (a -> m c) -> (a, b) -> m (c, b)
mapFstM a -> m c
f ~(a
a,b
b) = (,b
b) (c -> (c, b)) -> m c -> m (c, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m c
f a
a

-- | Monadic 'mapSnd'.
mapSndM :: (Applicative m) => (b -> m d) -> (a,b) -> m (a,d)
mapSndM :: (b -> m d) -> (a, b) -> m (a, d)
mapSndM b -> m d
f ~(a
a,b
b) = (a
a,) (d -> (a, d)) -> m d -> m (a, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m d
f b
b

newtype List2 a = List2 { List2 a -> (a, a)
list2 :: (a,a) }
  deriving (List2 a -> List2 a -> Bool
(List2 a -> List2 a -> Bool)
-> (List2 a -> List2 a -> Bool) -> Eq (List2 a)
forall a. Eq a => List2 a -> List2 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List2 a -> List2 a -> Bool
$c/= :: forall a. Eq a => List2 a -> List2 a -> Bool
== :: List2 a -> List2 a -> Bool
$c== :: forall a. Eq a => List2 a -> List2 a -> Bool
Eq, a -> List2 b -> List2 a
(a -> b) -> List2 a -> List2 b
(forall a b. (a -> b) -> List2 a -> List2 b)
-> (forall a b. a -> List2 b -> List2 a) -> Functor List2
forall a b. a -> List2 b -> List2 a
forall a b. (a -> b) -> List2 a -> List2 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> List2 b -> List2 a
$c<$ :: forall a b. a -> List2 b -> List2 a
fmap :: (a -> b) -> List2 a -> List2 b
$cfmap :: forall a b. (a -> b) -> List2 a -> List2 b
Functor, List2 a -> Bool
(a -> m) -> List2 a -> m
(a -> b -> b) -> b -> List2 a -> b
(forall m. Monoid m => List2 m -> m)
-> (forall m a. Monoid m => (a -> m) -> List2 a -> m)
-> (forall m a. Monoid m => (a -> m) -> List2 a -> m)
-> (forall a b. (a -> b -> b) -> b -> List2 a -> b)
-> (forall a b. (a -> b -> b) -> b -> List2 a -> b)
-> (forall b a. (b -> a -> b) -> b -> List2 a -> b)
-> (forall b a. (b -> a -> b) -> b -> List2 a -> b)
-> (forall a. (a -> a -> a) -> List2 a -> a)
-> (forall a. (a -> a -> a) -> List2 a -> a)
-> (forall a. List2 a -> [a])
-> (forall a. List2 a -> Bool)
-> (forall a. List2 a -> Int)
-> (forall a. Eq a => a -> List2 a -> Bool)
-> (forall a. Ord a => List2 a -> a)
-> (forall a. Ord a => List2 a -> a)
-> (forall a. Num a => List2 a -> a)
-> (forall a. Num a => List2 a -> a)
-> Foldable List2
forall a. Eq a => a -> List2 a -> Bool
forall a. Num a => List2 a -> a
forall a. Ord a => List2 a -> a
forall m. Monoid m => List2 m -> m
forall a. List2 a -> Bool
forall a. List2 a -> Int
forall a. List2 a -> [a]
forall a. (a -> a -> a) -> List2 a -> a
forall m a. Monoid m => (a -> m) -> List2 a -> m
forall b a. (b -> a -> b) -> b -> List2 a -> b
forall a b. (a -> b -> b) -> b -> List2 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
product :: List2 a -> a
$cproduct :: forall a. Num a => List2 a -> a
sum :: List2 a -> a
$csum :: forall a. Num a => List2 a -> a
minimum :: List2 a -> a
$cminimum :: forall a. Ord a => List2 a -> a
maximum :: List2 a -> a
$cmaximum :: forall a. Ord a => List2 a -> a
elem :: a -> List2 a -> Bool
$celem :: forall a. Eq a => a -> List2 a -> Bool
length :: List2 a -> Int
$clength :: forall a. List2 a -> Int
null :: List2 a -> Bool
$cnull :: forall a. List2 a -> Bool
toList :: List2 a -> [a]
$ctoList :: forall a. List2 a -> [a]
foldl1 :: (a -> a -> a) -> List2 a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> List2 a -> a
foldr1 :: (a -> a -> a) -> List2 a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> List2 a -> a
foldl' :: (b -> a -> b) -> b -> List2 a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> List2 a -> b
foldl :: (b -> a -> b) -> b -> List2 a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> List2 a -> b
foldr' :: (a -> b -> b) -> b -> List2 a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> List2 a -> b
foldr :: (a -> b -> b) -> b -> List2 a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> List2 a -> b
foldMap' :: (a -> m) -> List2 a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> List2 a -> m
foldMap :: (a -> m) -> List2 a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> List2 a -> m
fold :: List2 m -> m
$cfold :: forall m. Monoid m => List2 m -> m
Foldable, Functor List2
Foldable List2
Functor List2
-> Foldable List2
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> List2 a -> f (List2 b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    List2 (f a) -> f (List2 a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> List2 a -> m (List2 b))
-> (forall (m :: * -> *) a. Monad m => List2 (m a) -> m (List2 a))
-> Traversable List2
(a -> f b) -> List2 a -> f (List2 b)
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 => List2 (m a) -> m (List2 a)
forall (f :: * -> *) a. Applicative f => List2 (f a) -> f (List2 a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> List2 a -> m (List2 b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List2 a -> f (List2 b)
sequence :: List2 (m a) -> m (List2 a)
$csequence :: forall (m :: * -> *) a. Monad m => List2 (m a) -> m (List2 a)
mapM :: (a -> m b) -> List2 a -> m (List2 b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> List2 a -> m (List2 b)
sequenceA :: List2 (f a) -> f (List2 a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => List2 (f a) -> f (List2 a)
traverse :: (a -> f b) -> List2 a -> f (List2 b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List2 a -> f (List2 b)
$cp2Traversable :: Foldable List2
$cp1Traversable :: Functor List2
Traversable)

instance Applicative List2 where
  pure :: a -> List2 a
pure a
a                            = (a, a) -> List2 a
forall a. (a, a) -> List2 a
List2 (a
a,a
a)
  (List2 (a -> b
f,a -> b
f')) <*> :: List2 (a -> b) -> List2 a -> List2 b
<*> (List2 (a
a,a
a')) = (b, b) -> List2 b
forall a. (a, a) -> List2 a
List2 (a -> b
f a
a, a -> b
f' a
a')