haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Clean up a bunch of warnings

Browse Source
This commit is contained in:
Michael Snoyman 2014-09-29 08:08:02 +03:00
parent 14d9b7ce71
commit 3447510080
12 changed files with 46 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-core/Yesod/Core/Class/Handler.hs
View File

@ -13,8 +13,8 @@ module Yesod.Core.Class.Handler
import Yesod.Core.Types
import Data.Monoid (mempty)
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Resource (MonadResource, MonadResourceBase, ExceptionT (..))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (MonadResource, MonadResourceBase)
import Control.Monad.Trans.Class (lift)
import Data.Monoid (Monoid)
import Data.Conduit.Internal (Pipe, ConduitM)

6
yesod-core/Yesod/Core/Class/Yesod.hs
View File

@ -39,10 +39,8 @@ import qualified Network.Wai as W
import Data.Default (def)
import Network.Wai.Parse (lbsBackEnd,
tempFileBackEnd)
import System.IO (stdout)
import Network.Wai.Logger (ZonedDate, clockDateCacher)
import System.Log.FastLogger
import qualified GHC.IO.FD
import Text.Blaze (customAttribute, textTag,
toValue, (!))
import Text.Blaze (preEscapedToMarkup)
@ -210,9 +208,9 @@ class RenderRoute site => Yesod site where
-- Default: Sends to stdout and automatically flushes on each write.
makeLogger :: site -> IO Logger
makeLogger _ = do
loggerSet <- newLoggerSet defaultBufSize Nothing
loggerSet' <- newStdoutLoggerSet defaultBufSize
(getter, _) <- clockDateCacher
return $! Logger loggerSet getter
return $! Logger loggerSet' getter
-- | Send a message to the @Logger@ provided by @getLogger@.
--

8
yesod-core/Yesod/Core/Content.hs
View File

@ -66,7 +66,11 @@ import Data.Conduit.Internal (ResumableSource (ResumableSource))
import qualified Data.Conduit.Internal as CI
import qualified Data.Aeson as J
#if MIN_VERSION_aeson(0, 7, 0)
import Data.Aeson.Encode (encodeToTextBuilder)
#else
import Data.Aeson.Encode (fromValue)
#endif
import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
import Data.Text.Lazy.Builder (toLazyText)
import Yesod.Core.Types
@ -243,7 +247,11 @@ instance ToContent J.Value where
toContent = flip ContentBuilder Nothing
. Blaze.fromLazyText
. toLazyText
#if MIN_VERSION_aeson(0, 7, 0)
. encodeToTextBuilder
#else
. fromValue
#endif
instance HasContentType J.Value where
getContentType _ = typeJson

32
yesod-core/Yesod/Core/Dispatch.hs
View File

@ -42,7 +42,7 @@ import qualified Network.Wai as W
import Data.ByteString.Lazy.Char8 ()
import Data.Text (Text, pack)
import Data.Text (Text)
import Data.Monoid (mappend)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
@ -96,6 +96,7 @@ toWaiAppYre yre req =
sendResponse $ W.responseLBS status301
[ ("Content-Type", "text/plain")
, ("Location", Blaze.ByteString.Builder.toByteString dest')
-- FIXME , ("Server", serverValue)
] "Redirecting"
where
dest = joinPath y (resolveApproot y env) segments' []
@ -152,19 +153,9 @@ toWaiAppLogger logger site = do
warp :: YesodDispatch site => Int -> site -> IO ()
warp port site = do
logger <- makeLogger site
toWaiAppLogger logger site >>= Network.Wai.Handler.Warp.runSettings
Network.Wai.Handler.Warp.defaultSettings
{ Network.Wai.Handler.Warp.settingsPort = port
{- FIXME
, Network.Wai.Handler.Warp.settingsServerName = S8.pack $ concat
[ "Warp/"
, Network.Wai.Handler.Warp.warpVersion
, " + Yesod/"
, showVersion Paths_yesod_core.version
, " (core)"
]
-}
, Network.Wai.Handler.Warp.settingsOnException = const $ \e ->
toWaiAppLogger logger site >>= Network.Wai.Handler.Warp.runSettings (
Network.Wai.Handler.Warp.setPort port $
Network.Wai.Handler.Warp.setOnException (\_ e ->
when (shouldLog' e) $
messageLoggerSource
site
@ -172,11 +163,20 @@ warp port site = do
$(qLocation >>= liftLoc)
"yesod-core"
LevelError
(toLogStr $ "Exception from Warp: " ++ show e)
}
(toLogStr $ "Exception from Warp: " ++ show e)) $
Network.Wai.Handler.Warp.defaultSettings)
where
shouldLog' = Network.Wai.Handler.Warp.defaultShouldDisplayException
_serverValue :: S8.ByteString -- FIXME
_serverValue = S8.pack $ concat
[ "Warp/"
, Network.Wai.Handler.Warp.warpVersion
, " + Yesod/"
, showVersion Paths_yesod_core.version
, " (core)"
]
-- | A default set of middlewares.
--
-- Since 1.2.0

1
yesod-core/Yesod/Core/Internal/Request.hs
View File

@ -39,7 +39,6 @@ import Data.Conduit
import Data.Conduit.List (sourceList)
import Data.Conduit.Binary (sourceFile, sinkFile)
import Data.Word (Word64)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (runResourceT, ResourceT)
import Control.Exception (throwIO)
import Yesod.Core.Types

8
yesod-core/Yesod/Core/Internal/Response.hs
View File

@ -14,11 +14,11 @@ import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Network.Wai
import Data.Conduit (transPipe)
import Control.Monad.Trans.Resource (runInternalState, getInternalState, runResourceT, InternalState, closeInternalState)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Resource (runInternalState, InternalState)
import Network.Wai.Internal
import Control.Exception (finally)
#if !MIN_VERSION_base(4, 6, 0)
import Prelude hiding (catch)
#endif
import Web.Cookie (renderSetCookie)
import Yesod.Core.Content
import Yesod.Core.Types
@ -43,7 +43,7 @@ yarToResponse :: YesodResponse
-> IO ResponseReceived
yarToResponse (YRWai a) _ _ _ _ sendResponse = sendResponse a
yarToResponse (YRWaiApp app) _ _ req _ sendResponse = app req sendResponse
yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq req is sendResponse = do
yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq _req is sendResponse = do
extraHeaders <- do
let nsToken = maybe
newSess

9
yesod-core/Yesod/Core/Internal/Run.hs
View File

@ -10,7 +10,7 @@ module Yesod.Core.Internal.Run where
import Yesod.Core.Internal.Response
import Blaze.ByteString.Builder (toByteString)
import Control.Applicative ((<$>))
import Control.Exception (fromException, bracketOnError, evaluate)
import Control.Exception (fromException, evaluate)
import qualified Control.Exception as E
import Control.Exception.Lifted (catch)
import Control.Monad (mplus)
@ -35,7 +35,9 @@ import Language.Haskell.TH.Syntax (Loc, qLocation)
import qualified Network.HTTP.Types as H
import Network.Wai
import Network.Wai.Internal
#if !MIN_VERSION_base(4, 6, 0)
import Prelude hiding (catch)
#endif
import System.Log.FastLogger (LogStr, toLogStr)
import System.Random (newStdGen)
import Yesod.Core.Content
@ -44,8 +46,7 @@ import Yesod.Core.Types
import Yesod.Core.Internal.Request (parseWaiRequest,
tooLargeResponse)
import Yesod.Routes.Class (Route, renderRoute)
import Control.DeepSeq (($!!), NFData)
import Control.Monad (liftM)
import Control.DeepSeq (($!!))
returnDeepSessionMap :: Monad m => SessionMap -> m SessionMap
#if MIN_VERSION_bytestring(0, 10, 0)
@ -115,6 +116,7 @@ runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -
| otherwise = status'
in return $ YRPlain status hs' ct c sess
YRWai _ -> return yar
YRWaiApp _ -> return yar
let sendFile' ct fp p =
return $ YRPlain H.status200 headers ct (ContentFile fp p) finalSession
contents1 <- evaluate contents `E.catch` \e -> return
@ -225,6 +227,7 @@ runFakeHandler fakeSessionMap logger site handler = liftIO $ do
, requestBody = return mempty
, vault = mempty
, requestBodyLength = KnownLength 0
, requestHeaderRange = Nothing
}
fakeRequest =
YesodRequest

1
yesod-core/Yesod/Core/Json.hs
View File

@ -29,7 +29,6 @@ module Yesod.Core.Json
import Yesod.Core.Handler (HandlerT, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep)
import Control.Monad.Trans.Writer (Writer)
import Control.Monad.Trans.Resource (runExceptionT)
import Data.Monoid (Endo)
import Yesod.Core.Content (TypedContent)
import Yesod.Core.Types (reqAccept)

3
yesod-core/Yesod/Core/Types.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
@ -54,7 +55,9 @@ import Yesod.Core.Internal.Util (getTime, putTime)
import Control.Monad.Trans.Class (MonadTrans (..))
import Yesod.Routes.Class (RenderRoute (..), ParseRoute (..))
import Control.Monad.Reader (MonadReader (..))
#if !MIN_VERSION_base(4, 6, 0)
import Prelude hiding (catch)
#endif
import Control.DeepSeq (NFData (rnf))
import Data.Conduit.Lazy (MonadActive, monadActive)
import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)

4
yesod-core/Yesod/Routes/Overlap.hs
View File

@ -37,8 +37,8 @@ data Overlap t = Overlap
}
data OverlapF = OverlapF
{ overlapF1 :: [String]
, overlapF2 :: [String]
{ _overlapF1 :: [String]
, _overlapF2 :: [String]
}
overlaps :: [Piece t] -> [Piece t] -> Bool -> Bool -> Bool

4
yesod-core/Yesod/Routes/TH/Dispatch.hs
View File

@ -118,8 +118,8 @@ mkDispatchClause MkDispatchSettings {..} resources = do
[]
where
handleDispatch :: Dispatch a -> [Exp] -> Q (Exp, Pat)
handleDispatch dispatch dyns =
case dispatch of
handleDispatch dispatch' dyns =
case dispatch' of
Methods multi methods -> do
(finalPat, mfinalE) <-
case multi of

2
yesod-core/yesod-core.cabal
View File

@ -50,7 +50,7 @@ library
, directory >= 1
, vector >= 0.9 && < 0.11
, aeson >= 0.5
, fast-logger >= 2.1
, fast-logger >= 2.2
, wai-logger >= 0.2
, monad-logger >= 0.3.1 && < 0.4
, conduit >= 1.2