{- |
Module      : Antelude.Function
Description : Contains some functional functions and symbols.
Maintainer  : dneavesdev@pm.me

I realized after-the-fact that the arrows (which I was taking inspiration from Elm) is essentially part of what the 'flow' package does.
-}
module Antelude.Function
    ( constant
    , identity
      -- | Reexport from 'Data.Function'
    , Prelude.flip
      -- | Reexport from 'Prelude'
    , Prelude.asTypeOf
      -- | Reexport from 'Prelude'
    , Prelude.seq
      -- operators
    , (.>)
    , (<.)
    , (<|)
    , (|>)
    ) where

import safe qualified Prelude


-- | Re-return the first argument. Can be surprisingly useful.
identity :: a -> a
identity :: forall a. a -> a
identity = a -> a
forall a. a -> a
Prelude.id


-- | Always return the first argument.
constant :: a -> b -> a
constant :: forall a b. a -> b -> a
constant = a -> b -> a
forall a b. a -> b -> a
Prelude.const


infixr 0 <|


-- | Equivalent to '($)' from 'Data.Function', but like Elm. Can be slightly clearer for unfamiliar developers.
(<|) :: (a -> b) -> a -> b
a -> b
a <| :: forall a b. (a -> b) -> a -> b
<| a
b = a -> b
a a
b

infixl 0 |>


-- | Equivalent to '(&)' from 'Data.Function', but like Elm. Can be slightly clearer for unfamiliar developers.
(|>) :: a -> (a -> b) -> b
a
a |> :: forall a b. a -> (a -> b) -> b
|> a -> b
b = a -> b
b a
a


infixl 9 <.


{- |
   Equivalent to '(.)' from 'Data.Function', but in an arrowhead format.

   Since '(<<)' would be confused with 'flip (>>)', '(<.)' was decided as it's `(.)` but with a direction.
-}
(<.) :: (b -> c) -> (a -> b) -> a -> c
b -> c
a <. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
<. a -> b
b = \a
x -> b -> c
a (b -> c) -> b -> c
forall a b. (a -> b) -> a -> b
<| a -> b
b a
x


infixr 9 .>


{- |
   Equivalent to 'flip (.)', but in an arrowhead format.

   Since '(>>)' is already a typeclass-locked Haskell symbol for `Monad`, '(.>)' was decided as was decided as it's `(.)` but with a direction.
-}
(.>) :: (a -> b) -> (b -> c) -> a -> c
a -> b
a .> :: forall a b c. (a -> b) -> (b -> c) -> a -> c
.> b -> c
b = \a
x -> b -> c
b (b -> c) -> b -> c
forall a b. (a -> b) -> a -> b
<| a -> b
a a
x