How do I set per request transient-state in Snap?
Looking at http://snapframework.com/docs/tutorials/snaplets-tutorial it says
Handler b v has a MonadState v instance. This means that you can access all your snaplet state through the get, put, gets, and modify functions that are probably familiar from the state monad.
So I am trying the following:
data App = App
{ _test :: Int
}
And then in the handler:
someHandler :: Handler App App ()
someHandler = do
test <- gets _test
liftIO $ print test
put ( 2 :: Int _test
However I get the error:
• Couldn't match type ‘()’ with ‘Handler App App a0’
Expected type: (App -> Int) -> Handler App App a0
Actual type: (App -> Int) -> ()
• The function ‘put’ is applied to two arguments,
its type is ‘s0 -> m0 ()’,
it is specialized to ‘Int -> (App -> Int) -> ()’
In a stmt of a 'do' block: put (2 :: Int) _test
In the expression:
do { test <- gets _test;
liftIO $ print test;
put (2 :: Int) _test;
Any ideas how to achieve that?
Thanks!
Related
I am using Obelisk OAuth to handle multiple OAuth options (Facebook, Google, & Apple, though only FB is shown below).
I have getOAuthDetails which gets the correct details for each provider.
I use it in backend (at the bottom), but it gives me this error:
backend/src/Backend.hs:144:47-54: error:
• Couldn't match expected type ‘OAuthProvider’
with actual type ‘OAuth a1’
• In the first argument of ‘getOAuthDetails’, namely ‘provider’
In the expression: getOAuthDetails provider code
In a pattern binding: (t, reqUrl) = getOAuthDetails provider code
• Relevant bindings include
oauthRoute :: a1 (bound at backend/src/Backend.hs:140:41)
provider :: OAuth a1 (bound at backend/src/Backend.hs:140:29)
|
144 | let (t, reqUrl) = getOAuthDetails provider code
| ^^^^^^^^
This error is confusing to me because I am explicitly feeding in OAuthProvider as provider in that function. Why would it then say actual type ‘OAuth a1’?
data OAuthProvider = OAuthProvider_Facebook
| OAuthProvider_Google
| OAuthProvider_Apple
getOAuthDetails :: OAuthProvider -> T.Text -> (TokenRequest BackendRoute, String) -- NB. this last T.Text is a reqUrl
getOAuthDetails OAuthProvider_Facebook code = (fbTokenReq code, (T.unpack fbReqUrl))
getOAuthDetails OAuthProvider_Google code = (googTokenReq code, (T.unpack googReqUrl))
getOAuthDetails OAuthProvider_Apple code = (applTokenReq code, (T.unpack applReqUrl))
fbTokenReq :: T.Text -> TokenRequest BackendRoute
fbTokenReq code = TokenRequest
{ _tokenRequest_grant = TokenGrant_AuthorizationCode $ T.encodeUtf8 code
, _tokenRequest_clientId = "fake-client-id" -- Get this from the OAuth authorization server
, _tokenRequest_clientSecret = "fake-client-secret" -- Get this from the OAuth authorization server
, _tokenRequest_redirectUri = BackendRoute_OAuth
}
fbReqUrl :: T.Text
fbReqUrl = "https://graph.facebook.com/oauth/access_token"
...
-- provider2Auth :: OAuthProvider -> OAuth RedirectUriParams
-- provider2Auth
backend :: OAuthProvider -> Backend BackendRoute FrontendRoute
backend provider = Backend
{ _backend_run = \serve -> do
cfg <- getConfigs
let route = T.strip $ T.decodeUtf8 $ cfg ! "common/route"
tlsMgr <- Https.newTlsManager
serve $ \case
BackendRoute_Missing :/ () -> error "404"
BackendRoute_OAuth :/ provider :/ oauthRoute -> case oauthRoute of
OAuth_RedirectUri :/ redirectParams -> case redirectParams of
Nothing -> liftIO $ error "Expected to receive the authorization code here"
Just (RedirectUriParams code _mstate) -> do
let (t, reqUrl) = getOAuthDetails provider code
rsp <- liftIO $ flip Http.httpLbs tlsMgr =<< getOauthToken reqUrl route checkedEncoder t
-- ^ this response should include the access token and probably a refresh token
liftIO $ print rsp
, _backend_routeEncoder = fullRouteEncoder
}
EDIT:
ob run displayed this:
backend/src/Backend.hs:140:9-43: error:
• Could not deduce: a1 ~ R OAuth
from the context: a ~ Data.Dependent.Sum.DSum OAuth Identity
bound by a pattern with constructor:
BackendRoute_OAuth :: BackendRoute (R OAuth),
in a case alternative
at backend/src/Backend.hs:139:7-24
‘a1’ is a rigid type variable bound by
a pattern with pattern synonym:
:/ :: forall (f :: * -> *). () => forall a. f a -> a -> R f,
in a case alternative
at backend/src/Backend.hs:139:7-36
• In the pattern: OAuth_RedirectUri :/ redirectParams
In a case alternative:
OAuth_RedirectUri :/ redirectParams
-> case redirectParams of
Nothing
-> liftIO $ error "Expected to receive the authorization code here"
Just (RedirectUriParams code _mstate)
-> do let ...
....
In the expression:
case oauthRoute of {
OAuth_RedirectUri :/ redirectParams
-> case redirectParams of
Nothing
-> liftIO $ error "Expected to receive the authorization code here"
Just (RedirectUriParams code _mstate) -> do ... }
• Relevant bindings include
oauthRoute :: a1 (bound at backend/src/Backend.hs:139:41)
provider :: OAuth a1 (bound at backend/src/Backend.hs:139:29)
|
140 | OAuth_RedirectUri :/ redirectParams -> case redirectParams of
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
backend/src/Backend.hs:143:47-54: error:
• Couldn't match expected type ‘OAuthProvider’
with actual type ‘OAuth a1’
• In the first argument of ‘getOAuthDetails’, namely ‘provider’
In the expression: getOAuthDetails provider code
In a pattern binding: (t, reqUrl) = getOAuthDetails provider code
• Relevant bindings include
oauthRoute :: a1 (bound at backend/src/Backend.hs:139:41)
provider :: OAuth a1 (bound at backend/src/Backend.hs:139:29)
|
143 | let (t, reqUrl) = getOAuthDetails provider code
| ^^^^^^^^
Thanks to Srid, I saw that I had two providers. I modified my backend to:
backend :: OAuthProvider -> Backend BackendRoute FrontendRoute
backend provider = Backend
{ _backend_run = \serve -> do
cfg <- getConfigs
let route = T.strip $ T.decodeUtf8 $ cfg ! "common/route"
tlsMgr <- Https.newTlsManager
serve $ \case
BackendRoute_Missing :/ () -> error "404"
BackendRoute_OAuth :/ oauthRoute -> case oauthRoute of
OAuth_RedirectUri :/ redirectParams -> case redirectParams of
Nothing -> liftIO $ error "Expected to receive the authorization code here"
Just (RedirectUriParams code _mstate) -> do
let (t, reqUrl) = getOAuthDetails provider code
rsp <- liftIO $ flip Http.httpLbs tlsMgr =<< getOauthToken reqUrl route checkedEncoder t
-- ^ this response should include the access token and probably a refresh token
liftIO $ print rsp
, _backend_routeEncoder = fullRouteEncoder
}
And now I get:
Running test...
<interactive>:623:116-130: error:
• Couldn't match expected type ‘Backend
backendRoute0 FrontendRoute’
with actual type ‘OAuthProvider
-> Backend BackendRoute FrontendRoute’
• Probable cause: ‘backend’ is applied to too few arguments
In the third argument of ‘Obelisk.Run.run’, namely ‘backend’
In the expression:
Obelisk.Run.run
55245
(Obelisk.Run.runServeAsset
"/Users/levelchart/Documents/git/app-obelisk/static")
backend
Frontend.frontend
In an equation for ‘it’:
it
= Obelisk.Run.run
55245
(Obelisk.Run.runServeAsset
"/Users/levelchart/Documents/git/app-obelisk/static")
backend
Frontend.frontend
I am currently working on a game engine in Haskell and now I am trying to implement a messaging system between subsystems of this engine (I am using a Publisher-Subscriber pattern). You can check out the code as a whole at here on my github profile. I implemented a "Participant" typeclass for all datatypes participating in my Messaging system as follows:
class (Show m, Message m) => Participant prt m where
-- | Function to get the lsit of subscribers from the participant
partSubscribers
:: prt
-- ^ the participant
-> forall us. Affection us [(m -> Affection us ())]
-- ^ List of Subscriber functions
-- | Subscribe to the 'Participant''s events
partSubscribe
:: prt
-- ^ The 'Participant' to subscribe to
-> (forall us. m -> Affection us ())
-- ^ What to do in case of a 'Message'
-- (Subscriber function)
-> Affection us UUID
-- ^ 'UUID' of the registered subscriber Function
-- | Unsubscribe a Subscriber function from Participant
partUnSubscribe
:: prt -- ^ The 'Participant' to unsubscribe from
-> UUID -- ^ The subscriber function's 'UUID'
-> Affection us ()
-- | Get the 'Participant' to emit a 'Message' on all of its subscribers
partEmit
:: prt -- ^ The 'Participant'
-> m -- ^ The 'Message' to emit
-> Affection us ()
partEmit p m = do
liftIO $ logIO Debug $ "Emitting message: " ++ show m
l <- partSubscribers p
mapM_ ($ m) l
A concrete implementation of this Typeclass looks like this. I'm making the use of the Package stm:
data AffectionWindow us = AffectionWindow
{ windowSubscribers
:: forall us. TVar [(UUID, WindowMessage -> Affection us ())]
}
instance Participant (AffectionWindow us) WindowMessage where
partSubscribe p funct = do
uuid <- genUUID
liftIO $ atomically $ modifyTVar' (windowSubscribers p) ((uuid, funct) :)
return uuid
partUnSubscribe p uuid =
liftIO $ atomically $ modifyTVar' (windowSubscribers p)
(filter (\(u, _) -> u /= uuid))
partSubscribers p = do
subTups <- liftIO $ readTVarIO $ windowSubscribers p
return $ map snd subTups
This code compiles fine as a library, but when I try to use this in a minimal example, it fails to compile. The code, where it fails looks like this:
load :: IO StateData
load = do
empty1 <- newTVarIO []
-- ([] :: [(UUID, WindowMessage -> Affection StateData ())])
empty2 <- newTVarIO []
-- ([] :: [(UUID, MouseMessage -> Affection StateData ())])
empty3 <- newTVarIO []
-- ([] :: [(UUID, KeyboardMessage -> Affection StateData ())])
return $ StateData $ Subsystems
(AffectionWindow empty1)
(AffectionMouse empty2)
(AffectionKeyboard empty3)
and the error message is:
examples/example00.hs:43:22: error:
• Couldn't match type ‘a0’
with ‘(UUID, WindowMessage -> Affection us1 ())’
because type variable ‘us1’ would escape its scope
This (rigid, skolem) type variable is bound by
a type expected by the context:
forall us1. TVar [(UUID, WindowMessage -> Affection us1 ())]
at examples/example00.hs:43:6-27
Expected type: TVar [(UUID, WindowMessage -> Affection us1 ())]
Actual type: TVar [a0]
• In the first argument of ‘AffectionWindow’, namely ‘empty1’
In the first argument of ‘Subsystems’, namely
‘(AffectionWindow empty1)’
In the second argument of ‘($)’, namely
‘Subsystems
(AffectionWindow empty1)
(AffectionMouse empty2)
(AffectionKeyboard empty3)’
• Relevant bindings include
empty1 :: TVar [a0] (bound at examples/example00.hs:39:3)
|
43 | (AffectionWindow empty1)
| ^^^^^^
I have never encountered any error like this and I'm at my wits end.
Hopefully somebody in here knows the solution.
Thanks for your time!
I'm working on a project that builds on the simple yesod template. I am new to functional programming, haskell and Yesod so it's probably something obvious to anyone with Yesod experience. At the moment I am trying to make github API calls using this library. I am getting some type issues and I'm not even sure how to start approaching solving them.
You can find my handler here.
Handler/Home.hs:43:19:
Couldn't match expected type ‘HandlerT
App IO (Either a0 GitHub.User)’
with actual type ‘GitHub.Request k0 GitHub.User’
In a stmt of a 'do' block:
possibleUser <- GitHub.userInfoForR "mike-burns"
In the expression:
do { maid <- maybeAuthId;
possibleUser <- GitHub.userInfoForR "mike-burns";
result <- either (("Error: " <>) . tshow) formatUser possibleUser;
defaultLayout
(do { (asWidgetT GHC.Base.. toWidget)
((blaze-markup-0.7.1.1:Text.Blaze.Internal.preEscapedText
GHC.Base.. Data.Text.pack)
"<p>Your current auth ID: ");
(asWidgetT GHC.Base.. toWidget) (toHtml (show maid));
(asWidgetT GHC.Base.. toWidget)
((blaze-markup-0.7.1.1:Text.Blaze.Internal.preEscapedText
GHC.Base.. Data.Text.pack)
"</p>\n");
.... }) }
Handler/Home.hs:44:38:
Couldn't match type ‘Text’ with ‘HandlerT App IO a1’
Expected type: a0 -> HandlerT App IO a1
Actual type: a0 -> Text
In the second argument of ‘(.)’, namely ‘tshow’
In the first argument of ‘either’, namely
‘(("Error: " <>) . tshow)’
Handler/Home.hs:44:45:
Couldn't match type ‘Text’ with ‘HandlerT App IO a1’
Expected type: GitHub.User -> HandlerT App IO a1
Actual type: GitHub.User -> Text
In the second argument of ‘either’, namely ‘formatUser’
In a stmt of a 'do' block:
result <- either (("Error: " <>) . tshow) formatUser possibleUser
The GitHub library seems to be about building requests, and running them. The userInfoForR does such a thing :
userInfoForR :: Name User -> Request k User
Once you have a request, you can run it with one of the following functions, depending if you need to authenticate or not:
executeRequest :: Auth -> Request k a -> IO (Either Error a)
executeRequest' :: Request RO a -> IO (Either Error a)
I don't know about this specific case, but let's say you don't need authentication. So, the following expression would do the trick:
executeRequest' (userInfoForR "mike-burns") :: IO (Either Error User)
Now, in order to use it in a Handler, you'll need to learn about the fact that Handler is an instance of MonadIO, and you can thus do:
euser <- liftIO (executeRequest' (userInfoForR "mike-burns"))
case euser of
Left rr -> ...
Right user -> ...
I'm learning haskell now.
Now i want to write a function which takes one argument(Int, for example), prints some string to the output and returns this argument. I'm trying to do something like this:
test :: Int -> Int
test h = do
putStrLn "Here will be number!"
h
main = print $ test 200
Now i getting such error:
Couldn't match expected type `Int' with actual type `m0 b0'
Expected type: m0 a0 -> m0 b0 -> Int
Actual type: m0 a0 -> m0 b0 -> m0 b0
In a stmt of a 'do' block: h
In the expression:
do { putStrLn "Here will be number!";
h }
Is there way to implement what I want?
Since test produces output visible to the user, it must return an IO Int, not an Int. Have a look at the introduction to IO on the Haskell wiki.
test :: Int -> IO ()
test n = putStrLn (show n)
main :: IO ()
main = test 200
I'm working on ffi bindings to the Assimp library using c2hs. I have a datatype AiScene, defined as follows (the details are unimportant):
data AiScene = AiScene
{ mFlags :: SceneFlags
, mMeshes :: [AiMesh]
, mMaterials :: [AiMaterial]
, mAnimations :: [AiAnimation]
, mTextures :: [AiTexture]
, mLights :: [AiLight]
, mCameras :: [AiCamera]
}
{#pointer *aiScene as AiScenePtr -> AiScene#}
Now I'm trying to write bindings to the following function:
const aiScene* aiImportFile(
const char* pFile,
unsigned int pFlags);
This is what I have so far:
{#fun aiImportFile as ^
{`String', cFromEnum `SceneFlags'} -> `AiScene' peek*#}
Unfortunately I get a type error...
Couldn't match expected type `AiScene' against inferred type `()'
Expected type: IO AiScene
Inferred type: IO ()
Now if I go into the generated source and change the type:
aiImportFile'_ :: ((Ptr CChar) -> (CUInt -> (IO (Ptr ())))) -- original
aiImportFile'_ :: ((Ptr CChar) -> (CUInt -> (IO (Ptr AiScene)))) -- fixed
Then the problem goes away. How can I get c2hs to do this automatically / what am I doing wrong?
Thanks!
Edit: One thing I forgot to mention is that I have defined an instance of Storable for AiScene.
community-wiki answer with the solution for posterity:
I defined the following: with' x y = with x (y . castPtr) and peek' = peek . castPtr and the type errors go away.