gistfile1.hs

class PushReaderT a where
    type PushReaderSubType a
    unPushReaderT :: String -> PushReaderSubType a -> a

instance (PushReaderT b) => PushReaderT (a -> b) where
    type PushReaderSubType (a -> b) = a -> PushReaderSubType b
    unPushReaderT str f = unPushReaderT str . f

instance (PushReaderT a, PushReaderT b) => PushReaderT (a :<|> b) where
    type PushReaderSubType (a :<|> b) = PushReaderSubType a :<|> PushReaderSubType b
    unPushReaderT str (a :<|> b) = unPushReaderT str a :<|> unPushReaderT str b

instance PushReaderT (RestActionRaw a) where
    type PushReaderSubType (RestActionRaw a) = RestActionLabeled a
    unPushReaderT rstate x = runReaderT x rstate


type RestActionRaw = EitherT (Int, String) IO
type RestActionLabeled = ReaderT MyReader RestActionRaw

data MyReader = MyReader String
data a ::> b = a ::> b

instance ( PushReaderT (Server sublayout)
         , HasServer sublayout
         ) => HasServer (MyReader ::> sublayout)
  where
    type Server (MyReader ::> sublayout) = MyReader ::> PushReaderSubType (Server sublayout)

    route Proxy (MyReader st ::> subserver) request respond = do
        route (Proxy :: Proxy sublayout) (unPushReaderT st subserver) request respond

type MyAPI = MyReader ::> Get Int

s ::  PushReaderSubType (Server MyAPI)
s = MyReader "every handle is a ReaderT that gets this string" ::> something
  where something :: ReaderT MyReader RestActionRaw Int
        something = length <$> ask