<div dir="ltr">You could try and enable the <font face="monospace">{-# ScopedTypeVariables #-}</font> language extension [1].<div><br></div><div>Then you can write an explicit <font face="monospace">forall </font><font face="arial, sans-serif">so that the type variable a scopes over the where clause:</font></div><div><br></div><div><font face="monospace">myAPIServer :: forall a. Job a => Beamline -> JobQueue a -> Server (MyApi a)<br>myAPIServer beam jobQueue = handleJobSpec :<|> handleHomepage :<|> handleXdsMe :<|> handleLogs :<|> handleResumXds :<|> handleSessionId<br>  where<br>    handleJobSpec :: JobSpecSub a -> Handler ()<br>    handleJobSpec jobSpec = liftIO $ enqueue jobSpec jobQueue  </font><br><div><br></div><div>You could also do this without the language extension by explicitly passing the type variable via some proxy, but I recommend using the ScopedTypeVariables language extension.</div><div><br></div><div>1 - <a href="https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#lexically-scoped-type-variables">https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#lexically-scoped-type-variables</a></div></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">Op wo 16 okt. 2019 om 21:40 schreef PICCA Frederic-Emmanuel <<a href="mailto:frederic-emmanuel.picca@synchrotron-soleil.fr">frederic-emmanuel.picca@synchrotron-soleil.fr</a>>:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">Hello, I have a type for my APi like this<br>
<br>
type SubscribeAPI a = "upload" :> ReqBody '[JSON] (JobSpecSub a) :> Post '[JSON] ()<br>
type HomepageAPI = "homepage"  :> QueryParam "id" Int :> Get '[HTML] Homepage<br>
type XdsMeAPI a = "xdsme" :> ReqBody '[FormUrlEncoded] XdsMeRequest :> Post '[JSON] (JobSpecSub a)<br>
type LogsAPI = "logs" :> ReqBody '[FormUrlEncoded] LogsRequest :> Post '[HTML] Html<br>
type ResumXdsAPI = "resumxds" :> ReqBody '[FormUrlEncoded] ResumXdsRequest :> Post '[HTML] Html<br>
type SessionIdAPI = "sessionid" :> ReqBody '[FormUrlEncoded] SessionIdRequest :> Post '[HTML] Html<br>
<br>
type MyApi a = SubscribeAPI a :<|> HomepageAPI :<|> XdsMeAPI a :<|> LogsAPI :<|> ResumXdsAPI :<|> SessionIdAPI<br>
<br>
myApi :: Job a => Proxy (MyApi a)<br>
myApi = Proxy<br>
<br>
When I try to write the handler for this API, I have this error message for the next code<br>
<br>
myAPIServer :: Job a => Beamline -> JobQueue a -> Server (MyApi a)<br>
myAPIServer beam jobQueue = handleJobSpec :<|> handleHomepage :<|> handleXdsMe :<|> handleLogs :<|> handleResumXds :<|> handleSessionId<br>
  where<br>
    handleJobSpec :: Job b => JobSpecSub b -> Handler ()<br>
    handleJobSpec jobSpec = liftIO $ enqueue jobSpec jobQueue<br>
<br>
<br>
    • Couldn't match type ‘a’ with ‘b’<br>
      ‘a’ is a rigid type variable bound by<br>
        the type signature for:<br>
          myAPIServer :: forall a.<br>
                         Job a =><br>
                         Beamline -> JobQueue a -> Server (MyApi a)<br>
        at src/Web.hs:235:1-66<br>
      ‘b’ is a rigid type variable bound by<br>
        the type signature for:<br>
          handleJobSpec :: forall b. Job b => JobSpecSub b -> Handler ()<br>
        at src/Web.hs:238:5-56<br>
      Expected type: JobQueue b<br>
        Actual type: JobQueue a<br>
    • In the second argument of ‘enqueue’, namely ‘jobQueue’<br>
      In the second argument of ‘($)’, namely ‘enqueue jobSpec jobQueue’<br>
      In the expression: liftIO $ enqueue jobSpec jobQueue<br>
    • Relevant bindings include<br>
        jobSpec :: JobSpecSub b (bound at src/Web.hs:239:19)<br>
        handleJobSpec :: JobSpecSub b -> Handler ()<br>
          (bound at src/Web.hs:239:5)<br>
        jobQueue :: JobQueue a (bound at src/Web.hs:236:18)<br>
        myAPIServer :: Beamline -> JobQueue a -> Server (MyApi a)<br>
          (bound at src/Web.hs:236:1)<br>
    |<br>
239 |     handleJobSpec jobSpec = liftIO $ enqueue jobSpec jobQueue<br>
    |                                                      ^^^^^^^^<br>
<br>
<br>
I understand that I need to explain haskell that a ~ b.<br>
<br>
So my question is how can I do this :)<br>
<br>
thanks for your help<br>
<br>
Frederic<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div>