Wall-werror all the things

This commit is contained in:
Michael Xavier 2017-02-01 18:20:55 -08:00
parent 66bdc481bc
commit 6edd459223
20 changed files with 96 additions and 24 deletions

View File

@ -10,7 +10,6 @@ import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawEx
import Foundation as X
import Model as X
import Test.Hspec as X
import Text.Shakespeare.Text (st)
import Yesod.Default.Config2 (ignoreEnv, loadAppSettings)
import Yesod.Test as X

View File

@ -13,6 +13,10 @@ homepage: https://github.com/yesodweb/serversession
description: API docs and the README are available at <http://www.stackage.org/package/serversession-backend-acid-state>
extra-source-files: README.md
flag lib-Werror
default: False
manual: True
library
hs-source-dirs: src
build-depends:
@ -35,6 +39,8 @@ library
TypeFamilies
UndecidableInstances
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
test-suite tests
@ -51,6 +57,8 @@ test-suite tests
extensions:
CPP
ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts
if flag(lib-Werror)
ghc-options: -Werror
source-repository head

View File

@ -1,3 +1,4 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Internal module exposing the guts of the package. Use at
-- your own risk. No API stability guarantees apply.
module Web.ServerSession.Backend.Acid.Internal
@ -23,7 +24,7 @@ module Web.ServerSession.Backend.Acid.Internal
, AcidStorage(..)
) where
import Control.Applicative ((<$>), (<*>))
import Control.Applicative as A
import Control.Monad.Reader (ask)
import Control.Monad.State (get, modify, put)
import Data.Acid
@ -103,7 +104,7 @@ insertSessionForAuthId sid = maybe id (flip (HM.insertWith S.union) (S.singleton
-- @safeCopy@ doesn't contain instances for @HashMap@ as of now.
instance SafeCopy SS.SessionMap where
putCopy = contain . safePut . HM.toList . SS.unSessionMap
getCopy = contain $ SS.SessionMap . HM.fromList <$> safeGet
getCopy = contain $ SS.SessionMap . HM.fromList A.<$> safeGet
-- | We can't @deriveSafeCopy 0 'base ''SS.SessionId@ as

View File

@ -1,6 +1,6 @@
module Main (main) where
import Control.Applicative ((<$>))
import Control.Applicative as A
import Data.Acid.Local (openLocalState, createCheckpointAndClose)
import Data.Acid.Memory (openMemoryState)
import Test.Hspec
@ -15,7 +15,7 @@ main =
(AcidStorage <$> openLocalState emptyState)
(createCheckpointAndClose . acidState) $
\acidLocal -> hspec $ do
acidMem <- runIO $ AcidStorage <$> openMemoryState emptyState
acidMem <- runIO $ AcidStorage A.<$> openMemoryState emptyState
describe "AcidStorage on memory only" $
allStorageTests acidMem it runIO parallel shouldBe shouldReturn shouldThrow
describe "AcidStorage on local storage" $

View File

@ -13,6 +13,10 @@ homepage: https://github.com/yesodweb/serversession
description: API docs and the README are available at <http://www.stackage.org/package/serversession-backend-persistent>
extra-source-files: README.md
flag lib-Werror
default: False
manual: True
library
hs-source-dirs: src
build-depends:
@ -51,6 +55,9 @@ library
TypeFamilies
UndecidableInstances
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
test-suite tests
@ -76,6 +83,9 @@ test-suite tests
TemplateHaskell
main-is: Main.hs
ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts
if flag(lib-Werror)
ghc-options: -Werror
source-repository head

View File

@ -12,10 +12,10 @@ module Web.ServerSession.Backend.Persistent.Internal.Impl
, throwSS
) where
import Control.Applicative ((<$>), (<*>))
import Control.Applicative as A
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.Monoid (mempty)
import Data.Monoid as M
import Data.Proxy (Proxy(..))
import Data.Time (UTCTime)
import Data.Typeable (Typeable)
@ -94,7 +94,7 @@ instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (Pe
[]
[]
["Eq", "Ord", "Show", "Typeable"]
mempty
M.mempty
False
where
pfd :: P.EntityField (PersistentSession sess) typ -> P.FieldDef
@ -109,7 +109,7 @@ instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (Pe
fromPersistValues [a, b, c, d, e] =
PersistentSession
<$> err "key" (P.fromPersistValue a)
A.<$> err "key" (P.fromPersistValue a)
<*> err "authId" (P.fromPersistValue b)
<*> err "session" (P.fromPersistValue c)
<*> err "createdAt" (P.fromPersistValue d)

View File

@ -12,7 +12,7 @@ module Web.ServerSession.Backend.Persistent.Internal.Types
-- $orphanSessionMap
) where
import Control.Applicative ((<$>))
import Control.Applicative as A
import Control.Arrow (first)
import Control.Monad ((>=>), mzero)
import Data.ByteString (ByteString)
@ -103,7 +103,7 @@ instance PersistFieldSql SessionMap where
instance S.Serialize SessionMap where
put = S.put . map (first TE.encodeUtf8) . HM.toList . unSessionMap
get = SessionMap . HM.fromList . map (first TE.decodeUtf8) <$> S.get
get = SessionMap . HM.fromList . map (first TE.decodeUtf8) A.<$> S.get
instance A.FromJSON SessionMap where
parseJSON = fmap fixup . A.parseJSON

View File

@ -17,6 +17,10 @@ flag old-locale
description: Use time-1.4 and old-locale (GHC 7.8).
default: False
flag lib-Werror
default: False
manual: True
library
hs-source-dirs: src
build-depends:
@ -47,6 +51,9 @@ library
ScopedTypeVariables
TypeFamilies
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
test-suite tests
@ -62,6 +69,9 @@ test-suite tests
, serversession-backend-redis
main-is: Main.hs
ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts
if flag(lib-Werror)
ghc-options: -Werror
source-repository head

View File

@ -26,7 +26,7 @@ module Web.ServerSession.Backend.Redis.Internal
, throwRS
) where
import Control.Applicative ((<$), (<$>))
import Control.Applicative as A
import Control.Arrow (first)
import Control.Monad (void, when)
import Control.Monad.IO.Class (liftIO)
@ -230,7 +230,7 @@ batched f xs =
-- | Get the session for the given session ID.
getSessionImpl :: RedisSession sess => SessionId sess -> R.Redis (Maybe (Session sess))
getSessionImpl sid = parseSession sid <$> unwrap (R.hgetall $ rSessionKey sid)
getSessionImpl sid = parseSession sid A.<$> unwrap (R.hgetall $ rSessionKey sid)
-- | Delete the session with given session ID.

View File

@ -3,7 +3,6 @@ module Main (main) where
import Database.Redis (connect, defaultConnectInfo)
import Test.Hspec
import Web.ServerSession.Backend.Redis
import Web.ServerSession.Core
import Web.ServerSession.Core.StorageTests
main :: IO ()

View File

@ -13,6 +13,11 @@ homepage: https://github.com/yesodweb/serversession
description: API docs and the README are available at <http://www.stackage.org/package/serversession-frontend-snap>
extra-source-files: README.md
flag lib-Werror
default: False
manual: True
library
hs-source-dirs: src
build-depends:
@ -38,6 +43,9 @@ library
TypeFamilies
UndecidableInstances
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
source-repository head
type: git

View File

@ -12,7 +12,7 @@ module Web.ServerSession.Frontend.Snap.Internal
, forceInvalidate
) where
import Control.Applicative ((<$>))
import Control.Applicative as A
import Control.Arrow (first, second)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
@ -137,7 +137,7 @@ instance ( Storage sto
mcookie <- S.getCookie (cookieName ssm)
-- Load session from storage backend.
(data1, saveSessionToken) <-
liftIO $ loadSession (state ssm) (S.cookieValue <$> mcookie)
liftIO $ loadSession (state ssm) (S.cookieValue A.<$> mcookie)
-- Add CSRF token if needed.
data2 <-
maybe

View File

@ -13,6 +13,10 @@ homepage: https://github.com/yesodweb/serversession
description: API docs and the README are available at <http://www.stackage.org/package/serversession-frontend-wai>
extra-source-files: README.md
flag lib-Werror
default: False
manual: True
library
hs-source-dirs: src
build-depends:
@ -38,6 +42,8 @@ library
OverloadedStrings
TypeFamilies
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
source-repository head
type: git

View File

@ -10,7 +10,7 @@ module Web.ServerSession.Frontend.Wai.Internal
, forceInvalidate
) where
import Control.Applicative ((<$>))
import Control.Applicative as A
import Control.Monad (guard)
import Control.Monad.IO.Class (MonadIO(..))
import Data.ByteString (ByteString)
@ -80,7 +80,7 @@ mkSession sessionRef =
-- We need to use atomicModifyIORef instead of readIORef
-- because latter may be reordered (cf. "Memory Model" on
-- Data.IORef's documentation).
( \k -> kvLookup k <$> liftIO (I.atomicModifyIORef' sessionRef $ \a -> (a, a))
( \k -> kvLookup k A.<$> liftIO (I.atomicModifyIORef' sessionRef $ \a -> (a, a))
, \k v -> liftIO (I.atomicModifyIORef' sessionRef $ flip (,) () . kvInsert k v)
)

View File

@ -13,6 +13,10 @@ homepage: https://github.com/yesodweb/serversession
description: API docs and the README are available at <http://www.stackage.org/package/serversession-frontend-yesod>
extra-source-files: README.md
flag lib-Werror
default: False
manual: True
library
hs-source-dirs: src
build-depends:
@ -38,6 +42,8 @@ library
OverloadedStrings
TypeFamilies
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
source-repository head
type: git

View File

@ -13,6 +13,10 @@ homepage: https://github.com/yesodweb/serversession
description: API docs and the README are available at <http://www.stackage.org/package/serversession>
extra-source-files: README.md
flag lib-Werror
default: False
manual: True
library
hs-source-dirs: src
build-depends:
@ -42,6 +46,9 @@ library
TypeFamilies
UndecidableInstances
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
test-suite tests
@ -66,6 +73,9 @@ test-suite tests
UndecidableInstances
main-is: Main.hs
ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts
if flag(lib-Werror)
ghc-options: -Werror
source-repository head

View File

@ -45,7 +45,7 @@ module Web.ServerSession.Core.Internal
, ForceInvalidate(..)
) where
import Control.Applicative ((<$>), (<*>))
import Control.Applicative as A
import Control.Monad (guard, when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.ByteString (ByteString)
@ -730,7 +730,7 @@ saveSessionOnDb state now maybeInput DecomposedSession {..} = do
(saveToDb, key, createdAt) <-
case maybeInput of
Nothing -> liftIO $
(,,) <$> return (insertSession $ storage state)
(,,) A.<$> return (insertSession $ storage state)
<*> generateSessionId (generator state)
<*> return now
Just Session {..} ->

View File

@ -7,7 +7,7 @@ module Web.ServerSession.Core.StorageTests
( allStorageTests
) where
import Control.Applicative ((<$), (<$>), (<*>))
import Control.Applicative as A
import Control.Exception (Exception)
import Control.Monad
import Web.ServerSession.Core.Internal
@ -95,7 +95,7 @@ allStorageTests storage it runIO parallel _shouldBe shouldReturn shouldThrow = d
master <- generateSession gen HasAuthId
let Just authId = sessionAuthId master
preslaves <-
(++) <$> replicateM 100 (generateSession gen HasAuthId)
(++) A.<$> replicateM 100 (generateSession gen HasAuthId)
<*> replicateM 100 (generateSession gen NoAuthId)
let slaves = (\s -> s { sessionAuthId = Just authId }) <$> preslaves
others <-

View File

@ -1,6 +1,6 @@
module Main (main) where
import Control.Applicative ((<$), (<$>), (<*>))
import Control.Applicative as A
import Control.Arrow
import Control.Monad
import Data.Maybe
@ -49,7 +49,7 @@ main = hspec $ parallel $ do
-- The probability of a given character not appearing on
-- this test is (63/64)^(24*reps), so it's extremely
-- unlikely for this test to fail on correct code.
let observed = S.fromList $ concat $ T.unpack . unS <$> sids
let observed = S.fromList $ concat $ T.unpack . unS A.<$> sids
expected = S.fromList $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "-_"
observed `shouldBe` expected

View File

@ -8,6 +8,21 @@ packages:
- serversession-frontend-wai
- serversession-frontend-yesod
- examples/serversession-example-yesod-persistent
flags:
serversession:
lib-Werror: true
serversession-backend-acid-state:
lib-Werror: true
serversession-backend-persistent:
lib-Werror: true
serversession-backend-redis:
lib-Werror: true
serversession-frontend-snap:
lib-Werror: true
serversession-frontend-wai:
lib-Werror: true
serversession-frontend-yesod:
lib-Werror: true
extra-deps:
- acid-state-0.14.0
- nonce-1.0.2