-- |
-- Module:     Control.ContStuff.Instances
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- This module implements some miscellaneous type class instances.

{-# LANGUAGE TypeFamilies #-}

module Control.ContStuff.Instances () where

import qualified Control.Exception as E
import Control.ContStuff.Classes
import Control.ContStuff.Trans
import Control.Monad.ST


----------------
-- Exceptions --
----------------

instance HasExceptions (Either e) where
    type Exception (Either e) = e
    raise = Left
    try = Right

instance HasExceptions Maybe where
    type Exception Maybe = ()
    raise = const Nothing
    try = Just . maybe (Left ()) Right

instance HasExceptions IO where
    type Exception IO = E.SomeException
    raise = E.throwIO
    try = E.try


--------------
-- LiftBase --
--------------

instance LiftBase Id where type Base Id = Id; base = id
instance LiftBase IO where type Base IO = IO; base = id
instance LiftBase Maybe where type Base Maybe = Maybe; base = id
instance LiftBase (ST s) where type Base (ST s) = ST s; base = id
instance LiftBase [] where type Base [] = []; base = id
instance LiftBase ((->) r) where type Base ((->) r) = (->) r; base = id

instance (LiftBase m, Monad m) => LiftBase (ChoiceT r i m) where
    type Base (ChoiceT r i m) = Base m
    base = lift . base

instance (LiftBase m, Monad m) => LiftBase (ContT r m) where
    type Base (ContT r m) = Base m
    base = lift . base

instance (LiftBase m, Monad m) => LiftBase (EitherT r e m) where
    type Base (EitherT r e m) = Base m
    base = lift . base

instance (LiftBase m, Monad m) => LiftBase (IdT m) where
    type Base (IdT m) = Base m
    base = lift . base

instance (LiftBase m, Monad m) => LiftBase (MaybeT r m) where
    type Base (MaybeT r m) = Base m
    base = lift . base

instance (LiftBase m, Monad m) => LiftBase (StateT r s m) where
    type Base (StateT r s m) = Base m
    base = lift . base


--------------
-- Stateful --
--------------

instance (Monad m, Stateful m) => Stateful (ChoiceT r i m) where
    type StateOf (ChoiceT r i m) = StateOf m
    get = lift get
    put = lift . put
    putLazy = lift . putLazy

instance (Monad m, Stateful m) => Stateful (ContT r m) where
    type StateOf (ContT r m) = StateOf m
    get = lift get
    put = lift . put
    putLazy = lift . putLazy

instance (Monad m, Stateful m) => Stateful (EitherT r e m) where
    type StateOf (EitherT r e m) = StateOf m
    get = lift get
    put = lift . put
    putLazy = lift . putLazy

instance (Monad m, Stateful m) => Stateful (IdT m) where
    type StateOf (IdT m) = StateOf m
    get = lift get
    put = lift . put
    putLazy = lift . putLazy

instance (Monad m, Stateful m) => Stateful (MaybeT r m) where
    type StateOf (MaybeT r m) = StateOf m
    get = lift get
    put = lift . put
    putLazy = lift . putLazy