{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

----------------------------------------------------------------------
-- |
-- Module      :  Data.StarToStar.Iso
-- Copyright   :  (c) Nicolas Frisby 2010
-- License     :  http://creativecommons.org/licenses/by-sa/3.0/
-- 
-- Maintainer  :  nicolas.frisby@gmail.com
-- Stability   :  experimental
-- Portability :  see LANGUAGE pragmas
-- 
-- Instances for @mtl@ interface classes via 'Data.StarToStar.Iso.Iso' for
-- monads defined using 'Data.StarToStar.Fix'.
----------------------------------------------------------------------

module Control.Monad.StarToStar.Fix where

import Data.StarToStar (Fix(..))
import Data.StarToStar.Iso (Iso(..))

import Control.Monad (MonadPlus(..))
import Control.Monad.Fix (MonadFix(..))

import Control.Monad.Trans (MonadIO(..))
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.Writer.Class (MonadWriter(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.RWS.Class (MonadRWS(..))
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Cont.Class (MonadCont(..))



instance (Iso (Fix ff), Monad (Other (Fix ff))) => Monad (Fix ff) where
  return = to . return
  m >>= k = to (from m >>= from . k)

instance (Iso (Fix ff), MonadPlus (Other (Fix ff))) => MonadPlus (Fix ff) where
  mzero = to mzero
  mplus m1 m2 = to $ (from m1) `mplus` (from m2)

instance (Iso (Fix ff), MonadFix (Other (Fix ff))) => MonadFix (Fix ff) where
  mfix f = to $ mfix $ \a -> from (f a)


instance (Iso (Fix ff), MonadIO (Other (Fix ff))) => MonadIO (Fix ff) where
  liftIO = to . liftIO

instance (Iso (Fix ff), MonadReader r (Other (Fix ff))) => MonadReader r (Fix ff) where
  ask = to ask
  local g = to . (local g) . from

instance (Iso (Fix ff), MonadWriter w (Other (Fix ff))) => MonadWriter w (Fix ff) where
  tell = to . tell
  listen = to . listen . from
  pass = to . pass . from

instance (Iso (Fix ff), MonadState s (Other (Fix ff))) => MonadState s (Fix ff) where
  get = to get
  put = to . put

instance (Iso (Fix ff), MonadRWS r w s (Other (Fix ff))) => MonadRWS r w s (Fix ff)

instance (Iso (Fix ff), MonadError r (Other (Fix ff))) => MonadError r (Fix ff) where
  throwError = to . throwError
  m `catchError` h = to $ (from m) `catchError` (from . h)

instance (Iso (Fix ff), MonadCont (Other (Fix ff))) => MonadCont (Fix ff) where
  callCC f = to $ callCC (from . f . (to .))