From 434f49266749cad6f074920fb61ad3ec6ef90bea Mon Sep 17 00:00:00 2001 From: Rebecca Turner Date: Thu, 1 Jun 2023 09:57:36 -0400 Subject: [PATCH 1/5] Import `Control.Monad` in `Spec` (#1487) mtl-2.3 removes these reexports --- persistent-qq/test/Spec.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/persistent-qq/test/Spec.hs b/persistent-qq/test/Spec.hs index 8f7c40ceb..315a15bf7 100644 --- a/persistent-qq/test/Spec.hs +++ b/persistent-qq/test/Spec.hs @@ -2,6 +2,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} +import Control.Monad (when) import Control.Monad.Logger (LoggingT, runLoggingT) import Control.Monad.Trans.Resource import Control.Monad.Reader From 52a0ef599612cb6688c47547af41694af9e3d27a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=CB=8Cbod=CA=B2=C9=AA=CB=88=C9=A1r=CA=B2im?= Date: Mon, 5 Jun 2023 18:55:28 +0100 Subject: [PATCH 2/5] Future-proof against potential Prelude.foldl' (#1501) --- persistent/Database/Persist/PersistValue.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/persistent/Database/Persist/PersistValue.hs b/persistent/Database/Persist/PersistValue.hs index 7f1fa4b6d..856d66b95 100644 --- a/persistent/Database/Persist/PersistValue.hs +++ b/persistent/Database/Persist/PersistValue.hs @@ -23,7 +23,7 @@ import Data.Bits (shiftL, shiftR) import Numeric (readHex, showHex) import qualified Data.Text as Text import Data.Text (Text) -import Data.ByteString (ByteString, foldl') +import Data.ByteString as BS (ByteString, foldl') import Data.Time (Day, TimeOfDay, UTCTime) import Web.PathPieces (PathPiece(..)) import qualified Data.Aeson as A @@ -235,7 +235,7 @@ instance A.ToJSON PersistValue where -- taken from crypto-api bs2i :: ByteString -> Integer - bs2i bs = foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 bs + bs2i bs = BS.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 bs {-# INLINE bs2i #-} -- showHex of n padded with leading zeros if necessary to fill d digits From 2a26141c6dd71b56e63a009fcacd5dddda0389dd Mon Sep 17 00:00:00 2001 From: Haisheng <109395773+hw202207@users.noreply.github.com> Date: Tue, 27 Jun 2023 15:29:38 -0700 Subject: [PATCH 3/5] Fixes name shadowing error at keyFromRecordM for Primary keys (#1496) * Fixes name shadowing error at keyFromRecordM for Primary keys * Address comments - use newName instead of mkName to create variable - got the idea from #1494 * Update changelog * Fixes the link in the change log --- persistent/ChangeLog.md | 5 +++++ persistent/Database/Persist/TH.hs | 17 ++++++++++------- .../Persist/TH/CompositeKeyStyleSpec.hs | 2 ++ 3 files changed, 17 insertions(+), 7 deletions(-) diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 9ad9967aa..6bf4b8ca4 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for persistent +## Unreleased + +* [#1496](https://github.com/yesodweb/persistent/pull/1496) + * Fixes name shadowing error at the generated `keyFromRecordM` function. + ## 2.14.5.0 * [#1469](https://github.com/yesodweb/persistent/pull/1469) diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs index a6ac5d7a0..189261d7b 100644 --- a/persistent/Database/Persist/TH.hs +++ b/persistent/Database/Persist/TH.hs @@ -141,6 +141,7 @@ import Database.Persist.ImplicitIdDef.Internal conp :: Name -> [Pat] -> Pat conp name pats = ConP name [] pats #else +conp :: Name -> [Pat] -> Pat conp = ConP #endif @@ -1994,18 +1995,20 @@ mkEntity embedEntityMap entityMap mps preDef = do [keyFromRecordM'] <- case unboundPrimarySpec entDef of NaturalKey ucd -> do - let - keyCon = - keyConName entDef - keyFields' = - fieldNameToRecordName mps entDef <$> unboundCompositeCols ucd + let keyFields' = fieldNameToRecordName mps entDef <$> unboundCompositeCols ucd + keyFieldNames' <- forM keyFields' $ \fieldName -> do + fieldVarName <- newName (nameBase fieldName) + return (fieldName, fieldVarName) + + let keyCon = keyConName entDef constr = foldl' AppE (ConE keyCon) - (VarE <$> keyFields') + (VarE . snd <$> keyFieldNames') keyFromRec = varP 'keyFromRecordM - lam = LamE [RecP name [(n, VarP n) | n <- toList keyFields']] constr + fieldPat = [(fieldName, VarP fieldVarName) | (fieldName, fieldVarName) <- toList keyFieldNames'] + lam = LamE [RecP name fieldPat ] constr [d| $(keyFromRec) = Just $(pure lam) |] diff --git a/persistent/test/Database/Persist/TH/CompositeKeyStyleSpec.hs b/persistent/test/Database/Persist/TH/CompositeKeyStyleSpec.hs index 2d6dfa8c3..b98ac1d7d 100644 --- a/persistent/test/Database/Persist/TH/CompositeKeyStyleSpec.hs +++ b/persistent/test/Database/Persist/TH/CompositeKeyStyleSpec.hs @@ -10,6 +10,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wname-shadowing -Werror=name-shadowing #-} + module Database.Persist.TH.CompositeKeyStyleSpec where import Data.Data (Data, constrFields, toConstr) From 892a9d5cebe6cf55763f524398032616aa563e90 Mon Sep 17 00:00:00 2001 From: Haisheng <109395773+hw202207@users.noreply.github.com> Date: Wed, 28 Jun 2023 11:53:39 -0700 Subject: [PATCH 4/5] Haisheng/tweak parser comment line (#1505) * Tweak the comment line parsing rule - In order to support `-- |` being an empty line * run through stylish-haskell * Update changelog * Update changelog - update PR number --- persistent/ChangeLog.md | 2 ++ persistent/Database/Persist/Quasi/Internal.hs | 4 ++-- persistent/test/Database/Persist/QuasiSpec.hs | 7 +++++++ 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 6bf4b8ca4..6af6798db 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -4,6 +4,8 @@ * [#1496](https://github.com/yesodweb/persistent/pull/1496) * Fixes name shadowing error at the generated `keyFromRecordM` function. +* [#1505](https://github.com/yesodweb/persistent/pull/1505) + * Fixes the comment line parsing rule so that accommodates paragraph breaks. ## 2.14.5.0 diff --git a/persistent/Database/Persist/Quasi/Internal.hs b/persistent/Database/Persist/Quasi/Internal.hs index 8f67e991b..aad9ec76f 100644 --- a/persistent/Database/Persist/Quasi/Internal.hs +++ b/persistent/Database/Persist/Quasi/Internal.hs @@ -53,8 +53,8 @@ module Database.Persist.Quasi.Internal import Prelude hiding (lines) import Control.Applicative (Alternative((<|>))) -import Data.Char (isDigit, isLower, isSpace, isUpper, toLower) import Control.Monad +import Data.Char (isDigit, isLower, isSpace, isUpper, toLower) import Data.List (find, foldl') import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL @@ -238,7 +238,7 @@ parseIndentationAmount txt = tokenize :: Text -> [Token] tokenize t | T.null t = [] - | Just txt <- T.stripPrefix "-- | " t = [DocComment txt] + | Just txt <- T.stripPrefix "-- |" t = [DocComment (T.stripStart txt)] | "--" `T.isPrefixOf` t = [] -- Comment until the end of the line. | "#" `T.isPrefixOf` t = [] -- Also comment to the end of the line, needed for a CPP bug (#110) | T.head t == '"' = quotes (T.tail t) id diff --git a/persistent/test/Database/Persist/QuasiSpec.hs b/persistent/test/Database/Persist/QuasiSpec.hs index a987d29a6..02356ee9f 100644 --- a/persistent/test/Database/Persist/QuasiSpec.hs +++ b/persistent/test/Database/Persist/QuasiSpec.hs @@ -236,6 +236,13 @@ spec = describe "Quasi" $ do [ DocComment "this is a comment" ] ) + it "recognizes empty line" $ do + parseLine "-- |" `shouldBe` + Just + ( Line 0 + [ DocComment "" + ] + ) it "works if comment is indented" $ do parseLine " -- | comment" `shouldBe` From 0bc89423a6c7452a6345a9a1e33e63c92d5d9d19 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 28 Jun 2023 12:54:15 -0600 Subject: [PATCH 5/5] persistent-2.14.5.1 --- persistent/ChangeLog.md | 2 +- persistent/persistent.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 6af6798db..2de90fae7 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -1,6 +1,6 @@ # Changelog for persistent -## Unreleased +## 2.14.5.1 * [#1496](https://github.com/yesodweb/persistent/pull/1496) * Fixes name shadowing error at the generated `keyFromRecordM` function. diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index cfe446ebf..857cd8b47 100644 --- a/persistent/persistent.cabal +++ b/persistent/persistent.cabal @@ -1,5 +1,5 @@ name: persistent -version: 2.14.5.0 +version: 2.14.5.1 license: MIT license-file: LICENSE author: Michael Snoyman