{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}

module Data.TrieMap.Applicative where

import Control.Applicative
import Control.Monad

import Data.Monoid hiding (Dual)

newtype Id a = Id {unId :: a}

instance Functor First where
	fmap f (First m) = First (fmap f m)

instance Functor Last where
	fmap f (Last m) = Last (fmap f m)

instance Monad First where
	return = First . return
	First m >>= k = First (m >>= getFirst . k)

instance Monad Last where
	return = Last . return
	Last m >>= k = Last (m >>= getLast . k)

instance Applicative Id where
	pure = Id
	Id f <*> Id x = Id (f x)

instance Functor Id where
	fmap f (Id x) = Id (f x)

instance MonadPlus First where
	mzero = mempty
	mplus = mappend

instance MonadPlus Last where
	mzero = mempty
	mplus = mappend

(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(f .: g) x y = f (g x y)

(<.>) :: Functor f => (b -> c) -> (a -> f b) -> a -> f c
f <.> g = fmap f . g

(<.:>) :: Functor f => (c -> d) -> (a -> b -> f c) -> a -> b -> f d
(f <.:> g) x y = f <$> g x y

instance Applicative First where
	pure = return
	(<*>) = ap

instance Alternative First where
	empty = mempty
	(<|>) = mplus

instance Applicative Last where
	pure = return
	(<*>) = ap

instance Alternative Last where
	empty = mempty
	(<|>) = mplus

newtype Dual f a = Dual {runDual :: f a}

instance Functor f => Functor (Dual f) where
	fmap f (Dual x) = Dual (fmap f x)

instance Applicative f => Applicative (Dual f) where
	pure = Dual . pure
	Dual f <*> Dual x = Dual (f <*> x)

instance Alternative f => Alternative (Dual f) where
	empty = Dual empty
	Dual a <|> Dual b = Dual (b <|> a)