Code Monkey home page Code Monkey logo

Comments (7)

mattjbray avatar mattjbray commented on June 1, 2024 1

Hi,

Thanks - glad you like the library!

We're waiting for servant-foreign to add support for the AuthProtect combinator, then we can think about how to support auth in servant-elm.

However, if your Elm requests don't need to do anything special (I'm guessing the browser automatically adds your auth cookie to the requests?), in the meantime you can just add an instance for AuthProtect that does nothing:

instance (KnownSymbol sym, HasForeign lang ftype sublayout)
    => HasForeign lang ftype (AuthProtect sym :> sublayout) where
    type Foreign ftype (AuthProtect sym :> sublayout) = Foreign ftype sublayout

    foreignFor lang ftype Proxy req =
      foreignFor lang ftype (Proxy :: Proxy sublayout) req

from servant-elm.

garetht avatar garetht commented on June 1, 2024 1

I just happened to be working on this and using {-# LANGUAGE ScopedTypeVariables #-} solved the ambiguous type variable problem.

from servant-elm.

erewok avatar erewok commented on June 1, 2024

Nice! I'll give it a shot and report back. Thanks for the suggestion!

from servant-elm.

erewok avatar erewok commented on June 1, 2024

Well, I got stuck on an ambiguous type variable problem and was unfortunately at a loss as to how to begin debugging it, but it's alright if this doesn't work because I can just generate the Elm by hand and return to this problem once the servant-foreign library supports the AuthProtect combinator.

I'll post my attempt and the compiler error anyway in case anyone is working on something similar and stumbles across this discussion:

{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

import           Data.List
import           Data.Proxy
import           GHC.TypeLits    (KnownSymbol)
import           Servant.Elm
import           Servant.Foreign

import           Api

instance (KnownSymbol sym, HasForeign lang ftype sublayout)
    => HasForeign lang ftype (AuthProtect sym :> sublayout) where
    type Foreign ftype (AuthProtect sym :> sublayout) = Foreign ftype sublayout

    foreignFor lang ftype Proxy req =
      foreignFor lang ftype (Proxy :: Proxy sublayout) req

Results in:

     Couldn't match type Foreign ftype api0
                     with Foreign ftype sublayout
      Expected type: Foreign ftype (AuthProtect sym :> sublayout)
        Actual type: Foreign ftype api0
      NB: Foreign is a type function, and may not be injective
      The type variable api0 is ambiguous
     In the expression:
        foreignFor lang ftype (Proxy :: Proxy sublayout) req
      In an equation for foreignFor’:
          foreignFor lang ftype Proxy req
            = foreignFor lang ftype (Proxy :: Proxy sublayout) req
      In the instance declaration for
        HasForeign lang ftype (AuthProtect sym :> sublayout)
     Relevant bindings include
        req :: Req ftype (bound at client/GenerateElm.hs:19:33)
        ftype :: Proxy ftype (bound at client/GenerateElm.hs:19:21)
        foreignFor :: Proxy lang
                      -> Proxy ftype
                      -> Proxy (AuthProtect sym :> sublayout)
                      -> Req ftype
                      -> Foreign ftype (AuthProtect sym :> sublayout)
          (bound at client/GenerateElm.hs:19:5)

from servant-elm.

erewok avatar erewok commented on June 1, 2024

@garetht's suggestion worked for me.

from servant-elm.

mattjbray avatar mattjbray commented on June 1, 2024

Great! Sorry, it would have been helpful for me to put the language pragmas and imports in my snippet...

from servant-elm.

erewok avatar erewok commented on June 1, 2024

Oh, no worries. I should understand the language pragmas better than I do if I'm going to be using them.

from servant-elm.

Related Issues (20)

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.