I've learnt that I can define my API with servant and Lucid in the following way:
type ClientAPI =
"users" :> Get '[HTML] (Html ())
:<|> "userdata" :> Get '[HTML] (Html ())
Then if I want to add a link to one of the endpoints in my HTML, I can use "a_" function provided by Lucid, e.g.
a_ [href_ "users"] "Show users"
The problem I have with this approach is that I need to repeat the endpoint's name twice. "users" occurs both in API definition and a_ tag. As a result if I change it in one place, the other one stops working immediately.
Is there a way to define a single symbol that could be used in both places instead ? Something like:
data MySites = UserSite | UserDataSite -- potentially more
type ClientAPI' =
UserSite :> Get '[HTML] (Html ())
-- ......
let html =
...
a_ [href_ UserSite] "Show users"
...
If you just want to abstract over the string "user", you can do this with a type alias, and then use GHC.TypeLits.symbolVal to get the string at the value level:
{-# LANGUAGE DataKinds #-}
import Data.Proxy
import GHC.TypeLits
type UserSite = "user"
html = ... href_ (symbolVal (Proxy :: Proxy UserSite)) ...
You can also make the symbolVal call a bit shorter by defining a helper with AllowAmbiguousTypes:
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
urlpath :: forall s . KnownSymbol s => String
urlpath = symbolVal (Proxy :: Proxy s)
html = ... href_ (urlpath #UserSite) ...
(I actually thought something like it was in the standard library somewhere but I can't find it.)
Related
While going through the examples of the Yesod Book, I'm running into an issue with the following snippet:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
import Data.Text (Text)
import qualified Data.Text as T
import Yesod
data App = App
instance Yesod App
mkYesod "App" [parseRoutes|
/person/#Text PersonR GET
/year/#Integer/month/#Text/day/#Int DateR
/wiki/*Texts WikiR GET
|]
getPersonR :: Text -> Handler Html
getPersonR name = defaultLayout [whamlet|<h1>Hello #{name}!|]
handleDateR :: Integer -> Text -> Int -> Handler Text -- text/plain
handleDateR year month day =
return $
T.concat [month, " ", T.pack $ show day, ", ", T.pack $ show year]
getWikiR :: [Text] -> Handler Text
getWikiR = return . T.unwords
main :: IO ()
main = warp 3000 App
(It's on page 124 of 598; route arguments)
The instance declaration on line 11 raises the following error:
YesodRouteParams.hs:11:10: error:
• No instance for (RenderRoute App)
arising from the superclasses of an instance declaration
• In the instance declaration for ‘Yesod App’
|
11 | instance Yesod App
|
It can be fixed by moving that line below the mkYesod block, where routes are defined.
I'm trying to understand why that is. Does it mean that Template Haskell evaluation at compile time happens simultaneously with the written code evaluation?
I ask because in Crystal, for example, macros are expanded before anything else. So the order of things doesn't really matter in a file (or app). But by the looks of it, they do in Haskell. Or is there another explanation?
This was because of a change made in GHC 9.0.1. From the release notes:
Breaking change: Template Haskell splices now act as separation points between constraint solving passes. It is no longer possible to use an instance of a class before a splice and define that instance after a splice. For example, this code now reports a missing instance for C Bool:
class C a where foo :: a
bar :: Bool
bar = foo
$(return [])
instance C Bool where foo = True
If you were to downgrade to GHC 8.10.7, you'd see that your code would then work as you wrote it.
I opened https://github.com/yesodweb/yesodweb.com-content/pull/269 to fix the examples in the book.
Supposing I'm running a Servant webserver, with two endpoints, with a type looking like this:
type BookAPI =
"books" :> Get '[JSON] (Map Text Text)
:<|> "book" :> Capture "Name" Text :> ReqBody '[JSON] (Text) :> Post '[JSON] (Text)
λ:T.putStrLn $ layout (Proxy :: Proxy BookAPI)
/
├─ book/
│ └─ <capture>/
│ └─•
└─ books/
└─•
I might want to use something like Network.Wai.Middleware.Prometheus's instrumentHandlerValue to generate a Prometheus metric that fire's every time this API is called, with a handler value set to the path of the request.
However, if I do something like the following:
prometheusMiddlware = instrumentHandlerValue (T.intercalate "\\" . pathInfo)
This is bad, because different requests to the book/<Name> endpoint, such as book/great-expectations and book/vanity-fair result in different labels, this is fine if the number of books is small, but if it's very large then the amount of data used by these metrics is very big, and either my service falls over, or my monitoring bill becomes very large.
I'd quite like a function, that took a Servant API, and a Wai Request, and if it matched, returned a list of segments in a form that was the same for each endpoint.
That is requests to /books would return Just ["books"], requests to /book/little-dorrit would return Just ["book", "Name"], and requests to /films would return Nothing.
I can kind of see how you might go about writing this by pattern matching on Router' from Servant.Server.Internal.Router, but it's not clear to me that relying on an internal package in order to do this is a good idea.
Is there a better way?
The pathInfo function returns all the path segments for a Request. Perhaps we could define a typeclass that, given a Servant API, produced a "parser" for the list of segments, whose result would be a formatted version of the list.
The parser type could be something like:
import Data.Text
import Control.Monad.State.Strict
import Control.Applicative
type PathParser = StateT ([Text],[Text]) Maybe ()
Where the first [Text] in the state are the path segments yet to be parsed, and the second are the formatted path segments we have accumulated so far.
This type has an Alternative instance where failure discards state (basically backtracking) and a MonadFail instance that returns mzero on pattern-match failure inside do-blocks.
The typeclass:
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
import Data.Data ( Proxy )
import GHC.TypeLits
class HasPathParser (x :: k) where
pathParser :: Proxy x -> PathParser
The instance for Symbol moves the path piece from the pending list to the processed list:
instance KnownSymbol piece => HasPathParser (piece :: Symbol) where
pathParser _ = do
(piece : rest, found) <- get -- we are using MonadFail here
guard (piece == Data.Text.pack (symbolVal (Proxy #piece)))
put (rest, piece : found)
The instance for Capture puts the name of the path variable—not the value—on the processed list:
instance KnownSymbol name => HasPathParser (Capture name x) where
pathParser _ = do
(_ : rest, found) <- get -- we are using MonadFail here
put (rest, Data.Text.pack (symbolVal (Proxy #name)) : found)
When we reach a Verb (GET, POST...) we require that no pending path pieces should remain:
instance HasPathParser (Verb method statusCode contextTypes a) where
pathParser _ = do
([], found) <- get -- we are using MonadFail here
put ([], found)
Some other instances:
instance HasPathParser (ReqBody x y) where
pathParser _ = pure ()
instance (HasPathParser a, HasPathParser b) => HasPathParser (a :> b) where
pathParser _ = pathParser (Proxy #a) *> pathParser (Proxy #b)
instance (HasPathParser a, HasPathParser b) => HasPathParser (a :<|> b) where
pathParser _ = pathParser (Proxy #a) <|> pathParser (Proxy #b)
Putting it to work:
main :: IO ()
main = do
do let Just ([], result) = execStateT (pathParser (Proxy #BookAPI)) (["books"],[])
print result
-- ["books"]
do let Just ([], result) = execStateT (pathParser (Proxy #BookAPI)) (["book", "somebookid"],[])
print result
-- ["Name","book"]
I need to give the ability to change the web-root (or path-prefix) of my API via CLI arguments.
If my server exposes the following API paths...
/enqueue
/run
/cancel
...at startup it should be possible to change them to the following by passing a CLI switch --web-root=/admin:
/admin/enqueue
/admin/run
/admin/cancel
The question is not related to parsing the command-line, which is a solved problem via optparse-applicative. It's about any in-built way in servant, AT RUNTIME, to (a) change the web-root of the server, and (b) make the corresponding change in various safe-links functions (generated via allFieldLinks').
Servant provides no straightforward facility for doing this, and the internals of Servant.Link have been zealously overprotected (an unfortunately common problem with Haskell packages) so as to make it unnecessarily difficult to implement on the link side.
You can mount a servant API under a runtime-specified base path using the usual methods of specifying types at runtime. However, getting safe links to automatically incorporate the base path seems close to impossible. If you're satisfied with fixing up the links after the fact, then the following might work.
Given that you're using allFieldLinks', you're probably using the generic interface, so suppose you have a service:
data HelloService route = HelloService
{ hello :: route :- "hello" :> Get '[PlainText] Text
, world :: route :- "world" :> Get '[PlainText] Text
} deriving (Generic)
helloServer :: HelloService AsServer
helloServer = HelloService
{ hello = return $ "Goto \"localhost:3000/" <> toUrlPiece (world asLink) <> "\""
, world = return "Hello, world!"
} where asLink = allFieldLinks
with the usual boring way of serving it at the root:
main = run 3000 $ genericServe helloServer
If you wanted to serve this off a compile-time base path (e.g., /admin) without modifying the service definition, you could rewrite main as:
main = run 3000 $ serve (Proxy #("admin" :> ToServant HelloService AsApi))
(genericServer helloServer)
To specify the base path component "admin" at runtime, you can define and case-match on an existential symbol:
main = do
let base = "admin"
case someSymbolVal base of
SomeSymbol (_ :: Proxy base) ->
run 3000 $ serve (Proxy #(base :> ToServant HelloService AsApi))
(genericServer helloServer)
This only allows one component in the base path, but you can generalize to a multiple-component base with:
serveUnder :: forall service. HasServer service '[]
=> [String] -> Proxy service -> Server service -> Application
serveUnder [] p s = serve p s
serveUnder (x:xs) _ s = case someSymbolVal x of
SomeSymbol (_ :: Proxy x) -> serveUnder xs (Proxy #(x :> service)) s
main :: IO ()
main = do
let base = ["foo", "bar"] -- mount under /foo/bar
run 3000 $ serveUnder (reverse base)
(genericApi (Proxy #HelloService))
(genericServer helloServer)
If you try this out and visit http://localhost:3000/foo/bar/hello, you'll see that the allFieldLinks doesn't reflect the new mount point. If Servant.Links exposed more internals, this would be trivial to fix. Unfortunately, as it is, the only reasonable way to address this is to pass some form of the runtime path into helloServer and have it fix the safe links as part of the rendering.
The resulting full program would look something like this:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
module HelloService where
import Data.Text (Text)
import qualified Data.Text as T
import Servant
import Servant.API.Generic
import Servant.Server.Generic
import Network.URI
import Network.Wai.Handler.Warp
import GHC.TypeLits
data HelloService route = HelloService
{ hello :: route :- "hello" :> Get '[PlainText] Text
, world :: route :- "world" :> Get '[PlainText] Text
} deriving (Generic)
helloServer :: Text -> HelloService AsServer
helloServer webroot = HelloService
{ hello = return $ "Goto \"localhost:3000/" <> renderLink (world asLink) <> "\""
, world = return "Hello, world!"
} where asLink = allFieldLinks
renderLink l = webroot <> toUrlPiece l
serveUnder :: forall service. HasServer service '[]
=> [String] -> Proxy service -> Server service -> Application
serveUnder [] p s = serve p s
serveUnder (x:xs) _ s = case someSymbolVal x of
SomeSymbol (_ :: Proxy x) -> serveUnder xs (Proxy #(x :> service)) s
main :: IO ()
main = do
let base = ["foo", "bar"] -- mount under /foo/bar
webroot = "http://localhost:3000/" <> T.intercalate "/" (map escaped base) <> "/"
escaped = T.pack . escapeURIString isUnreserved
run 3000 $ serveUnder (reverse base)
(genericApi (Proxy #HelloService))
(genericServer (helloServer webroot))
I am trying to relay some ByteString back to the client (browser). The client will not know the content-type of the document being requested so I am trying to send appropriate content-type response back to the client. The document could be an image or pdf or word document, etc.
For example, the client will request /document?id=55 and the server will respond with the appropriate content-type and the associated ByteString.
I followed the example here: and I created something for an image.
data IMAGE
instance Accept IMAGE where
contentType _ = "image" M.// "jpeg"
instance MimeRender IMAGE LBS.ByteString where
mimeRender _ = id
The challenge is the client will not be sending the request with some specific Accept: header so there is no way for me to react with an appropriate Mime Type like it is done here. Plus the above will only work for images (assuming browsers will infer a png even I send back jpeg) but not for pdf, docx,etc.
I thought about a paramaterized type like MyDynamicContent String and I will pass in the content type at run-time but I am not sure how I will declare my API i.e., what will I use instead of '[JSON]. Not sure such thing is even possible as the examples are just a simple datatype.
So my question is, if I want to send some ByteString as a response and set the Content-Type header dynamically, what will be the best way to do it using servant
Update: I have opened an issue
It's possible, but a bit of a hack:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverlappingInstances #-}
module DynCT where
import Control.Monad.Trans.Either
import Data.ByteString.Lazy (ByteString)
import Servant
import Servant.API.ContentTypes
import Network.Wai.Handler.Warp
data WithCT = WithCT { header :: ByteString, content :: ByteString }
instance AllCTRender xs WithCT where
handleAcceptH _ _ (WithCT h c) = Just (h, c)
type API = Get '[] WithCT
api :: Proxy API
api = Proxy
server :: Server API
server = return $ WithCT { header = "example", content = "somecontent" }
main :: IO ()
main = run 8000 $ serve api server
Testing it:
% curl localhost:8000 -v
...
< HTTP/1.1 200 OK
...
< Content-Type: example
<
...
somecontent%
The idea is just to override the normal behaviour by declaring an overlapping instance for AllCTRender. Note that you'll probably also have to do some extra leg work for servant-client, servant-docs etc. if you're also using those. Given that, you may want to open an issue in the repo about this for more complete support.
As of right now this hack works
data WithCT = WithCT {header :: BS.ByteString, content :: BS.ByteString}
instance AllCTRender '[IMAGE] WithCT where
handleAcceptH _ _ (WithCT h c) = Just (fromStrict h, fromStrict c)
data IMAGE deriving (Typeable)
instance MimeRender IMAGE BS.ByteString where
mimeRender _ content = fromStrict content
instance Accept IMAGE where
contentType _ = ""
type ImageApi = Capture "image_id" ImageId :> Get '[IMAGE] WithCT
I'm just starting doing some Yesod + Haskell stuff.
Is jsonToRepJson broken or something?
I made this code below but I always get an error in jsonToRepJson part.
It seems it doesn't get the expected type?
Any help would be great! Thanks :3
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
import Yesod
import Data.Text
data APP = APP
instance Yesod APP
mkYesod "APP" [parseRoutes|
/ TestR GET
|]
getTestR :: Handler RepJson
getTestR = jsonToRepJson $ object ["test".= ("test"::Text)]
main::IO()
main = warpDebug 3001 APP
this is what I get when I use runhaskell
api.hs:18:12:
Couldn't match expected type `RepJson' with actual type `Value'
Expected type: Handler RepJson
Actual type: HandlerT APP IO Value
In the expression:
jsonToRepJson $ object ["test" .= ("test" :: Text)]
In an equation for `getTestR':
getTestR = jsonToRepJson $ object ["test" .= ("test" :: Text)]
You must convert your value toJSON.
Eg.:
jsonToRepJson $ object [("result", toJSON resultValue)]
:)
You can read about that change in Yesod 1.2
What I did is, I used the TypeContent handler.
If I understood correctly what I've read, repSelect allows us to easily handle what type of data representation the client asks for.
It reads the request header and checks if it asks for JSON, then it will spit out JSON data, if it needs HTML it will then give the HTML page. Providing that you yourself had added the specific data needed using providRep.
Here's my code.
mkYesod "APP" [parseRoutes|
/ TestR GET
|]
getTestR::Handler TypedContent
getTestR = do
selectRep $ do
provideRep $ jsonToRepJson $ object $ (["test" .= ("test"::Text)])
main::IO()
main = warpDebug 3001 APP