Stack.hs

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}

module Stack where

import Control.Applicative
import Control.Lens
import Control.Monad.State

data OuterData = OuterData
  { _outerDataName :: String
  }

data InnerData = InnerData
  { _innerDataName :: String
  }

makeClassy ''OuterData
makeClassy ''InnerData

newtype InnerT m a = InnerT { unInnerT :: StateT InnerData m a }
  deriving (Functor, Applicative, Monad)

newtype OuterT m a = OuterT { unOuterT :: StateT OuterData (InnerT m) a }
  deriving (Functor, Applicative, Monad)

instance HasOuterData (InnerData, OuterData) where
  outerData = _2

instance HasInnerData (InnerData, OuterData) where
  innerData = _1

instance Monad m => MonadState (InnerData, OuterData) (OuterT m) where

getOuterName :: (MonadState s m, HasOuterData s) => m String
getOuterName = use outerDataName

getInnerName :: (MonadState s m, HasInnerData s) => m String
getInnerName = use innerDataName

a :: OuterT Identity String
a = getInnerName