Compile with ghc 8.6 by pushing MonadFail usage into IO
This commit is contained in:
parent
90423f5bc7
commit
132abccff2
5 changed files with 18 additions and 5 deletions
|
@ -1,3 +1,7 @@
|
|||
## 1.6.0.1
|
||||
|
||||
* Compile with GHC 8.6
|
||||
|
||||
## 1.6.0
|
||||
|
||||
* Upgrade to yesod-core 1.6.0
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, QuasiQuotes #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
@ -69,7 +70,9 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login
|
|||
setSession oauthSessionName $ lookupTokenSecret tok
|
||||
redirect $ authorizeUrl oauth' tok
|
||||
dispatch "GET" [] = do
|
||||
Just tokSec <- lookupSession oauthSessionName
|
||||
tokSec <- lookupSession oauthSessionName >>= \case
|
||||
Just t -> return t
|
||||
Nothing -> liftIO $ fail "lookupSession could not find session"
|
||||
deleteSession oauthSessionName
|
||||
reqTok <-
|
||||
if oauthVersion oauth == OAuth10
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
name: yesod-auth-oauth
|
||||
version: 1.6.0
|
||||
version: 1.6.0.1
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Hiromi Ishii
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
module EmbedProductionTest where
|
||||
|
||||
-- Tests the production mode of the embedded static subsite by
|
||||
|
@ -108,7 +109,9 @@ embedProductionSpecs = yesodSpec (MyApp eProduction) $ do
|
|||
yit "Embedded Javascript" $ do
|
||||
get HomeR
|
||||
statusIs 200
|
||||
[script] <- htmlQuery "script"
|
||||
script <- htmlQuery "script" >>= \case
|
||||
[s] -> return s
|
||||
_ -> liftIO $ fail "Expected singleton list of script"
|
||||
let src = BL.takeWhile (/= 34) $ BL.drop 1 $ BL.dropWhile (/= 34) script -- 34 is "
|
||||
|
||||
get $ TL.toStrict $ TL.decodeUtf8 src
|
||||
|
|
|
@ -5,6 +5,7 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
@ -482,8 +483,10 @@ postHomeR = defaultLayout
|
|||
|
||||
postResourcesR :: Handler ()
|
||||
postResourcesR = do
|
||||
([("foo", t)], _) <- runRequestBody
|
||||
sendResponseCreated $ ResourceR t
|
||||
t <- runRequestBody >>= \case
|
||||
([("foo", t)], _) -> return t
|
||||
_ -> liftIO $ fail "postResourcesR pattern match failure"
|
||||
sendResponseCreated $ ResourceR t
|
||||
|
||||
getResourceR :: Text -> Handler Html
|
||||
getResourceR i = defaultLayout
|
||||
|
|
Loading…
Reference in a new issue