{-# language Safe #-}

{-# options_ghc -Wno-orphans #-}

module LazyAsync.Orphans where

import LazyAsync.Actions
import LazyAsync.Prelude
import LazyAsync.Types

-- | 🌈 '<*>' is equivalent to 'LazyAsync.apply'
instance Applicative LazyAsync where
    pure :: forall a. a -> LazyAsync a
pure = forall a. a -> LazyAsync a
pureLazyAsync
    <*> :: forall a b. LazyAsync (a -> b) -> LazyAsync a -> LazyAsync b
(<*>) = forall a b. LazyAsync (a -> b) -> LazyAsync a -> LazyAsync b
apply

-- | 🌈 '<|>' is equivalent to 'LazyAsync.choose'
instance Alternative LazyAsync where
    empty :: forall a. LazyAsync a
empty = forall a. LazyAsync a
emptyLazyAsync
    <|> :: forall a. LazyAsync a -> LazyAsync a -> LazyAsync a
(<|>) = forall a. LazyAsync a -> LazyAsync a -> LazyAsync a
choose

-- | 🌈 '<*>' is equivalent to 'applyStatus'
instance Applicative Status where
    pure :: forall a. a -> Status a
pure = forall a. a -> Status a
pureStatus
    <*> :: forall a b. Status (a -> b) -> Status a -> Status b
(<*>) = forall a b. Status (a -> b) -> Status a -> Status b
applyStatus

-- | 🌈 '<|>' is equivalent to 'chooseStatus'
instance Alternative Status where
    empty :: forall a. Status a
empty = forall a. Status a
emptyStatus
    <|> :: forall a. Status a -> Status a -> Status a
(<|>) = forall a. Status a -> Status a -> Status a
chooseStatus

-- | 🌈 '<*>' is equivalent to 'applyOutcome'
instance Applicative Outcome where
    pure :: forall a. a -> Outcome a
pure = forall a. a -> Outcome a
pureOutcome
    <*> :: forall a b. Outcome (a -> b) -> Outcome a -> Outcome b
(<*>) = forall a b. Outcome (a -> b) -> Outcome a -> Outcome b
applyOutcome

-- | 🌈 '<|>' is equivalent to 'chooseOutcome'
instance Alternative Outcome where
    empty :: forall a. Outcome a
empty = forall a. Outcome a
emptyOutcome
    <|> :: forall a. Outcome a -> Outcome a -> Outcome a
(<|>) = forall a. Outcome a -> Outcome a -> Outcome a
chooseOutcome