{-# LANGUAGE ConstraintKinds, DeriveFunctor, FlexibleInstances #-}
{-# LANGUAGE RankNTypes, StandaloneDeriving #-}
module Build.Task.Wrapped (GTask (..), Wrapped, unwrap) where
import Control.Applicative
import Control.Monad
import Build.Task
newtype GTask c k v a =
GTask { runGTask :: forall f. c f => (k -> f v) -> f a }
type Wrapped c k v = (k -> GTask c k v v) -> GTask c k v v
unwrap :: forall c k v. Wrapped c k v -> Task c k v
unwrap wrapped = runGTask (wrapped f)
where
f :: k -> GTask c k v v
f k = GTask $ \f -> f k
deriving instance Functor (GTask Functor k v)
deriving instance Functor (GTask Applicative k v)
deriving instance Functor (GTask Alternative k v)
deriving instance Functor (GTask Monad k v)
deriving instance Functor (GTask MonadPlus k v)
instance Applicative (GTask Applicative k v) where
pure x = GTask $ \_ -> pure x
GTask f <*> GTask x = GTask $ \fetch -> f fetch <*> x fetch
instance Applicative (GTask Alternative k v) where
pure x = GTask $ \_ -> pure x
GTask f <*> GTask x = GTask $ \fetch -> f fetch <*> x fetch
instance Applicative (GTask Monad k v) where
pure x = GTask $ \_ -> pure x
GTask f <*> GTask x = GTask $ \fetch -> f fetch <*> x fetch
instance Applicative (GTask MonadPlus k v) where
pure x = GTask $ \_ -> pure x
GTask f <*> GTask x = GTask $ \fetch -> f fetch <*> x fetch
instance Monad (GTask Monad k v) where
return x = GTask $ \_ -> return x
GTask x >>= f = GTask $ \fetch -> x fetch >>= \a -> runGTask (f a) fetch
instance Monad (GTask MonadPlus k v) where
return x = GTask $ \_ -> return x
GTask x >>= f = GTask $ \fetch -> x fetch >>= \a -> runGTask (f a) fetch
instance Alternative (GTask Alternative k v) where
empty = GTask $ \_ -> empty
GTask x <|> GTask y = GTask $ \fetch -> x fetch <|> y fetch
instance Alternative (GTask MonadPlus k v) where
empty = GTask $ \_ -> empty
GTask x <|> GTask y = GTask $ \fetch -> x fetch <|> y fetch
instance MonadPlus (GTask MonadPlus k v) where
mzero = empty
mplus = (<|>)