diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +# 1.0.4 + +* bump acid-state to 0.16 diff --git a/serversession-backend-acid-state.cabal b/serversession-backend-acid-state.cabal --- a/serversession-backend-acid-state.cabal +++ b/serversession-backend-acid-state.cabal @@ -1,23 +1,29 @@ +cabal-version: >= 1.10 name: serversession-backend-acid-state -version: 1.0.3 +version: 1.0.4 license: MIT license-file: LICENSE author: Felipe Lessa -maintainer: Felipe Lessa +maintainer: Michael Xavier synopsis: Storage backend for serversession using acid-state. category: Web stability: Stable -cabal-version: >= 1.8 build-type: Simple homepage: https://github.com/yesodweb/serversession description: API docs and the README are available at extra-source-files: README.md + changelog.md +flag lib-Werror + default: False + manual: True + library + default-language: Haskell2010 hs-source-dirs: src build-depends: base == 4.* - , acid-state >= 0.12 + , acid-state >= 0.16 , containers , mtl , safecopy >= 0.8 @@ -27,7 +33,7 @@ exposed-modules: Web.ServerSession.Backend.Acid Web.ServerSession.Backend.Acid.Internal - extensions: + default-extensions: ConstraintKinds DeriveDataTypeable FlexibleContexts @@ -35,9 +41,14 @@ TypeFamilies UndecidableInstances ghc-options: -Wall + if flag(lib-Werror) + ghc-options: -Werror + if impl(ghc >= 8.0.0) + ghc-options: -Wno-redundant-constraints test-suite tests + default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests build-depends: @@ -48,9 +59,11 @@ , serversession , serversession-backend-acid-state main-is: Main.hs - extensions: + default-extensions: CPP ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts + if flag(lib-Werror) + ghc-options: -Werror source-repository head diff --git a/src/Web/ServerSession/Backend/Acid/Internal.hs b/src/Web/ServerSession/Backend/Acid/Internal.hs --- a/src/Web/ServerSession/Backend/Acid/Internal.hs +++ b/src/Web/ServerSession/Backend/Acid/Internal.hs @@ -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 @@ , 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,19 +104,19 @@ -- @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 -- otherwise we'd require an unneeded @SafeCopy sess@. -instance SafeCopy (SS.SessionId sess) where +instance Typeable sess => SafeCopy (SS.SessionId sess) where putCopy = contain . safePut . SSI.unS getCopy = contain $ SSI.S <$> safeGet -- | We can't @deriveSafeCopy 0 'base ''SS.Session@ due to the -- required context. -instance SafeCopy (SS.Decomposed sess) => SafeCopy (SS.Session sess) where +instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (SS.Session sess) where putCopy (SS.Session key authId data_ createdAt accessedAt) = contain $ do put_t <- getSafePut safePut key @@ -135,7 +136,7 @@ -- | We can't @deriveSafeCopy 0 'base ''ServerSessionAcidState@ due -- to the required context. -instance SafeCopy (SS.Decomposed sess) => SafeCopy (ServerSessionAcidState sess) where +instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (ServerSessionAcidState sess) where putCopy (ServerSessionAcidState sits aits) = contain $ do safePut (HM.toList sits) safePut (HM.toList aits) @@ -272,23 +273,23 @@ data InsertSession sess = InsertSession (SS.Session sess) deriving (Typeable) data ReplaceSession sess = ReplaceSession (SS.Session sess) deriving (Typeable) -instance SafeCopy (GetSession sess) where +instance Typeable sess => SafeCopy (GetSession sess) where putCopy (GetSession v) = contain $ safePut v getCopy = contain $ GetSession <$> safeGet -instance SafeCopy (DeleteSession sess) where +instance Typeable sess => SafeCopy (DeleteSession sess) where putCopy (DeleteSession v) = contain $ safePut v getCopy = contain $ DeleteSession <$> safeGet -instance SafeCopy (DeleteAllSessionsOfAuthId sess) where +instance Typeable sess => SafeCopy (DeleteAllSessionsOfAuthId sess) where putCopy (DeleteAllSessionsOfAuthId v) = contain $ safePut v getCopy = contain $ DeleteAllSessionsOfAuthId <$> safeGet -instance SafeCopy (SS.Decomposed sess) => SafeCopy (InsertSession sess) where +instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (InsertSession sess) where putCopy (InsertSession v) = contain $ safePut v getCopy = contain $ InsertSession <$> safeGet -instance SafeCopy (SS.Decomposed sess) => SafeCopy (ReplaceSession sess) where +instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (ReplaceSession sess) where putCopy (ReplaceSession v) = contain $ safePut v getCopy = contain $ ReplaceSession <$> safeGet @@ -321,8 +322,8 @@ instance AcidContext sess => IsAcidic (ServerSessionAcidState sess) where acidEvents = - [ QueryEvent $ \(GetSession sid) -> getSession sid - , UpdateEvent $ \(DeleteSession sid) -> deleteSession sid - , UpdateEvent $ \(DeleteAllSessionsOfAuthId authId) -> deleteAllSessionsOfAuthId authId - , UpdateEvent $ \(InsertSession session) -> insertSession session - , UpdateEvent $ \(ReplaceSession session) -> replaceSession session ] + [ QueryEvent (\(GetSession sid) -> getSession sid) safeCopyMethodSerialiser + , UpdateEvent (\(DeleteSession sid) -> deleteSession sid) safeCopyMethodSerialiser + , UpdateEvent (\(DeleteAllSessionsOfAuthId authId) -> deleteAllSessionsOfAuthId authId) safeCopyMethodSerialiser + , UpdateEvent (\(InsertSession session) -> insertSession session) safeCopyMethodSerialiser + , UpdateEvent (\(ReplaceSession session) -> replaceSession session) safeCopyMethodSerialiser ] diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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 @@ (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" $