Applicative.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

module Papa.Base.Control.Applicative (
  Applicative (pure, (<*>), (*>), (<*)),
  Alternative (empty, (<|>), some, many),
  Const (Const, getConst),
  WrappedMonad (unwrapMonad),
  WrappedArrow (unwrapArrow),
  ZipList (getZipList),
  (<$>),
  (<$),
  (<**>),
  liftA,
  liftA2,
  liftA3,
  optional,
  const,
  replicateA,
  replicateA_,
) where

import Control.Applicative (
  Alternative (empty, many, some, (<|>)),
  Applicative (pure, (*>), (<*), (<*>)),
  Const (Const, getConst),
  WrappedArrow (unwrapArrow),
  WrappedMonad (unwrapMonad),
  ZipList (getZipList),
  liftA,
  liftA2,
  liftA3,
  optional,
  (<$),
  (<$>),
  (<**>),
 )
import Papa.Base.Prelude (IO, Int, Maybe, otherwise, (-), (<=))

{-# INLINE const #-}
const ::
  (Applicative f) =>
  a ->
  f a
const =
  pure

{-# INLINEABLE replicateA #-}
{-# SPECIALIZE replicateA ::
  Int ->
  IO a ->
  IO [a]
  #-}
{-# SPECIALIZE replicateA ::
  Int ->
  Maybe a ->
  Maybe [a]
  #-}
replicateA :: (Applicative f) => Int -> f a -> f [a]
replicateA cnt0 f =
  loop cnt0
 where
  loop cnt
    | cnt <= 0 = pure []
    | otherwise = liftA2 (:) f (loop (cnt - 1))

{-# INLINEABLE replicateA_ #-}
{-# SPECIALIZE replicateA_ ::
  Int ->
  IO a ->
  IO ()
  #-}
{-# SPECIALIZE replicateA_ ::
  Int ->
  Maybe a ->
  Maybe ()
  #-}
replicateA_ :: (Applicative f) => Int -> f a -> f ()
replicateA_ cnt0 f =
  loop cnt0
 where
  loop cnt
    | cnt <= 0 = pure ()
    | otherwise = f *> loop (cnt - 1)