diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,2 +1,5 @@ +0.4.0 +* Updates to support newer GHC and persistent + 0.3.1 * Broaden deps diff --git a/snaplet-actionlog.cabal b/snaplet-actionlog.cabal --- a/snaplet-actionlog.cabal +++ b/snaplet-actionlog.cabal @@ -1,5 +1,5 @@ name: snaplet-actionlog -version: 0.3.1 +version: 0.4.0 synopsis: Generic action log snaplet for the Snap Framework description: This snaplet contains support for logging website actions. Common actions are creating, updating, and deleting records. @@ -8,7 +8,7 @@ author: Soostone Inc. Ozgun Ataman, Doug Beardsley maintainer: ozataman@gmail.com, mightybyte@gmail.com build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.10 homepage: https://github.com/soostone/snaplet-actionlog category: Web, Snap @@ -30,6 +30,7 @@ Library hs-source-dirs: src + default-language: Haskell2010 exposed-modules: Snap.Snaplet.ActionLog @@ -44,28 +45,27 @@ build-depends: base >= 4 && < 5, - blaze-builder >= 0.3 && < 0.5, - bytestring >= 0.9.1 && < 0.11, - digestive-functors >= 0.6 && < 0.9, - digestive-functors-heist >= 0.7 && < 0.9, - digestive-functors-snap >= 0.6 && < 0.8, - errors >= 2.0 && < 2.3, - heist >= 0.14 && < 1.1, + blaze-builder >= 0.3, + bytestring >= 0.9.1, + digestive-functors >= 0.6, + digestive-functors-heist >= 0.7, + digestive-functors-snap >= 0.6, + errors >= 2.0, + heist >= 0.14, lens < 5, map-syntax, - persistent >= 2.0 && < 2.8, - persistent-postgresql >= 2.0 && < 2.7, - persistent-template >= 2.0 && < 2.6, - readable >= 0.1 && < 0.4, - restful-snap >= 0.4 && < 0.5, - snap >= 0.11.3 && < 1.1, - snap-extras >= 0.11 && < 1.1, - snaplet-persistent >= 0.4 && < 0.7, - text >= 0.11 && < 1.3, - time >= 1.1 && < 1.9, - transformers >= 0.3 && < 0.6, - unordered-containers >= 0.2 && < 0.3, - xmlhtml >= 0.2 && < 0.3 + persistent >= 2.13, + persistent-postgresql >= 2.13, + readable >= 0.1, + restful-snap >= 0.4, + snap >= 0.11.3, + snap-extras >= 0.11, + snaplet-persistent >= 0.7.1, + text >= 0.11, + time >= 1.1, + transformers >= 0.3, + unordered-containers >= 0.2, + xmlhtml >= 0.2 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields diff --git a/src/Snap/Snaplet/ActionLog.hs b/src/Snap/Snaplet/ActionLog.hs --- a/src/Snap/Snaplet/ActionLog.hs +++ b/src/Snap/Snaplet/ActionLog.hs @@ -52,7 +52,7 @@ import Control.Lens import Control.Monad import qualified Data.Map.Syntax as MS -import Data.Monoid +import Data.Monoid as Monoid import Data.Text.Encoding import Heist import qualified Heist.Interpreted as I @@ -82,7 +82,7 @@ addResourceRelative resource [(RIndex, indexH), (RShow, showH)] [] [] heist - addConfig heist $ mempty + addConfig heist $ Monoid.mempty & scCompiledSplices .~ actionLogSplices resource & scInterpretedSplices .~ actionLogISplices resource -- Load time splices are for splices that can be used in the apply and diff --git a/src/Snap/Snaplet/ActionLog/API.hs b/src/Snap/Snaplet/ActionLog/API.hs --- a/src/Snap/Snaplet/ActionLog/API.hs +++ b/src/Snap/Snaplet/ActionLog/API.hs @@ -9,12 +9,12 @@ ------------------------------------------------------------------------------ import Control.Monad -import Data.Functor.Identity import Data.Text (Text) import Data.Text.Encoding import Database.Persist import Database.Persist.Sql import Snap.Snaplet.Persistent +import Data.Proxy ------------------------------------------------------------------------------ import Snap.Snaplet.ActionLog.Types ------------------------------------------------------------------------------- @@ -173,10 +173,7 @@ -- | Get human name for a database table defined to be an 'Entity'. getName :: forall a. PersistEntity a => a -> Text -getName val = unHaskellName $ entityHaskell ed - where - ed = entityDef val' - val' = return val :: Identity a +getName _ = unEntityNameHS $ getEntityHaskellName $ entityDef $ (Proxy :: Proxy a) ------------------------------------------------------------------------------ diff --git a/src/Snap/Snaplet/ActionLog/Internal/Schema.hs b/src/Snap/Snaplet/ActionLog/Internal/Schema.hs --- a/src/Snap/Snaplet/ActionLog/Internal/Schema.hs +++ b/src/Snap/Snaplet/ActionLog/Internal/Schema.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -12,6 +17,7 @@ import Data.Time import Database.Persist import Database.Persist.Quasi +import Database.Persist.Quasi.Internal import Database.Persist.TH ------------------------------------------------------------------------------- import Snap.Snaplet.ActionLog.InternalTypes @@ -30,7 +36,7 @@ -- > share [mkMigrate "migrateAll"] $ -- > actionLogEntityDefs ++ -- > $(persistFileWith lowerCaseSettings "schema.txt") -actionLogEntityDefs :: [EntityDef] +actionLogEntityDefs :: [UnboundEntityDef] actionLogEntityDefs = $(persistFileWith lowerCaseSettings "schema.txt") diff --git a/src/Snap/Snaplet/ActionLog/Resource.hs b/src/Snap/Snaplet/ActionLog/Resource.hs --- a/src/Snap/Snaplet/ActionLog/Resource.hs +++ b/src/Snap/Snaplet/ActionLog/Resource.hs @@ -21,8 +21,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.Map.Syntax as MS -import Data.Monoid +import Data.Monoid as Monoid import qualified Data.Readable as R +import Data.Semigroup as Semigroup import Data.Text (Text) import qualified Data.Text as T import Database.Persist @@ -79,13 +80,18 @@ } deriving (Show) -instance Monoid LogFilter where +instance Semigroup LogFilter where + (LogFilter u1 e1 i1 a1) <> (LogFilter u2 e2 i2 a2) = + LogFilter + (Semigroup.getFirst $ (Semigroup.First u1) Semigroup.<> (Semigroup.First u2)) + (Semigroup.getFirst $ (Semigroup.First e1) Semigroup.<> (Semigroup.First e2)) + (Semigroup.getFirst $ (Semigroup.First i1) Semigroup.<> (Semigroup.First i2)) + (Semigroup.getFirst $ (Semigroup.First a1) Semigroup.<> (Semigroup.First a2)) + + +instance Monoid.Monoid LogFilter where mempty = LogFilter Nothing Nothing Nothing Nothing - mappend (LogFilter u1 e1 i1 a1) (LogFilter u2 e2 i2 a2) = - LogFilter (getFirst $ mappend (First u1) (First u2)) - (getFirst $ mappend (First e1) (First e2)) - (getFirst $ mappend (First i1) (First i2)) - (getFirst $ mappend (First a1) (First a2)) + mappend = (Semigroup.<>) mkFilters :: LogFilter -> [Filter LoggedAction] @@ -387,5 +393,3 @@ n <- getParamNode let f = filterCommon $ X.elementAttrs n I.runChildrenWith $ coupledISplices r True f - -