EnterMine.hs

-- Only difference I was trying is
instance Enter (m a) (m :~> n) (n a)  where
        enter (Nat f) = f
        enter (Raw a) = a

EnterNow.hs

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators     #-}
module Servant.Server.Internal.EnterSpec where

import qualified Control.Category           as C
import           Control.Monad.Reader
import           Control.Monad.Trans.Either
import           Data.Proxy
import           Servant.API
import           Servant.Server

import           Test.Hspec                 (Spec, describe, it)
import           Test.Hspec.Wai             (get, matchStatus, post,
                                             shouldRespondWith, with)

spec :: Spec
spec = describe "module Servant.Server.Enter" $ do
    enterSpec

type ReaderAPI = "int" :> Get '[JSON] Int
            :<|> "string" :> Post '[JSON] String

type IdentityAPI = "bool" :> Get '[JSON] Bool

type CombinedAPI = ReaderAPI :<|> IdentityAPI

readerAPI :: Proxy ReaderAPI
readerAPI = Proxy

combinedAPI :: Proxy CombinedAPI
combinedAPI = Proxy

readerServer' :: ServerT ReaderAPI (Reader String)
readerServer' = return 1797 :<|> ask

fReader :: Reader String :~> EitherT ServantErr IO
fReader = generalizeNat C.. (runReaderTNat "hi")

readerServer :: Server ReaderAPI
readerServer = enter fReader readerServer'

combinedReaderServer' :: ServerT CombinedAPI (Reader String)
combinedReaderServer' = readerServer' :<|> enter generalizeNat (return True)

combinedReaderServer :: Server CombinedAPI
combinedReaderServer = enter fReader combinedReaderServer'

enterSpec :: Spec
enterSpec = describe "Enter" $ do
  with (return (serve readerAPI readerServer)) $ do

    it "allows running arbitrary monads" $ do
      get "int" `shouldRespondWith` "1797"
      post "string" "3" `shouldRespondWith` "\"hi\""{ matchStatus = 201 }

  with (return (serve combinedAPI combinedReaderServer)) $ do
    it "allows combnation of enters" $ do
      get "bool" `shouldRespondWith` "true"

Error

src/Servant/Server/Internal/Enter.hs:57:16:
    Couldn't match expected type ‘m :~> n’
                with actual type ‘Raw (m a -> n a)’
    Relevant bindings include
      enter :: m :~> n -> m a -> n a
        (bound at src/Servant/Server/Internal/Enter.hs:56:9)
    In the pattern: Raw a
    In an equation for ‘enter’: enter (Raw a) = a
    In the instance declaration for ‘Enter (m a) (m :~> n) (n a)’

RawMine.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK not-home    #-}
module Servant.API.Raw where

import           Data.Typeable (Typeable)
-- | Endpoint for plugging in your own Wai 'Application's.
--
-- The given 'Application' will get the request as received by the server, potentially with
-- a modified (stripped) 'pathInfo' if the 'Application' is being routed with 'Servant.API.Sub.:>'.
--
-- In addition to just letting you plug in your existing WAI 'Application's,
-- this can also be used with 'Servant.Utils.StaticFiles.serveDirectory' to serve
-- static files stored in a particular directory on your filesystem
data Raw a = Raw a deriving Typeable

RawNow.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK not-home    #-}
module Servant.API.Raw where

import           Data.Typeable (Typeable)
-- | Endpoint for plugging in your own Wai 'Application's.
--
-- The given 'Application' will get the request as received by the server, potentially with
-- a modified (stripped) 'pathInfo' if the 'Application' is being routed with 'Servant.API.Sub.:>'.
--
-- In addition to just letting you plug in your existing WAI 'Application's,
-- this can also be used with 'Servant.Utils.StaticFiles.serveDirectory' to serve
-- static files stored in a particular directory on your filesystem
data Raw deriving Typeable