{-# LINE 1 "src/Control/Composition.cpphs" #-}
# 1 "src/Control/Composition.cpphs"
# 1 "<built-in>"
# 1 "<command-line>"
# 12 "<command-line>"
# 1 "/usr/include/stdc-predef.h" 1 3 4

# 17 "/usr/include/stdc-predef.h" 3 4










































# 12 "<command-line>" 2
# 1 "./dist/build/autogen/cabal_macros.h" 1



# 13 "./dist/build/autogen/cabal_macros.h"


# 24 "./dist/build/autogen/cabal_macros.h"


# 35 "./dist/build/autogen/cabal_macros.h"


# 46 "./dist/build/autogen/cabal_macros.h"


# 57 "./dist/build/autogen/cabal_macros.h"


# 68 "./dist/build/autogen/cabal_macros.h"


# 79 "./dist/build/autogen/cabal_macros.h"


# 90 "./dist/build/autogen/cabal_macros.h"


# 101 "./dist/build/autogen/cabal_macros.h"


# 112 "./dist/build/autogen/cabal_macros.h"


# 123 "./dist/build/autogen/cabal_macros.h"


# 134 "./dist/build/autogen/cabal_macros.h"


# 145 "./dist/build/autogen/cabal_macros.h"


# 156 "./dist/build/autogen/cabal_macros.h"


# 167 "./dist/build/autogen/cabal_macros.h"


# 178 "./dist/build/autogen/cabal_macros.h"

# 12 "<command-line>" 2
# 1 "/usr/local/haskell/ghc-8.2.2-x86_64/lib/ghc-8.2.2/include/ghcversion.h" 1















# 12 "<command-line>" 2
# 1 "/tmp/ghc29562_0/ghc_2.h" 1


















































































































































































































































































































































































































# 12 "<command-line>" 2
# 1 "src/Control/Composition.cpphs"
module Control.Composition
    ( -- * Postcomposition
      (.*)
    , (.**)
    , (.***)
    , (.****)
    -- * Precomposition
    , (-.)
    , (-.*)
    , (-.**)
    , (-.***)
    , (-.****)
    -- * Fancy function application
    , (-$)
    -- * Monadic helpers
    , bisequence'
    -- * Monadic actions
    , axe
    , biaxe
    -- * Composition with lists of functions
    , thread
    -- * Tuple helpers
    , both
    -- * Functor helpers
    , (<&>)
    -- * Reëxports from base
    , (&)
    , fix
    , on
    ) where

import           Control.Arrow ((***))
import           Control.Monad

import           Data.Function (fix, on, (&))




infixr 8 .*
infixr 8 .**
infixr 8 .***
infixr 8 .****
infixr 8 -.*
infixr 8 -.**
infixr 8 -.***
infixr 8 -.****
infixl 8 -$



infixl 1 <&>









axe :: (Traversable t, Monad m) => t (a -> m ()) -> a -> m ()

axe = sequence_ .* sequence




bisequence' :: (Traversable t, Monad m) => t (a -> b -> m c) -> a -> b -> t (m c)

bisequence' = sequence .* sequence




biaxe :: (Traversable t, Monad m) => t (a -> b -> m ()) -> a -> b -> m ()

biaxe = sequence_ .** bisequence'

both :: (a -> b) -> (a, a) -> (b, b)
both = join (***)

-- | Backwards function application
(-$) :: (a -> b -> c) -> b -> a -> c
(-$) f x y = f y x

-- | As an example:
--
-- > λ:> ((*2) .* (+)) 1 3 4
-- > 16
(.*) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.*) f g x y = f (g x y)

(.**) :: (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
(.**) f g x y z = f (g x y z)

(.***) :: (e -> f) -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> f
(.***) f g w x y z = f (g w x y z)

(.****) :: (f -> g) -> (a -> b -> c -> d -> e -> f) -> a -> b -> c -> d -> e -> g
(.****) f g v w x y z = f (g v w x y z)

-- | The Oedipus combinator
(-.*) :: (b -> c) -> (a -> c -> d) -> a -> b -> d
(-.*) f g x y = g x (f y)

(-.**) :: (c -> d) -> (a -> b -> d -> e) -> a -> b -> c -> e
(-.**) f g x y z = g x y (f z)

(-.***) :: (d -> e) -> (a -> b -> c -> e -> f) -> a -> b -> c -> d -> f
(-.***) f g w x y z = g w x y (f z)

(-.****) :: (e -> f) -> (a -> b -> c -> d -> f -> g) -> a -> b -> c -> d -> e -> g
(-.****) f g v w x y z = g v w x y (f z)

-- | Backwards function composition
(-.) :: (a -> b) -> (b -> c) -> a -> c
(-.) f g x = g (f x)

(<&>) :: Functor f => f a -> (a -> b) -> f b
x <&> f = fmap f x

{-# RULES
    "thread" forall f g. thread [f, g] = f . g
  #-}

{-# RULES
    "thread" forall f g h. thread [f, g, h] = f . g . h
  #-}

{-# RULES
    "thread/fmap" forall f fs. thread (f:fs) = f . thread fs
  #-}

thread :: [a -> a] -> a -> a
thread = foldr (.) id

{-# INLINE [1] thread #-}