I have been searching for examples, however most examples do a RouteSomething -> PathSegment "firstpath" $ unitEncoder mempty and not a single nested route.
There are some examples that use Cat.id to pass the whole URI as a Text such Characher-Sheet:
backendRouteEncoder = mkFullRouteEncoder
(FullRoute_Backend BackendRoute_Missing :/ ())
(\case
BackendRoute_API -> PathSegment "api" $ Cat.id
BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty
)
and then on the backend parse the whole route:
server sql (BackendRoute_API :=> Identity _) = dir "api" $
route [ ("spelllist/", runReaderT spellListHandler sql)
, ("featlist/", runReaderT featListHandler sql)
]
however, this feels odd since I would have thought all routing would have been defined in Common.Route with Obelisk.Route as per the skeleton of ob init and other examples defining routes exclusively there. I would appreciate the safety of exhaustiveness check of the LambdaCase over the datatype codifying routes and not having to add BackendRoute_Missing equivalent on all possible backend/frontend subroutes.
data FrontendRoute :: * -> * where
FrontendRoute_Sub :: FrontendRoute (R SubRoute)
data SubRoute :: * -> * where
SubRoute_Foo :: SubRoute ()
Then replace unitEncoder with pathComponentEncoder $ \case ...
See obelisk-oauth for another example.
Related
I was using servant-generic-0.1.0.3 and servant-server-0.13.0.1 to do the following:
data Site route = Site
{ page :: route :-
"page" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] [Int]
, home :: route :-
Raw
} deriving (Generic)
type API = ToServant (Site AsApi)
siteServer :: Pool Connection -> Site AsServer
siteServer pool = Site
{ page = \x y ->
liftIO $ withResource pool $ \conn -> someDbFunction conn x y
, home = serveDirectoryWebApp "static"
}
api :: Proxy API
api = Proxy
app :: Pool Connection -> Application
app pool = serve api (toServant $ siteServer pool)
That worked fine, then I tried to use ReaderT to avoid passing Pool Connection to siteServer, so I added AppM and replaced siteServer like this:
type AppM = ReaderT (Pool Connection) IO
siteServer :: ServerT API AppM
siteServer = Site
{ page = do
pool <- ask
\x y ->
liftIO $ withResource pool $ \conn -> someDbFunction conn x y
, home = serveDirectoryWebApp "static"
}
but I got a bunch of errors when I tried to compile it.
I followed the same steps shown in the servant cookbook, but I couldn't make this work with generic routes, although it works when using regular routes.
Am I missing something that could make this work?
At least for the record-style routes supported by servant-* >= 0.14 (see here), if you want to work with another monad than Handler, you will want to look at AsServerT and genericServerT.
Applied to your example, this means siteServer should be defined as follows (not typechecked, but should be very close to correct).
siteServer :: Site (AsServerT AppM)
siteServer = Site
{ page = ... something in AppM ...
, home = ... something in AppM ...
}
-- turning that into a usual chain of :<|>-separated handlers
oldStyleServer :: ServerT API AppM
oldStyleServer = genericServerT siteServer
-- bringing it all back in Handler
oldStyleServerInHandler :: Pool Connection -> Server API -- same as ServerT API Handler
oldStyleServerInHandler conns = hoistServer (Proxy #API) appToHandler oldStyleServer
where appToHandler = liftIO . flip runReaderT conns
-- or something along those lines
-- serving it
app :: Pool Connection -> Application
app conns = serve (Proxy #API) (oldStyleServerInHandler conns)
Edit: Since you're using servant-* < 0.14 with servant-generic, you should replace genericServerT with toServant.
I have the following code which grabs two pages of data from a paginated API endpoint. I'd like to modify query function to keep getting pages until it finds no more data (so replace take 2 in the code below with something which looks at the API response).
My question is wether it is possible to achieve this without changing query function to an IO function. And if so, how would I go about it. If not, is there a way of doing this without writing recursive function?
Here is the code:
#!/usr/bin/env stack
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
import Servant.Client
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Data.Proxy
import Servant.API
import Data.Aeson
import GHC.Generics
-- data type
data BlogPost = BlogPost
{ id :: Integer
, title :: String
} deriving (Show, Generic)
instance FromJSON BlogPost
-- api client
type API = "posts" :> QueryParam "_page" Integer :> Get '[JSON] [BlogPost]
api :: Proxy API
api = Proxy
posts :: Maybe Integer -> ClientM [BlogPost]
posts = client api
-- query by page
query :: ClientM [[BlogPost]]
query = sequence $ take 2 $ map posts pages
where
pages = [Just p | p <- [1..]]
-- main
main :: IO ()
main = do
manager' <- newManager defaultManagerSettings
let url = ClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
posts' <- runClientM query url
print posts'
I've tried to use takeWhileM to do this and ended up making query an IO function and passing url into it. It was starting to look pretty horrible and I couldn't get the types to match up (I felt like I needed something more like (a -> m Bool) -> m [a] -> m [a] rather than (a -> m Bool) -> [a] -> m [a] which is what takeWhileM is - still find this strange because I see this function as a filter, yet the input list and output list are different (one has monad around it and the other doesn't)).
For these cases of monadic iteration I usually turn to the streaming library. Its interface is reminiscent to that of pure lists, while still allowing effects:
import Streaming
import qualified Streaming.Prelude as S
repeatAndCollect :: Monad m => m (Either a r) -> m [a]
repeatAndCollect = S.toList_ . Control.Monad.void . S.untilRight
repeatAndCollectLimited :: Monad m => Int -> m (Either a r) -> m [a]
repeatAndCollectLimited len = S.toList_ . S.take len . S.untilRight
Using the untilRight, take and toList_ functions.
When only the first successful result is needed, we can use the Alternative instance of the ExceptT transformer in combination with asum from Data.Foldable to execute a list of fallible actions until one of them succeeds.
IO itself has an Alternative instance that returns the first "success", where "failure" means throwing a IOException.
Have you tried unfoldM?
unfoldM :: Monad m => m (Maybe a) -> m [a]
Let's update posts this way
posts :: Maybe Integer -> ClientM (Maybe [BlogPost])
posts = fmap notNil . client api where
notNil [] = Nothing
notNil bs = Just bs
The idea is to update query so that you can just use unfoldM query and get back an ClientM [[BlogPost]]. To do that, the type of query has to be
query :: ClientM (Maybe [BlogPost])
meaning, the page number must be coming from the environment:
query = forever $ page >>= posts
Clearly, there is some form of state going on here, as we need a way to keep track of the current page number. We can wrap the client action in a StateT:
type ClientSM = StateT Integer ClientM
page :: ClientSM Integer
page = get <* modify (+1)
This action demands a few additional changes to both query and posts. Edit: see below for a stroke of insight I got in the bus. First we need to lift the client action in the state monad:
posts :: Integer -> ClientSM (Maybe [BlogPost])
posts = fmap notNil . lift . client api . Just where
notNil [] = Nothing
notNil xs = Just xs
Only the type of query needs changing
query :: ClientSM (Maybe [BlogPost])
Finally, the main action just needs to peel the monad stack and unfold the query:
main = do
manager' <- newManager defaultManagerSettings
let url = mkClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
result <- flip runClientM url $ flip runStateT 1 $ unfoldM query
case result of
Left error -> print error
Right (posts, _) -> print posts
I haven't tested this, but it compiles 😅🤗
posts is oblivious to the state, and should remain so. So, without changing my original version above, you just need to lift in query:
query :: ClientSM (Maybe [BlogPost])
query = forever $ page >>= lift . posts . Just
If you need to keep the ClientM objects separate (either to run them each in a clean state, or anything similar), the best way is to chain your operations together.
In this particular case, the runClientM query ... IO action returns a Either String [BlogPost]. This means that the stop condition is receiving a Left String from one of the computations.
Using a hand-crafted eitherM helper, which runs one of two actions depending on the Either contructor, here is a relatively simple example of that:
Using the good old either makes this relatively simple :
queryAll :: ClientEnv -> [Int] -> IO [[BlogPost]]
queryAll _ [] = return []
queryAll url (x:xs) = runClientM (posts x) url >>= either ((const.pure) []) (\b -> (b:) <$> queryAll url xs)
main :: IO ()
main = do
manager' <- newManager defaultManagerSettings
let url = ClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
posts' <- queryAll url [1..]
print posts'
Hope it can help! :)
I have an in-memory repository that I can create by calling this function:
newEmptyRepository :: IO InMemoryGameRepository
where InMemoryGameRepository is defined like this:
type State = (HashMap GameId Game)
type IORefState = IORef State
newtype InMemoryGameRepository = InMemoryGameRepository IORefState
When writing tests for my Scotty application I've seen examples of using this approach:
spec =
before app $ do
describe "GET /" $ do
it "responds with 200" $ get "/" `shouldRespondWith` 200
it "responds with 'hello'" $ get "/" `shouldRespondWith` "hello"
...
This is all fine but I need to somehow also initialize the InMemoryGameRepository (by calling newEmptyRepository) and use the created instance in my tests. Thus I've changed app to:
app :: InMemoryGameRepository -> IO Application
app repo = scottyApp $ routes repo
And I'm trying to create a test that uses the repository AND the IO Application, for example like this (which doesn't work):
spec =
before (do repo <- newEmptyRepository
app repo) $
-- API Tests
describe "GET /api/games" $
it "responds with " $ do
liftIO $ startGame repo
get "/api/games" `shouldRespondWith` singleGameResponse
where startGame is defined like this:
startGame :: InMemoryGameRepository -> IO Game
Here the compiler says (obviously) that repo is not in scope. But how can I achieve this? I.e. I want to share a single instance of newEmptyRepository both for the app and in the test?
Ps: you can see the full application on github.
You should use beforeWith which has the type
beforeWith :: (b -> IO a) -> SpecWith a -> SpecWith b
Use it as e.g. before newEmptyRepository . beforeWith app whose type is SpecWith Application -> Spec.
If you want to access both the InMemoryGameRepository and the Application in your test cases, defined a helper function
withArg f a = (,) a <$> f a
withArg :: Functor f => (t -> f b) -> t -> f (t, b)
then use
before newEmptyRepository . beforeWith (withArg app)
:: SpecWith (InMemoryGameRepository, Application) -> Spec
Finally, you shouldn't use liftIO $ startGame repo in the definition of your tests - this runs startGame every time the test tree is built (although, this may actually be what you want, it doesn't seem to be the case). Instead, if you use the before family of functions, startGame will run once before the tests are actually run. You can even access the Game returned by startGame using the same technique as above:
before newEmptyRepository
. beforeWith (withArg startGame)
. beforeWith (withArg $ app . fst)
:: SpecWith ((InMemoryGameRepository, Game), Application) -> Spec
I'm new to Haskell so apologies in advance for the potentially stupid question.
I'd like to build a data structure that is constructed from two http requests in my application.
My first request gets a basic list of users which I could choose to decode to Maybe [User]
r <- getWith opts "https://www.example.com/users"
let users = decode $ r ^. responseBody :: Maybe [User]
But if I'd like to enrich my user data by calling a second endpoint for each of the users that respond by doing something like
r2 <- getWth opts "https://www.example.com/users/{userid}/addresses"
let enrichedUser = decode $ r2 ^. responseBody :: Maybe EnrichedUser
I can't quite piece these parts together at the minute. I'm in a do block thats expecting an IO ()
Any help would be appreciated!
I'm assuming that the type of enrichedUser is supposed to be Maybe EnrichedUser and not Maybe [EnrichedUser], right?
If so, after extracting the [User] list from users :: Maybe [User], the problem you're facing is running a monadic action (to fetch the web page) for each User. There's a handy combinator for this in Control.Monad:
mapM :: (Monad m) => (a -> m b) -> ([a] -> m [b])
which can be specialized in your situation to:
mapM :: (User -> IO EnrichedUser) -> ([User] -> IO [EnrichedUser])
This says, if you know how to write a function that takes a User and creates an IO action that will create an EnrichedUser, you can use mapM to turn this into a function that takes a list [User] and creates an IO action to create a whole list [EnrichedUser].
In your application, I imagine the former function would look something like:
enrich :: User -> IO EnrichedUser
enrich u = do
let opts = ...
let url = "https://www.example.com/users/"
++ userToUserID u ++ "/addresses"
r2 <- getWith opts url
let Just enrichedUser = decode $ r2 ^. responseBody
return enrichedUser
where decode = ...
and then you can write (in your IO do-block):
r <- getWith opts "https://www.example.com/users"
let Just users = decode $ r ^. responseBody
enrichedUsers <- mapM enrich users
-- here, enrichedUsers :: [EnrichedUser]
...etc...
I've omitted the Maybe processing here for simplicity. If enriching fails, you probably want to somehow coerce a regular User into a default EnrichedUser anyway, so you'd modify the bottom of the enrich function to read:
let enrichedUser = case decode $ r2 ^. responseBody of
Nothing -> defaultEnrichment u
Just e -> e
return enrichedUser
and everything else would stay the same.
I think I did asked a similar question some time ago but it was not answered due to unstable API. So I was waiting for the 0.13 to pass by. I am not sure if it is correct to bring up a similar question...?
What is the alternative to interpreted runChildrenWith(Text) and mapSplices in the compiled splices world? (this combination seems to be the most common)
I would really appreciate some code examples if possible.
If I understand correctly, we get together all the application splices and then add them to the heistInit. Can anyone show how to do it please?
Does the splice binding tag has to be unique across the whole application?
Is there a completed snap project utilising new APIs and compiled splices so that I could read and see learn?
Thank you.
-- UPDATE --
Great answer below. But some parts (the ones with lenses) got me even more confused, unfortunately.
If I understand correctly this is the simple way to splice a string:
mySplice = "testSplice" ## testSplice
where testSplice = return $ C.yieldRuntimeText $ do
return "text to be spliced"
If i need to run the spliced string several times, say in 5 table raws i would do it like this:
mySplices = C.manyWithSplices C.runChildren mySplice
Is this correct?
I get bunch of errors trying to add the splices in heist config.
addConfig h $ mempty
{
hcCompiledSplices = "mySplice" ## mySplice -- or mySplices
}
Where am I going wrong? Sorry for being slow.
All I need really ( just for now so I can understand) is to splice and display a simple string that I receive from database.
-- UPDATE 2 --
Thanks to the extremle helpfull Daniel`s answer I can finally get something working.
So far I get both variants of code working.
The first one, thanks to Daniel
stringSplice :: Monad n => C.Splice n
stringSplice = C.manyWithSplices C.runChildren splicefuncs (return ["aa","bb","cc"])
where
splicefuncs = "string" ## (C.pureSplice . C.textSplice $ id)
And the secod
testSplice :: C.Splice (Handler App App)
testSplice = return $ C.yieldRuntimeText $ return "text to be spliced"
Where
(C.pureSplice . C.textSplice $ id)
produces similar results to
return $ C.yieldRuntimeText $ return "text to be spliced"
Is there difference between the above? Any cases that one would prefer one to another? They seem to produce the same results.
There is a "deferMany" function in the compiled splices lib that, according to the docs, produces similar results to the mapSplices in interpreted lib.
Can we use it instead of "C.manyWithSplices C.runChildren" combination??
Let's say you want to display information about a list of persons using compiled splices (assume that we start from the scaffolding generated by snap init.)
A very simple _persons.tpl template with dummy values would be something like
<body>
<person>
<div>
<h1><name>dummy name</name></h1>
<p><age>77</age></p>
<p><location>jauja</location></p>
</div>
</person>
</body>
Where person, name, age, and location are the tags to be spliced.
We define a trivial Snaplet that holds the info
data Foo = Foo
{
_persons :: [Person]
}
makeLenses ''Foo
data Person = Person
{
_name :: Text
, _age :: Int
, _location :: Text
}
makeLenses ''Person
and we add it to the App record:
data App = App
{ _heist :: Snaplet (Heist App)
, _sess :: Snaplet SessionManager
, _auth :: Snaplet (AuthManager App)
, _foo :: Snaplet Foo
}
we add the following to the app initializer
f <- nestSnaplet "foo" foo $ makeSnaplet "foo" "Foo Snaplet" Nothing $ return $ Foo $
[ Person "Ricardo" 33 "Los Cantones"
, Person "Luis" 38 "Montealto"
]
...
return $ App h s a f
This function constructs a Handler that returns the list of persons (using view from Control.Lens):
personH :: SnapletLens b Foo -> Handler b b [Person]
personH l = withTop l $ view persons <$> get
This function constructs the appropiate compiled splice from a RuntimeSplice that produces a list of Persons. RuntimeSplices represent information that can only be known at run time, as opposed to load time:
personSplice :: Monad n => RuntimeSplice n [Person] -> C.Splice n
personSplice = C.manyWithSplices C.runChildren splicefuncs
where
splicefuncs = mconcat
[ "name" ## (C.pureSplice . C.textSplice $ view name)
, "age" ## (C.pureSplice . C.textSplice $ T.pack . show . view age)
, "location" ## (C.pureSplice . C.textSplice $ view location)
]
And this function can be used to register the splice in the global Heist configuration. Notice that we lift the Handler into a RuntimeSplice:
addPersonSplices :: HasHeist b => Snaplet (Heist b) ->
SnapletLens b Foo ->
Initializer b v ()
addPersonSplices h l = addConfig h $ mempty
{
hcCompiledSplices = "person" ## (personSplice . lift $ personH l)
}
Be sure to add this line to the app initializer:
addPersonSplices h foo
And to add the following pair to the app's routes:
("/persons", cRender "_persons")
If you now run the server, navigating to http://127.0.0.1:8000/persons should show the list.
UPDATE
For the simpler case (no complex records, no lenses) in which you only want to show a list of strings.
The template could be something like:
<body>
<strings>
<p><string>dummy value</string></p>
</strings>
</body>
The top-level splice would be:
stringSplice :: Monad n => C.Splice n
stringSplice = C.manyWithSplices C.runChildren splicefuncs (return ["aa","bb","cc"])
where
splicefuncs = "string" ## (C.pureSplice . C.textSplice $ id)
This means "when we encounter the tag associated to this splice, perform an action that produces a list of strings, and for each string, render the contents of the tag, substituting the current string for the string tag".
Notice that the signature of manyWithSplices forces the stuff to the right of the (##) to have type RuntimeSplice n Text -> Splice n. Here id has type Text -> Text. C.TextSplice transforms it into something of type Text -> Builder, and C.pureSplice performs the final transformation into a RuntimeSplice n Text -> Splice n.
In place of (return ["aa","bb","cc"]) you could provide a more complex action that connected a database and extracted the strings form there.
A function to register this splice would be:
addStringSplices :: HasHeist b => Snaplet (Heist b) -> Initializer b v ()
addStringSplices h = addConfig h $ mempty
{
hcCompiledSplices = "strings" ## stringSplice
}