module Control.Applicative
    ( module Control.Pointed
    , Applicative (..)
    , ap
    , ap2
    , ap3
    , ap4
    , ap5
    , map2
    , map3
    , map4
    , map5
    , (<$$>)
    , (*>)
    , (<*)
    , (>>)
    , forever
    ) where

import GHC.IOBase

import Control.Pointed
import Data.Function

infixl 4 <$>
class Pointed (~>) f => Applicative (~>) f where
    (<$>) :: f (a ~> b) -> (f a ~> f b)

instance Applicative Hask (Hask a) where
    f <$> g = \x -> f x $ g x

instance Applicative Hask IO where
    mf <$> mx = bindIO mf $ \f -> bindIO mx $ \x -> point $ f x

ap :: Applicative (~>) f => f (a ~> b) -> (f a ~> f b)
ap = (<$>)

ap2 :: Applicative Hask f => f (a -> b -> c) -> (f a -> f b -> f c)
ap2 = result2 ap ap

ap3 :: Applicative Hask f => f (a -> b -> c -> d) -> (f a -> f b -> f c -> f d)
ap3 = result3 ap ap2

ap4 :: Applicative Hask f => f (a -> b -> c -> d -> e) -> (f a -> f b -> f c -> f d -> f e)
ap4 = result4 ap ap3

ap5 :: Applicative Hask f => f (a -> b -> c -> d -> e -> g) -> (f a -> f b -> f c -> f d -> f e -> f g)
ap5 = result5 ap ap4

map2 :: Applicative Hask f => (a -> b -> c) -> (f a -> f b -> f c)
map2 = result2 ap map

map3 :: Applicative Hask f => (a -> b -> c -> d) -> (f a -> f b -> f c -> f d)
map3 = result3 ap map2

map4 :: Applicative Hask f => (a -> b -> c -> d -> e) -> (f a -> f b -> f c -> f d -> f e)
map4 = result4 ap map3

map5 :: Applicative Hask f => (a -> b -> c -> d -> e -> g) -> (f a -> f b -> f c -> f d -> f e -> f g)
map5 = result5 ap map4

(<$$>) :: Applicative Hask f => f a -> f (a -> b) -> f b
(<$$>) = map2 applyTo

infixl 4 *>
(*>) :: Applicative Hask f => f a -> f b -> f b
(*>) = map2 $ const id

infixl 4 <*
(<*) :: Applicative Hask f => f a -> f b -> f a
(<*) = map2 const

infixl 1  >>
(>>) :: Applicative Hask f => f a -> f b -> f b
(>>) = (*>)

forever :: Applicative Hask f => f a -> f b
forever a = a >> forever a