Использование мономорфных функций с полиморфной библиотекой Haxl?

Question

Я использую библиотеку Haxl и пытаюсь реализовать fetchHTML одновременно:

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)

Проблема, с которой я сталкиваюсь, заключается в том, что Хаксл BlockedFetch полиморфен:

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

Все же я желаю fetchHTML быть мономорфным (только вернуть Int):

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

Поэтому я получаю следующую ошибку при попытке компиляции:

  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’

Сначала я думал, что смогу переопределить BlockedFetch как так:

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

Однако для этого требуется новая реализация DataSource, чтобы включить его, чтобы получить мой заказ BlockFetch':

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

Понятно, что это скажется только в обратном направлении и потребует от меня переписать весь модуль Haxl!

Мои вопросы:

1) Есть ли простой способ сделать fetchHTML полиморфный? (Я не слишком обеспокоен тем, что он возвращает, просто он что-то возвращает, когда закончил)

2) Каков общий подход программистов на Haskell, когда они сталкиваются с такой проблемой?

Answer 1

BlockedFetch конструктор экзистенциально количественно a:

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

Это означает, что тот, кто создает BlockedFetch может выбрать что a есть, но после распаковки BlockedFetcha хранится абстрактно и не объединится ни с чем другим.

Тем не менее, вы получаете доступ к r тип. Выбирая r чтобы быть GADT вы можете ограничить a быть (одним из набора) определенного типа (ов) и восстановить эту информацию путем сопоставления с конструктором (ами) вашего GADT. Вам не нужно переписывать любой код Haxl - он был разработан, чтобы позволить вам подключить свой собственный r!

В этом случае я вижу, что у вас уже есть 90% пути:

data HttpRequest a where
    MakeRequest :: HttpRequest Int

Поэтому, когда вы подходите на MakeRequest конструктор вы получите знание того, что a ~ Int,

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