Using monomorphic functions with polymorphic Haxl library?

Question

I'm using the Haxl library and I'm trying to implement fetchHTML concurrently:

import Data.Aeson
import Control.Concurrent.Async
import Control.Concurrent.QSem
import Haxl.Core
import Haxl.Prelude

instance DataSource' u HTTPRequest where 
  fetch = metaImplementation

data HTTPRequest a where
  MakeRequest :: HTTPRequest Int

instance StateKey HTTPRequest where --Link HTTPRequest to State class
   data State HTTPRequest =
    HTTPRequestState {threadNum :: Int}

initialiseState :: Int -> IO (State HTTPRequest)
initialiseState threads = do
   return HTTPRequestState {threadNum = threads}

metaImplementation :: State HTTPRequest -> Flags -> u -> [BlockedFetch' HTTPRequest] -> PerformFetch 
metaImplementation HTTPRequestState{..} _flags user bfs =
AsyncFetch $ \inner -> do
    sem <- newQSem threadNum
    asyncs <- mapM (implementation sem) bfs
    inner
    mapM_ wait asyncs

implementation :: QSem -> BlockedFetch' HTTPRequest -> IO(Async())
implementation sem (BlockedFetch' request returnVal) = 
   async $ bracket_ (waitQSem sem) (signalQSem sem) $ do
      e <- Control.Exception.try $ 
         fetchHTML
      case e of 
        Left ex -> putFailure returnVal (ex :: SomeException)
        Right el -> putSuccess returnVal el


fetchHTML :: IO Int
fetchHTML = do
    res <- get "https://example.com"
    let resBody = res ^. responseBody 
    return (200)

makeHTTPRequest :: GenHaxl u Int --Perform concurrent fetches
makeHTTPRequest = dataFetch (MakeRequest)

The problem I'm facing is that Haxl's BlockedFetch is polymorphic:

BlockedFetch :: forall (r :: * -> *) a.  r a -> ResultVar a -> BlockedFetch r

Yet I wish fetchHTML to be monomorphic (only return an Int):

fetchHTML :: IO Int 
fetchHTML = do
   res <- get "https://www.bbc.com"
   let resBody = res ^. responseBody 
   return (200)

So I get the following error when I attempt to compile:

  Couldn't match expected type ‘a’ with actual type ‘Int’
    ‘a’ is a rigid type variable bound by
    a pattern with constructor:
      BlockedFetch :: forall (r :: * -> *) a.
                      r a -> ResultVar a -> BlockedFetch r,
    in an equation for ‘implementation’

Initially I thought I could re-define BlockedFetch as so:

data BlockedFetch' a where --Custom monomorphic implementation of BlockedFetch 
   BlockedFetch' :: HTTPRequest Int -> ResultVar Int -> BlockedFetch' HTTPRequest

However, then that requires a new implementation of DataSource, to enable it to receive my custom BlockFetch':

class (DataSourceName r, StateKey r) => DataSource' u r where 
   fetch :: State r -> Flags -> u -> [BlockedFetch' r] -> PerformFetch

Clearly, this will just affect backwards and require me to re-write the entire Haxl module!

My questions are:

1) Is there a simple way to make fetchHTML polymorphic? (I'm not too concerned about what it returns, just it returns something when it's finished)

2) What is the general approach by Haskell programmers when faced with this sort of problem?

Answer 1

The BlockedFetch constructor existentially quantifies a:

data BlockedFetch r = forall a. BlockedFetch (r a) (ResultVar a)

This means that whoever creates a BlockedFetch gets to choose what a is, but upon unpacking a BlockedFetch a is kept abstract and won't unify with anything else.

However, you do get access to the r type. By choosing r to be a GADT you can constrain a to be (one of a set of) particular type(s), and recover that information by matching on the constructor(s) of your GADT. You don't have to rewrite any Haxl code - it was designed to allow you to plug in your own r!

In this instance, I see that you've already got 90% of the way there:

data HttpRequest a where
    MakeRequest :: HttpRequest Int

So when you match on the MakeRequest constructor you gain the knowledge that a ~ Int.

implementation :: QSem -> BlockedFetch' HTTPRequest -> IO(Async())
                               -- match the MakeRequest constructor
implementation sem (BlockedFetch' MakeRequest returnVal) =
    -- as before