-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <1793913507@qq.com>
-- Stability: experimental
-- Portability: portable
-- Utilities that don't make a lot of sense.
module Distribution.Uusi.Utils
  ( (|>),
    (<|),
    chain,
  )
where

import Data.Function ((&))
import Distribution.Uusi.Types (Op)

infixl 1 |>

infixr 0 <|

-- | The same as '&', but lovelier
(|>) :: a -> (a -> b) -> b
|> :: a -> (a -> b) -> b
(|>) = a -> (a -> b) -> b
forall a b. a -> (a -> b) -> b
(&)

-- | The same as '$', but lovelier
(<|) :: (a -> b) -> a -> b
<| :: (a -> b) -> a -> b
(<|) = (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)

-- | Connect a series of 'Op'
chain :: [Op a] -> Op a
chain :: [Op a] -> Op a
chain = (Op a -> Op a -> Op a) -> Op a -> [Op a] -> Op a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Op a -> Op a -> Op a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Op a
forall a. a -> a
id