{-|

Miscellaneous combinators.

-}
module Language.Fortran.Model.Util where

import           Control.Applicative
import           Control.Monad.Reader

import           Data.Function       ((&), on)

--------------------------------------------------------------------------------
--  Combinators
--------------------------------------------------------------------------------

-- | Like 'on', but apply a different function to each argument (which are
-- allowed to have different types).
on2 :: (c -> d -> e) -> (a -> c) -> (b -> d) -> a -> b -> e
on2 :: (c -> d -> e) -> (a -> c) -> (b -> d) -> a -> b -> e
on2 c -> d -> e
h a -> c
g b -> d
f = (c -> d -> e
h (c -> d -> e) -> (a -> c) -> a -> d -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
g) (a -> d -> e) -> (b -> d) -> a -> b -> e
forall a c d b. (a -> c -> d) -> (b -> c) -> a -> b -> d
*.. b -> d
f


-- | '..*' in the Kleisli category.
matchingWithBoth :: (Monad m) => (a -> b -> m c) -> (c -> m r) -> a -> b -> m r
matchingWithBoth :: (a -> b -> m c) -> (c -> m r) -> a -> b -> m r
matchingWithBoth a -> b -> m c
f c -> m r
k = (m c -> (c -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> m r
k) (m c -> m r) -> (a -> b -> m c) -> a -> b -> m r
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
..* a -> b -> m c
f


-- | 'on2' in the Kleisli category.
matchingWith2 :: (Monad m) => (a -> m a') -> (b -> m b') -> ((a', b') -> m r) -> a -> b -> m r
matchingWith2 :: (a -> m a') -> (b -> m b') -> ((a', b') -> m r) -> a -> b -> m r
matchingWith2 = (a -> b -> m (a', b')) -> ((a', b') -> m r) -> a -> b -> m r
forall (m :: * -> *) a b c r.
Monad m =>
(a -> b -> m c) -> (c -> m r) -> a -> b -> m r
matchingWithBoth ((a -> b -> m (a', b')) -> ((a', b') -> m r) -> a -> b -> m r)
-> ((a -> m a') -> (b -> m b') -> a -> b -> m (a', b'))
-> (a -> m a')
-> (b -> m b')
-> ((a', b') -> m r)
-> a
-> b
-> m r
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
..* (m a' -> m b' -> m (a', b'))
-> (a -> m a') -> (b -> m b') -> a -> b -> m (a', b')
forall c d e a b.
(c -> d -> e) -> (a -> c) -> (b -> d) -> a -> b -> e
on2 ((a' -> b' -> (a', b')) -> m a' -> m b' -> m (a', b')
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,))


-- | Alternative @('<|>')@ over single-argument functions.
altf :: (Alternative f) => (a -> f b) -> (a -> f b) -> a -> f b
altf :: (a -> f b) -> (a -> f b) -> a -> f b
altf = ReaderT a f b -> a -> f b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT a f b -> a -> f b)
-> (ReaderT a f b -> ReaderT a f b -> ReaderT a f b)
-> ReaderT a f b
-> ReaderT a f b
-> a
-> f b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
..* ReaderT a f b -> ReaderT a f b -> ReaderT a f b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (ReaderT a f b -> ReaderT a f b -> a -> f b)
-> ((a -> f b) -> ReaderT a f b)
-> (a -> f b)
-> (a -> f b)
-> a
-> f b
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a -> f b) -> ReaderT a f b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT


-- | Alternative @('<|>')@ over two-argument functions.
altf2 :: (Alternative f) => (a -> b -> f c) -> (a -> b -> f c) -> a -> b -> f c
altf2 :: (a -> b -> f c) -> (a -> b -> f c) -> a -> b -> f c
altf2 = ((a, b) -> f c) -> a -> b -> f c
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((a, b) -> f c) -> a -> b -> f c)
-> (((a, b) -> f c) -> ((a, b) -> f c) -> (a, b) -> f c)
-> ((a, b) -> f c)
-> ((a, b) -> f c)
-> a
-> b
-> f c
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
..* ((a, b) -> f c) -> ((a, b) -> f c) -> (a, b) -> f c
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> (a -> f b) -> a -> f b
altf (((a, b) -> f c) -> ((a, b) -> f c) -> a -> b -> f c)
-> ((a -> b -> f c) -> (a, b) -> f c)
-> (a -> b -> f c)
-> (a -> b -> f c)
-> a
-> b
-> f c
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a -> b -> f c) -> (a, b) -> f c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

-- | Flipped 'fmap'.
(<$$>) :: (Functor f) => f a -> (a -> b) -> f b
<$$> :: f a -> (a -> b) -> f b
(<$$>) = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>)

-- | Flipped function application.
with :: a -> (a -> b) -> b
with :: a -> (a -> b) -> b
with = a -> (a -> b) -> b
forall a b. a -> (a -> b) -> b
(&)

-- | @(f *.. g) x y = f x (g y)@. Mnemonic: the @*@ is next to the function
-- which has two arguments.
(*..) :: (a -> c -> d) -> (b -> c) -> a -> b -> d
(a -> c -> d
f *.. :: (a -> c -> d) -> (b -> c) -> a -> b -> d
*.. b -> c
g) a
x b
y = a -> c -> d
f a
x (b -> c
g b
y)

-- | @(f ..* g) x y = f (g x y)@. Mnemonic: the @*@ is next to the function
-- which has two arguments.
(..*) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
c -> d
f ..* :: (c -> d) -> (a -> b -> c) -> a -> b -> d
..* a -> b -> c
g = ((a, b) -> d) -> a -> b -> d
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (c -> d
f (c -> d) -> ((a, b) -> c) -> (a, b) -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
g)