From 42eea68fb643a3c1eff61aa7c78f68e540a03150 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 30 Mar 2021 21:30:36 +0300 Subject: [PATCH 01/35] Support persistent 2.12 --- .github/workflows/tests.yml | 3 +++ stack-persistent-212.yaml | 20 ++++++++++++++++++++ yesod-auth/ChangeLog.md | 4 ++++ yesod-auth/yesod-auth.cabal | 4 ++-- yesod-persistent/ChangeLog.md | 4 ++++ yesod-persistent/Yesod/Persist/Core.hs | 4 ++++ yesod-persistent/yesod-persistent.cabal | 6 +++--- 7 files changed, 40 insertions(+), 5 deletions(-) create mode 100644 stack-persistent-212.yaml diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml index 1bf32d17..2265e9ec 100644 --- a/.github/workflows/tests.yml +++ b/.github/workflows/tests.yml @@ -21,6 +21,7 @@ jobs: - "--resolver lts-12" - "--resolver lts-11" - "--stack-yaml stack-persistent-211.yaml" + - "--stack-yaml stack-persistent-212.yaml" # Bugs in GHC make it crash too often to be worth running exclude: - os: windows-latest @@ -29,6 +30,8 @@ jobs: args: "--resolver lts-16" - os: windows-latest args: "--stack-yaml stack-persistent-211.yaml" + - os: windows-latest + args: "--stack-yaml stack-persistent-212.yaml" steps: - name: Clone project diff --git a/stack-persistent-212.yaml b/stack-persistent-212.yaml new file mode 100644 index 00000000..b4087765 --- /dev/null +++ b/stack-persistent-212.yaml @@ -0,0 +1,20 @@ +resolver: nightly-2021-03-31 +packages: +- ./yesod-core +- ./yesod-static +- ./yesod-persistent +- ./yesod-newsfeed +- ./yesod-form +- ./yesod-form-multi +- ./yesod-auth +- ./yesod-auth-oauth +- ./yesod-sitemap +- ./yesod-test +- ./yesod-bin +- ./yesod +- ./yesod-eventsource +- ./yesod-websockets +extra-deps: +- persistent-2.12.0.1 +- persistent-template-2.12.0.0 +- persistent-sqlite-2.12.0.0 diff --git a/yesod-auth/ChangeLog.md b/yesod-auth/ChangeLog.md index fb9d5391..90f7d647 100644 --- a/yesod-auth/ChangeLog.md +++ b/yesod-auth/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-auth +## 1.6.10.2 + +* Relax bounds for persistent 2.12 + ## 1.6.10.1 * Add support for Persistent 2.11 [#1701](https://github.com/yesodweb/yesod/pull/1701) diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 21d24b18..b6be336c 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: yesod-auth -version: 1.6.10.1 +version: 1.6.10.2 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin @@ -44,7 +44,7 @@ library , http-types , memory , nonce >= 1.0.2 && < 1.1 - , persistent >= 2.8 && < 2.12 + , persistent >= 2.8 , random >= 1.0.0.2 , safe , shakespeare diff --git a/yesod-persistent/ChangeLog.md b/yesod-persistent/ChangeLog.md index 1aaa6c63..4a4b5dd7 100644 --- a/yesod-persistent/ChangeLog.md +++ b/yesod-persistent/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-persistent +## 1.6.0.2 + +* Add support for persistent 2.12 + ## 1.6.0.5 * Add support for Persistent 2.11 [#1701](https://github.com/yesodweb/yesod/pull/1701) diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs index 2e450366..b7c82baf 100644 --- a/yesod-persistent/Yesod/Persist/Core.hs +++ b/yesod-persistent/Yesod/Persist/Core.hs @@ -196,7 +196,11 @@ insert400 datum = do conflict <- checkUnique datum case conflict of Just unique -> +#if MIN_VERSION_persistent(2, 12, 0) + badRequest' $ map (unFieldNameHS . fst) $ persistUniqueToFieldNames unique +#else badRequest' $ map (unHaskellName . fst) $ persistUniqueToFieldNames unique +#endif Nothing -> insert datum -- | Same as 'insert400', but doesn’t return a key. diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal index fb50543d..5bd21f5c 100644 --- a/yesod-persistent/yesod-persistent.cabal +++ b/yesod-persistent/yesod-persistent.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: yesod-persistent -version: 1.6.0.5 +version: 1.6.0.6 license: MIT license-file: LICENSE author: Michael Snoyman @@ -17,8 +17,8 @@ library default-language: Haskell2010 build-depends: base >= 4.10 && < 5 , yesod-core >= 1.6 && < 1.7 - , persistent >= 2.8 && < 2.12 - , persistent-template >= 2.1 && < 2.10 + , persistent >= 2.8 + , persistent-template >= 2.1 , transformers >= 0.2.2 , blaze-builder , conduit From b97d8d60b393d40094a8d00969da6382224018c7 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 30 Mar 2021 22:13:53 +0300 Subject: [PATCH 02/35] Fix changelog --- yesod-persistent/ChangeLog.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-persistent/ChangeLog.md b/yesod-persistent/ChangeLog.md index 4a4b5dd7..a8c8dad1 100644 --- a/yesod-persistent/ChangeLog.md +++ b/yesod-persistent/ChangeLog.md @@ -1,6 +1,6 @@ # ChangeLog for yesod-persistent -## 1.6.0.2 +## 1.6.0.6 * Add support for persistent 2.12 From c59993ff287b880abbf768f1e3f56ae9b19df51e Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sat, 3 Apr 2021 22:37:00 +0300 Subject: [PATCH 03/35] Change cabal-version syntax --- yesod-websockets/yesod-websockets.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal index 04b9bbf8..8294bbbc 100644 --- a/yesod-websockets/yesod-websockets.cabal +++ b/yesod-websockets/yesod-websockets.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.10 +cabal-version: >=1.10 name: yesod-websockets version: 0.3.0.3 synopsis: WebSockets support for Yesod From dc2d5d9cd0d34dd9318726c7534d683813410fc5 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Thu, 8 Apr 2021 09:34:38 -0400 Subject: [PATCH 04/35] Stop moving session language ahead of reqLangs Yesod.Core.Handler.languages checks first for a language set in the user's session, prepending that value to YesodRequest{reqLangs}, so it is respected above all else if present. For context, reqLangs itself also includes the session, but just later in line: langs' = catMaybes [ lookup langKey gets -- Query _LANG , lookup langKey cookies -- Cookie _LANG , lookupText langKey session -- Session _LANG ] ++ langs -- Accept-Language(s) In #1720, it was raised that allowing the session (something implicitly present for any request) to override a query parameter (something explicitly given on that request) is surprising. We decided (without knowing what order reqLangs was doing) that query, cookie, session, accept was best and languages should be changed to do that. Conveniently, this just makes languages equivalent to reqLangs, so that is what this patch does. --- yesod-core/src/Yesod/Core/Handler.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/yesod-core/src/Yesod/Core/Handler.hs b/yesod-core/src/Yesod/Core/Handler.hs index 063ad1f9..67b9b53d 100644 --- a/yesod-core/src/Yesod/Core/Handler.hs +++ b/yesod-core/src/Yesod/Core/Handler.hs @@ -1226,10 +1226,10 @@ cacheBySet key value = do -- Languages are determined based on the following (in descending order -- of preference): -- --- * The _LANG user session variable. --- -- * The _LANG get parameter. -- +-- * The _LANG user session variable. +-- -- * The _LANG cookie. -- -- * Accept-Language HTTP header. @@ -1239,10 +1239,7 @@ cacheBySet key value = do -- -- This is handled by parseWaiRequest (not exposed). languages :: MonadHandler m => m [Text] -languages = do - mlang <- lookupSession langKey - langs <- reqLangs <$> getRequest - return $ maybe id (:) mlang langs +languages = reqLangs <$> getRequest lookup' :: Eq a => a -> [(a, b)] -> [b] lookup' a = map snd . filter (\x -> a == fst x) From 7875930c430aeb70de76dd6490709bdded6928b1 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Thu, 8 Apr 2021 09:53:58 -0400 Subject: [PATCH 05/35] Version bump --- yesod-core/ChangeLog.md | 4 ++++ yesod-core/src/Yesod/Core/Handler.hs | 4 ++++ yesod-core/yesod-core.cabal | 2 +- 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 80eac463..eaf1f87a 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-core +## 1.6.18.9 + +* Change order of priority in `languages`[#1721](https://github.com/yesodweb/yesod/pull/1721) + ## 1.6.18.8 * Fix test suite for wai-extra change around vary header diff --git a/yesod-core/src/Yesod/Core/Handler.hs b/yesod-core/src/Yesod/Core/Handler.hs index 67b9b53d..119b4d64 100644 --- a/yesod-core/src/Yesod/Core/Handler.hs +++ b/yesod-core/src/Yesod/Core/Handler.hs @@ -1238,6 +1238,10 @@ cacheBySet key value = do -- If a matching language is not found the default language will be used. -- -- This is handled by parseWaiRequest (not exposed). +-- +-- __NOTE__: Before version @1.6.18.9@, this function prioritized the session +-- variable above all other sources. +-- languages :: MonadHandler m => m [Text] languages = reqLangs <$> getRequest diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 685b95e5..6e799418 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.18.8 +version: 1.6.18.9 license: MIT license-file: LICENSE author: Michael Snoyman From 0c2a4ebc817a05790dc42ef5338d20bbbd7dbbf4 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Thu, 8 Apr 2021 10:07:18 -0400 Subject: [PATCH 06/35] Bump minor, not patch --- yesod-core/ChangeLog.md | 2 +- yesod-core/src/Yesod/Core/Handler.hs | 2 +- yesod-core/yesod-core.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index eaf1f87a..70041a9f 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,6 +1,6 @@ # ChangeLog for yesod-core -## 1.6.18.9 +## 1.6.19.0 * Change order of priority in `languages`[#1721](https://github.com/yesodweb/yesod/pull/1721) diff --git a/yesod-core/src/Yesod/Core/Handler.hs b/yesod-core/src/Yesod/Core/Handler.hs index 119b4d64..d6ad08da 100644 --- a/yesod-core/src/Yesod/Core/Handler.hs +++ b/yesod-core/src/Yesod/Core/Handler.hs @@ -1239,7 +1239,7 @@ cacheBySet key value = do -- -- This is handled by parseWaiRequest (not exposed). -- --- __NOTE__: Before version @1.6.18.9@, this function prioritized the session +-- __NOTE__: Before version @1.6.19.0@, this function prioritized the session -- variable above all other sources. -- languages :: MonadHandler m => m [Text] diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 6e799418..41a228b4 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.18.9 +version: 1.6.19.0 license: MIT license-file: LICENSE author: Michael Snoyman From daf977fdb189da04811b234d753de9bd3085c6eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Sat, 10 Apr 2021 11:42:04 +0200 Subject: [PATCH 07/35] Use standard function forM_ --- yesod-form/Yesod/Form/Fields.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index ab27544f..bf04b9c8 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -80,7 +80,7 @@ import Database.Persist (Entity (..), SqlType (SqlString), PersistRecordBackend, import Database.Persist (Entity (..), SqlType (SqlString), PersistEntity, PersistQuery, PersistEntityBackend) #endif import Text.HTML.SanitizeXSS (sanitizeBalance) -import Control.Monad (when, unless) +import Control.Monad (when, unless, forM_) import Data.Either (partitionEithers) import Data.Maybe (listToMaybe, fromMaybe) @@ -749,7 +749,7 @@ selectFieldHelper outside onOpt inside opts' = Field opts <- fmap olOptions $ handlerToWidget opts' outside theId name attrs $ do unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts - flip mapM_ opts $ \opt -> inside + forM_ opts $ \opt -> inside theId name ((if isReq then (("required", "required"):) else id) attrs) From 993de7fa86c724a27b822712353170101fd2a471 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Sat, 10 Apr 2021 11:42:43 +0200 Subject: [PATCH 08/35] Add selectFieldGrouped --- yesod-form/Yesod/Form/Fields.hs | 90 ++++++++++++++++++++++++++++----- 1 file changed, 76 insertions(+), 14 deletions(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index bf04b9c8..47463201 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -45,6 +45,7 @@ module Yesod.Form.Fields , selectFieldHelper , selectField , selectFieldList + , selectFieldListGrouped , radioField , radioFieldList , checkboxesField @@ -54,6 +55,7 @@ module Yesod.Form.Fields , Option (..) , OptionList (..) , mkOptionList + , mkOptionListGrouped , optionsPersist , optionsPersistKey , optionsPairs @@ -427,7 +429,13 @@ selectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg -> Field (HandlerFor site) a selectFieldList = selectField . optionsPairs --- | Creates a @\@ tag with @\@s for selecting one option. +selectFieldListGrouped :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) + => [(msg, [(msg, a)])] + -> Field (HandlerFor site) a +selectFieldListGrouped = selectField . optionsPairsGrouped + +-- | Creates a @\@ tag for selecting multiple options. multiSelectFieldList :: (Eq a, RenderMessage site msg) @@ -531,6 +542,7 @@ $newline never \#{text} |]) + Nothing -- | Creates a group of radio buttons to answer the question given in the message. Radio buttons are used to allow differentiating between an empty response (@Nothing@) and a no response (@Just False@). Consider using the simpler 'checkBoxField' if you don't need to make this distinction. -- @@ -598,10 +610,20 @@ $newline never showVal = either (\_ -> False) -- | A structure holding a list of options. Typically you can use a convenience function like 'mkOptionList' or 'optionsPairs' instead of creating this directly. -data OptionList a = OptionList +data OptionList a + = OptionList { olOptions :: [Option a] , olReadExternal :: Text -> Maybe a -- ^ A function mapping from the form's value ('optionExternalValue') to the selected Haskell value ('optionInternalValue'). } + | OptionListGrouped + { olOptionsGrouped :: [(Text, [Option a])] + , olReadExternalGrouped :: Text -> Maybe a -- ^ A function mapping from the form's value ('optionExternalValue') to the selected Haskell value ('optionInternalValue'). + } + +-- | Convert grouped 'OptionList' to a normal one. +flattenOptionList :: OptionList a -> OptionList a +flattenOptionList (OptionListGrouped os re) = OptionList (concatMap snd os) re +flattenOptionList ol = ol -- | Since 1.4.6 instance Functor OptionList where @@ -615,6 +637,13 @@ mkOptionList os = OptionList , olReadExternal = flip Map.lookup $ Map.fromList $ map (optionExternalValue &&& optionInternalValue) os } +-- | Creates an 'OptionList', using a 'Map' to implement the 'olReadExternalGrouped' function. +mkOptionListGrouped :: [(Text, [Option a])] -> OptionList a +mkOptionListGrouped os = OptionListGrouped + { olOptionsGrouped = os + , olReadExternalGrouped = flip Map.lookup $ Map.fromList $ map (optionExternalValue &&& optionInternalValue) $ concatMap snd os + } + data Option a = Option { optionDisplay :: Text -- ^ The user-facing label. , optionInternalValue :: a -- ^ The Haskell value being selected. @@ -637,6 +666,28 @@ optionsPairs opts = do } return $ mkOptionList (zipWith mkOption [1 :: Int ..] opts) +-- | Creates an 'OptionList' from a list of (display-value, internal value) pairs. +optionsPairsGrouped + :: (MonadHandler m, RenderMessage (HandlerSite m) msg) + => [(msg, [(msg, a)])] -> m (OptionList a) +optionsPairsGrouped opts = do + mr <- getMessageRender + let mkOption (external, (display, internal)) = + Option { optionDisplay = mr display + , optionInternalValue = internal + , optionExternalValue = pack $ show external + } + opts' = enumerateSublists opts -- :: [(grp, [(Int, (msg, a))])] + opts'' = map (\(x, ys) -> (mr x, map mkOption ys)) opts' + return $ mkOptionListGrouped opts'' + +-- | Helper to enumerate sublists with one consecutive index. +enumerateSublists :: [(a, [b])] -> [(a, [(Int, b)])] +enumerateSublists xss = + let --yss :: [(Int, (a, [b]))] + yss = snd $ foldl (\(i, res) xs -> (i + (length.snd) xs, res ++ [(i, xs)])) (1, []) xss + in map (\(i, (x, ys)) -> (x, zip [i :: Int ..] ys)) yss + -- | Creates an 'OptionList' from an 'Enum', using its 'Show' instance for the user-facing value. optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a) optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound] @@ -731,7 +782,7 @@ optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do }) pairs -- | --- A helper function for constucting 'selectField's. You may want to use this when you define your custom 'selectField's or 'radioField's. +-- A helper function for constucting 'selectField's with optional option groups. You may want to use this when you define your custom 'selectField's or 'radioField's. -- -- @since 1.6.2 selectFieldHelper @@ -739,23 +790,26 @@ selectFieldHelper => (Text -> Text -> [(Text, Text)] -> WidgetFor site () -> WidgetFor site ()) -- ^ Outermost part of the field -> (Text -> Text -> Bool -> WidgetFor site ()) -- ^ An option for None if the field is optional -> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> WidgetFor site ()) -- ^ Other options + -> (Maybe (Text -> WidgetFor site ())) -- ^ Group headers placed inbetween options -> HandlerFor site (OptionList a) -> Field (HandlerFor site) a -selectFieldHelper outside onOpt inside opts' = Field +selectFieldHelper outside onOpt inside grpHdr opts' = Field { fieldParse = \x _ -> do - opts <- opts' + opts <- fmap flattenOptionList opts' return $ selectParser opts x , fieldView = \theId name attrs val isReq -> do - opts <- fmap olOptions $ handlerToWidget opts' outside theId name attrs $ do - unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts - forM_ opts $ \opt -> inside - theId - name - ((if isReq then (("required", "required"):) else id) attrs) - (optionExternalValue opt) - ((render opts val) == optionExternalValue opt) - (optionDisplay opt) + optsFlat <- fmap (olOptions.flattenOptionList) $ handlerToWidget opts' + unless isReq $ onOpt theId name $ not $ render optsFlat val `elem` map optionExternalValue optsFlat + opts'' <- handlerToWidget opts' + case opts'' of + (OptionList{}) -> constructOptions theId name attrs val isReq optsFlat + (OptionListGrouped{olOptionsGrouped=grps}) -> do + forM_ grps $ \(grp, opts) -> do + case grpHdr of + Just hdr -> hdr grp + Nothing -> return () + constructOptions theId name attrs val isReq opts , fieldEnctype = UrlEncoded } where @@ -768,6 +822,14 @@ selectFieldHelper outside onOpt inside opts' = Field x -> case olReadExternal opts x of Nothing -> Left $ SomeMessage $ MsgInvalidEntry x Just y -> Right $ Just y + constructOptions theId name attrs val isReq opts = + forM_ opts $ \opt -> inside + theId + name + ((if isReq then (("required", "required"):) else id) attrs) + (optionExternalValue opt) + ((render opts val) == optionExternalValue opt) + (optionDisplay opt) -- | Creates an input with @type="file"@. fileField :: Monad m From 829b5af62c7f83b3af7ba9c52c05b0681fda3236 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Tue, 13 Apr 2021 21:58:33 +0200 Subject: [PATCH 09/35] Fix implementation of instance Functor OptionList --- yesod-form/Yesod/Form/Fields.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 47463201..91fb487c 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -627,8 +627,10 @@ flattenOptionList ol = ol -- | Since 1.4.6 instance Functor OptionList where - fmap f (OptionList options readExternal) = + fmap f (OptionList options readExternal) = OptionList ((fmap.fmap) f options) (fmap f . readExternal) + fmap f (OptionListGrouped options readExternal) = + OptionListGrouped (map (\(g, os) -> (g, (fmap.fmap) f os)) options) (fmap f . readExternal) -- | Creates an 'OptionList', using a 'Map' to implement the 'olReadExternal' function. mkOptionList :: [Option a] -> OptionList a From 2998849e9919b7d031de236e87d3a052abf2a225 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Tue, 13 Apr 2021 22:16:29 +0200 Subject: [PATCH 10/35] Fix comments --- yesod-form/Yesod/Form/Fields.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 91fb487c..0f957054 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -679,14 +679,14 @@ optionsPairsGrouped opts = do , optionInternalValue = internal , optionExternalValue = pack $ show external } - opts' = enumerateSublists opts -- :: [(grp, [(Int, (msg, a))])] + opts' = enumerateSublists opts -- :: [(msg, [(Int, (msg, a))])] opts'' = map (\(x, ys) -> (mr x, map mkOption ys)) opts' return $ mkOptionListGrouped opts'' -- | Helper to enumerate sublists with one consecutive index. enumerateSublists :: [(a, [b])] -> [(a, [(Int, b)])] enumerateSublists xss = - let --yss :: [(Int, (a, [b]))] + let -- yss :: [(Int, (a, [b]))] yss = snd $ foldl (\(i, res) xs -> (i + (length.snd) xs, res ++ [(i, xs)])) (1, []) xss in map (\(i, (x, ys)) -> (x, zip [i :: Int ..] ys)) yss From c6f44d47b97356003b8fdd1efe15a37dd843ff67 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Tue, 13 Apr 2021 22:22:26 +0200 Subject: [PATCH 11/35] Also export this helper --- yesod-form/Yesod/Form/Fields.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 0f957054..4688eccb 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -59,6 +59,7 @@ module Yesod.Form.Fields , optionsPersist , optionsPersistKey , optionsPairs + , optionsPairsGrouped , optionsEnum ) where From 848da5ff12b9dfc739aa598b2f5bfd1765bddfe3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 09:39:13 +0200 Subject: [PATCH 12/35] Bump version and fix old version comments --- yesod-form/ChangeLog.md | 4 ++++ yesod-form/Yesod/Form/Fields.hs | 22 ++++++++++++++++------ yesod-form/yesod-form.cabal | 2 +- 3 files changed, 21 insertions(+), 7 deletions(-) diff --git a/yesod-form/ChangeLog.md b/yesod-form/ChangeLog.md index c38a49dc..5d37f2f8 100644 --- a/yesod-form/ChangeLog.md +++ b/yesod-form/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-form +## 1.7.0 + +* Extended `OptionList` by `OptionListGrouped` and implemented grouped select fields (`@ tag with @\@s for selecting one option. +-- +-- @since 1.7.0 selectFieldListGrouped :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, [(msg, a)])] -> Field (HandlerFor site) a @@ -611,6 +613,8 @@ $newline never showVal = either (\_ -> False) -- | A structure holding a list of options. Typically you can use a convenience function like 'mkOptionList' or 'optionsPairs' instead of creating this directly. +-- +-- Extended by 'OptionListGrouped' in 1.7.0. data OptionList a = OptionList { olOptions :: [Option a] @@ -622,11 +626,13 @@ data OptionList a } -- | Convert grouped 'OptionList' to a normal one. +-- +-- @since 1.7.0 flattenOptionList :: OptionList a -> OptionList a flattenOptionList (OptionListGrouped os re) = OptionList (concatMap snd os) re flattenOptionList ol = ol --- | Since 1.4.6 +-- | @since 1.4.6 instance Functor OptionList where fmap f (OptionList options readExternal) = OptionList ((fmap.fmap) f options) (fmap f . readExternal) @@ -641,6 +647,8 @@ mkOptionList os = OptionList } -- | Creates an 'OptionList', using a 'Map' to implement the 'olReadExternalGrouped' function. +-- +-- @since 1.7.0 mkOptionListGrouped :: [(Text, [Option a])] -> OptionList a mkOptionListGrouped os = OptionListGrouped { olOptionsGrouped = os @@ -653,7 +661,7 @@ data Option a = Option , optionExternalValue :: Text -- ^ The representation of this value stored in the form. } --- | Since 1.4.6 +-- | @since 1.4.6 instance Functor Option where fmap f (Option display internal external) = Option display (f internal) external @@ -670,6 +678,8 @@ optionsPairs opts = do return $ mkOptionList (zipWith mkOption [1 :: Int ..] opts) -- | Creates an 'OptionList' from a list of (display-value, internal value) pairs. +-- +-- @since 1.7.0 optionsPairsGrouped :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => [(msg, [(msg, a)])] -> m (OptionList a) @@ -746,7 +756,7 @@ optionsPersist filts ords toDisplay = fmap mkOptionList $ do -- | An alternative to 'optionsPersist' which returns just the 'Key' instead of -- the entire 'Entity'. -- --- Since 1.3.2 +-- @since 1.3.2 #if MIN_VERSION_persistent(2,5,0) optionsPersistKey :: (YesodPersist site diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index c66cd7b0..1fb100b1 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.6.7 +version: 1.7.0 license: MIT license-file: LICENSE author: Michael Snoyman From e3a95bd92cc932fe9d4258c94a290402a6ef681b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 09:40:21 +0200 Subject: [PATCH 13/35] Simplify code, fix linter warnings --- yesod-form/README.md | 2 +- yesod-form/Yesod/Form/Fields.hs | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/yesod-form/README.md b/yesod-form/README.md index 097995c4..29bd5767 100644 --- a/yesod-form/README.md +++ b/yesod-form/README.md @@ -3,7 +3,7 @@ Form handling for Yesod, in the same style as formlets. See [the forms chapter](http://www.yesodweb.com/book/forms) of the Yesod book. -This package provies a set of basic form inputs such as text, number, time, +This package provides a set of basic form inputs such as text, number, time, checkbox, select, textarea, and etc. via `Yesod.Form.Fields` module. Also, there is `Yesod.Form.Nic` module providing richtext field using Nic editor. However, this module is grandfathered now and Nic editor is not actively diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index f242131b..5f7255d8 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -813,11 +813,11 @@ selectFieldHelper outside onOpt inside grpHdr opts' = Field , fieldView = \theId name attrs val isReq -> do outside theId name attrs $ do optsFlat <- fmap (olOptions.flattenOptionList) $ handlerToWidget opts' - unless isReq $ onOpt theId name $ not $ render optsFlat val `elem` map optionExternalValue optsFlat + unless isReq $ onOpt theId name $ render optsFlat val `notElem` map optionExternalValue optsFlat opts'' <- handlerToWidget opts' case opts'' of - (OptionList{}) -> constructOptions theId name attrs val isReq optsFlat - (OptionListGrouped{olOptionsGrouped=grps}) -> do + OptionList{} -> constructOptions theId name attrs val isReq optsFlat + OptionListGrouped{olOptionsGrouped=grps} -> do forM_ grps $ \(grp, opts) -> do case grpHdr of Just hdr -> hdr grp @@ -841,7 +841,7 @@ selectFieldHelper outside onOpt inside grpHdr opts' = Field name ((if isReq then (("required", "required"):) else id) attrs) (optionExternalValue opt) - ((render opts val) == optionExternalValue opt) + (render opts val == optionExternalValue opt) (optionDisplay opt) -- | Creates an input with @type="file"@. @@ -939,7 +939,7 @@ prependZero t0 = if T.null t1 then "-0." `T.append` (T.drop 2 t1) else t1 - where t1 = T.dropWhile ((==) ' ') t0 + where t1 = T.dropWhile (==' ') t0 -- $optionsOverview -- These functions create inputs where one or more options can be selected from a list. From 7ffff2532652ac9788647f04a5506a0bf2bd8896 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 09:40:34 +0200 Subject: [PATCH 14/35] Add some type annotations --- yesod-form/Yesod/Form/Fields.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 5f7255d8..7dbaf3c4 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE CPP #-} -- | Field functions allow you to easily create and validate forms, cleanly handling the uncertainty of parsing user input. @@ -681,7 +682,7 @@ optionsPairs opts = do -- -- @since 1.7.0 optionsPairsGrouped - :: (MonadHandler m, RenderMessage (HandlerSite m) msg) + :: forall m msg a. (MonadHandler m, RenderMessage (HandlerSite m) msg) => [(msg, [(msg, a)])] -> m (OptionList a) optionsPairsGrouped opts = do mr <- getMessageRender @@ -690,14 +691,14 @@ optionsPairsGrouped opts = do , optionInternalValue = internal , optionExternalValue = pack $ show external } - opts' = enumerateSublists opts -- :: [(msg, [(Int, (msg, a))])] + opts' = enumerateSublists opts :: [(msg, [(Int, (msg, a))])] opts'' = map (\(x, ys) -> (mr x, map mkOption ys)) opts' return $ mkOptionListGrouped opts'' -- | Helper to enumerate sublists with one consecutive index. -enumerateSublists :: [(a, [b])] -> [(a, [(Int, b)])] +enumerateSublists :: forall a b. [(a, [b])] -> [(a, [(Int, b)])] enumerateSublists xss = - let -- yss :: [(Int, (a, [b]))] + let yss :: [(Int, (a, [b]))] yss = snd $ foldl (\(i, res) xs -> (i + (length.snd) xs, res ++ [(i, xs)])) (1, []) xss in map (\(i, (x, ys)) -> (x, zip [i :: Int ..] ys)) yss From 08b5150ac0042254bc66b81c9a72095c88d18d91 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 13:46:03 +0200 Subject: [PATCH 15/35] Fix typo --- demo/subsite/WikiRoutes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/demo/subsite/WikiRoutes.hs b/demo/subsite/WikiRoutes.hs index f22c0222..0e340449 100644 --- a/demo/subsite/WikiRoutes.hs +++ b/demo/subsite/WikiRoutes.hs @@ -21,7 +21,7 @@ data Wiki = Wiki } -- | A typeclass that all master sites that want a Wiki must implement. A --- master must be able to render form messages, as we use yesod-forms for +-- master must be able to render form messages, as we use yesod-form for -- processing user input. class (RenderMessage master FormMessage, Yesod master) => YesodWiki master where -- | Write protection. By default, no protection. From 73a85310c6985658fe74b5e0485bbc8e2f3a13ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 13:46:53 +0200 Subject: [PATCH 16/35] Relax version constraints for yesod-form --- yesod-auth-oauth/yesod-auth-oauth.cabal | 2 +- yesod-auth/yesod-auth.cabal | 2 +- yesod-form-multi/yesod-form-multi.cabal | 2 +- yesod/yesod.cabal | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal index 8c1ee7f4..3a3f5ce6 100644 --- a/yesod-auth-oauth/yesod-auth-oauth.cabal +++ b/yesod-auth-oauth/yesod-auth-oauth.cabal @@ -22,7 +22,7 @@ library , unliftio , yesod-auth >= 1.6 && < 1.7 , yesod-core >= 1.6 && < 1.7 - , yesod-form >= 1.6 && < 1.7 + , yesod-form >= 1.6 && < 1.8 exposed-modules: Yesod.Auth.OAuth ghc-options: -Wall diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index b6be336c..039051f1 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -57,7 +57,7 @@ library , unordered-containers , wai >= 1.4 , yesod-core >= 1.6 && < 1.7 - , yesod-form >= 1.6 && < 1.7 + , yesod-form >= 1.6 && < 1.8 , yesod-persistent >= 1.6 if flag(network-uri) diff --git a/yesod-form-multi/yesod-form-multi.cabal b/yesod-form-multi/yesod-form-multi.cabal index 7e576ead..f8b7c983 100644 --- a/yesod-form-multi/yesod-form-multi.cabal +++ b/yesod-form-multi/yesod-form-multi.cabal @@ -26,7 +26,7 @@ library , text >= 0.9 , transformers >= 0.2.2 , yesod-core >= 1.6 && < 1.7 - , yesod-form >= 1.6 && < 1.7 + , yesod-form >= 1.6 && < 1.8 if flag(network-uri) build-depends: network-uri >= 2.6 diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 42e36729..21e51b95 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -38,7 +38,7 @@ library , warp >= 1.3 , yaml >= 0.8.17 , yesod-core >= 1.6 && < 1.7 - , yesod-form >= 1.6 && < 1.7 + , yesod-form >= 1.6 && < 1.8 , yesod-persistent >= 1.6 && < 1.7 exposed-modules: Yesod From e064306ef32610285058d557b61b7c4ea48fa4ac Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 15 Apr 2021 09:18:55 +0300 Subject: [PATCH 17/35] Version bumps for bounds --- yesod-auth-oauth/ChangeLog.md | 6 ++++++ yesod-auth-oauth/yesod-auth-oauth.cabal | 2 +- yesod-auth/ChangeLog.md | 4 ++++ yesod-auth/yesod-auth.cabal | 2 +- yesod-form-multi/ChangeLog.md | 6 +++++- yesod-form-multi/yesod-form-multi.cabal | 2 +- yesod-form/yesod-form.cabal | 4 +++- 7 files changed, 21 insertions(+), 5 deletions(-) diff --git a/yesod-auth-oauth/ChangeLog.md b/yesod-auth-oauth/ChangeLog.md index b7047210..9d5d5dbb 100644 --- a/yesod-auth-oauth/ChangeLog.md +++ b/yesod-auth-oauth/ChangeLog.md @@ -1,3 +1,9 @@ +# ChangeLog for yesod-auth-oauth + +## 1.6.0.3 + +* Allow yesod-form 1.7 + ## 1.6.0.2 * Remove unnecessary deriving of Typeable diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal index 3a3f5ce6..4d0faa5e 100644 --- a/yesod-auth-oauth/yesod-auth-oauth.cabal +++ b/yesod-auth-oauth/yesod-auth-oauth.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: yesod-auth-oauth -version: 1.6.0.2 +version: 1.6.0.3 license: BSD3 license-file: LICENSE author: Hiromi Ishii diff --git a/yesod-auth/ChangeLog.md b/yesod-auth/ChangeLog.md index 90f7d647..df6b5ab2 100644 --- a/yesod-auth/ChangeLog.md +++ b/yesod-auth/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-auth +## 1.6.10.3 + +* Relax bounds for yesod-form 1.7 + ## 1.6.10.2 * Relax bounds for persistent 2.12 diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 039051f1..18d30a8c 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: yesod-auth -version: 1.6.10.2 +version: 1.6.10.3 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin diff --git a/yesod-form-multi/ChangeLog.md b/yesod-form-multi/ChangeLog.md index 737cd3af..046bb930 100644 --- a/yesod-form-multi/ChangeLog.md +++ b/yesod-form-multi/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog +## 1.7.0.2 + +* Allow yesod-form 1.7 + ## 1.7.0.1 [#1716](https://github.com/yesodweb/yesod/pull/1716) @@ -23,4 +27,4 @@ [#1601](https://github.com/yesodweb/yesod/pull/1601) -* Added `Yesod.Form.MultiInput` which supports multi-input forms without needing to submit the form to add an input field \ No newline at end of file +* Added `Yesod.Form.MultiInput` which supports multi-input forms without needing to submit the form to add an input field diff --git a/yesod-form-multi/yesod-form-multi.cabal b/yesod-form-multi/yesod-form-multi.cabal index f8b7c983..8588c106 100644 --- a/yesod-form-multi/yesod-form-multi.cabal +++ b/yesod-form-multi/yesod-form-multi.cabal @@ -1,5 +1,5 @@ name: yesod-form-multi -version: 1.7.0.1 +version: 1.7.0.2 license: MIT license-file: LICENSE author: James Burton diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index 1fb100b1..dc33cbf0 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,3 +1,4 @@ +cabal-version: >= 1.10 name: yesod-form version: 1.7.0 license: MIT @@ -7,7 +8,6 @@ maintainer: Michael Snoyman synopsis: Form handling support for Yesod Web Framework category: Web, Yesod stability: Stable -cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/ description: API docs and the README are available at . Third-party packages which you can find useful: - richtext form fields (currntly it provides only Summernote support). @@ -19,6 +19,7 @@ flag network-uri default: True library + default-language: Haskell2010 build-depends: base >= 4.10 && < 5 , aeson , attoparsec >= 0.10 @@ -70,6 +71,7 @@ library ghc-options: -Wall test-suite test + default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: test From 2f8036c61fd83d6add965dd054e421e185bf318b Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 15 Apr 2021 09:29:10 +0300 Subject: [PATCH 18/35] Version bump for bounds --- yesod/ChangeLog.md | 6 ++++++ yesod/yesod.cabal | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/yesod/ChangeLog.md b/yesod/ChangeLog.md index 42a429e2..dd2fe0b0 100644 --- a/yesod/ChangeLog.md +++ b/yesod/ChangeLog.md @@ -1,3 +1,9 @@ +# ChangeLog for yesod + +## 1.6.1.1 + +* Allow yesod-form 1.7 + ## 1.6.1.0 * `widgetFileReload` and `widgetFileNoReload` now use absolute paths via the new `globFilePackage` Q Exp which can provide absolute templates paths within the project [#1691](https://github.com/yesodweb/yesod/pull/1691) diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 21e51b95..2b0ef5b8 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.6.1.0 +version: 1.6.1.1 license: MIT license-file: LICENSE author: Michael Snoyman From 3224e8e6f128494ee85f11ff7b13efe7a812fae3 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 5 May 2021 12:15:57 -0600 Subject: [PATCH 19/35] Support persistent-2.13 --- .gitignore | 1 + stack-persistent-213.yaml | 25 +++++++++++++++++++++++++ yesod-persistent/Yesod/Persist/Core.hs | 10 +++++++++- 3 files changed, 35 insertions(+), 1 deletion(-) create mode 100644 stack-persistent-213.yaml diff --git a/.gitignore b/.gitignore index 42e81982..8f84fbea 100644 --- a/.gitignore +++ b/.gitignore @@ -25,3 +25,4 @@ tarballs/ # OS X .DS_Store +*.yaml.lock diff --git a/stack-persistent-213.yaml b/stack-persistent-213.yaml new file mode 100644 index 00000000..3fd9703d --- /dev/null +++ b/stack-persistent-213.yaml @@ -0,0 +1,25 @@ +resolver: nightly-2021-03-31 +packages: +- ./yesod-core +- ./yesod-static +- ./yesod-persistent +- ./yesod-newsfeed +- ./yesod-form +- ./yesod-form-multi +- ./yesod-auth +- ./yesod-auth-oauth +- ./yesod-sitemap +- ./yesod-test +- ./yesod-bin +- ./yesod +- ./yesod-eventsource +- ./yesod-websockets +extra-deps: +- lift-type-0.1.0.1 +- git: git@github.com:yesodweb/persistent + commit: 315ae91349ef4fbc2f4f2595cb7d3423e79ef80f + subdirs: + - persistent + - persistent-sqlite + - persistent-mysql + - persistent-postgresql diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs index b7c82baf..6a671ca7 100644 --- a/yesod-persistent/Yesod/Persist/Core.hs +++ b/yesod-persistent/Yesod/Persist/Core.hs @@ -25,6 +25,7 @@ module Yesod.Persist.Core import Database.Persist import Control.Monad.Trans.Reader (ReaderT, runReaderT) +import Data.Foldable (toList) import Yesod.Core import Data.Conduit import Blaze.ByteString.Builder (Builder) @@ -33,6 +34,9 @@ import Control.Monad.Trans.Resource import Control.Exception (throwIO) import Yesod.Core.Types (HandlerContents (HCError)) import qualified Database.Persist.Sql as SQL +#if MIN_VERSION_persistent(2,13,0) +import qualified Database.Persist.SqlBackend.Internal as SQL +#endif unSqlPersistT :: a -> a unSqlPersistT = id @@ -197,7 +201,11 @@ insert400 datum = do case conflict of Just unique -> #if MIN_VERSION_persistent(2, 12, 0) - badRequest' $ map (unFieldNameHS . fst) $ persistUniqueToFieldNames unique +-- toList is called here because persistent-2.13 changed this +-- to a nonempty list. for versions of persistent prior to 2.13, toList +-- will be a no-op. for persistent-2.13, it'll convert the NonEmptyList to +-- a List. + badRequest' $ map (unFieldNameHS . fst) $ toList $ persistUniqueToFieldNames unique #else badRequest' $ map (unHaskellName . fst) $ persistUniqueToFieldNames unique #endif From 69735fc9c6c10eaa0a2dc170fc4c703519afe696 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 5 May 2021 12:33:24 -0600 Subject: [PATCH 20/35] Add link to changelog, version bump --- yesod-persistent/ChangeLog.md | 4 ++++ yesod-persistent/yesod-persistent.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/yesod-persistent/ChangeLog.md b/yesod-persistent/ChangeLog.md index a8c8dad1..f8741166 100644 --- a/yesod-persistent/ChangeLog.md +++ b/yesod-persistent/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-persistent +## 1.7.0.7 + +* Add support for persistent 2.13. [#1723](https://github.com/yesodweb/yesod/pull/1723) + ## 1.6.0.6 * Add support for persistent 2.12 diff --git a/yesod-persistent/yesod-persistent.cabal b/yesod-persistent/yesod-persistent.cabal index 5bd21f5c..b9ca9fff 100644 --- a/yesod-persistent/yesod-persistent.cabal +++ b/yesod-persistent/yesod-persistent.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: yesod-persistent -version: 1.6.0.6 +version: 1.6.0.7 license: MIT license-file: LICENSE author: Michael Snoyman From d42354ae98d49df7cac850fa59fa04a6bf0ab9ad Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 5 May 2021 15:17:46 -0600 Subject: [PATCH 21/35] use hackage release --- stack-persistent-213.yaml | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/stack-persistent-213.yaml b/stack-persistent-213.yaml index 3fd9703d..bce1e6d8 100644 --- a/stack-persistent-213.yaml +++ b/stack-persistent-213.yaml @@ -16,10 +16,7 @@ packages: - ./yesod-websockets extra-deps: - lift-type-0.1.0.1 -- git: git@github.com:yesodweb/persistent - commit: 315ae91349ef4fbc2f4f2595cb7d3423e79ef80f - subdirs: - - persistent - - persistent-sqlite - - persistent-mysql - - persistent-postgresql +- persistent-2.13.0.0 +- persistent-mysql-2.13.0.0 +- persistent-sqlite-2.13.0.0 +- persistent-postgrseql-2.13.0.0 From 3d3fe3f5b6feea6cc7c87cd1d564d0e627e207e5 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 5 May 2021 16:31:30 -0600 Subject: [PATCH 22/35] fix version in changelog --- yesod-persistent/ChangeLog.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-persistent/ChangeLog.md b/yesod-persistent/ChangeLog.md index f8741166..52286010 100644 --- a/yesod-persistent/ChangeLog.md +++ b/yesod-persistent/ChangeLog.md @@ -1,6 +1,6 @@ # ChangeLog for yesod-persistent -## 1.7.0.7 +## 1.6.0.7 * Add support for persistent 2.13. [#1723](https://github.com/yesodweb/yesod/pull/1723) From b3188d962e0c1d79e0631c90cd00b4ed9c062329 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 6 May 2021 07:35:37 -0600 Subject: [PATCH 23/35] add to test --- .github/workflows/tests.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml index 2265e9ec..c328b031 100644 --- a/.github/workflows/tests.yml +++ b/.github/workflows/tests.yml @@ -22,6 +22,7 @@ jobs: - "--resolver lts-11" - "--stack-yaml stack-persistent-211.yaml" - "--stack-yaml stack-persistent-212.yaml" + - "--stack-yaml stack-persistent-213.yaml" # Bugs in GHC make it crash too often to be worth running exclude: - os: windows-latest From 3ea97d21b8266712a1ecf1ea595e701658c72ada Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Fri, 7 May 2021 13:08:39 +0300 Subject: [PATCH 24/35] Fix extra-deps --- stack-persistent-213.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/stack-persistent-213.yaml b/stack-persistent-213.yaml index bce1e6d8..c90d12e7 100644 --- a/stack-persistent-213.yaml +++ b/stack-persistent-213.yaml @@ -19,4 +19,5 @@ extra-deps: - persistent-2.13.0.0 - persistent-mysql-2.13.0.0 - persistent-sqlite-2.13.0.0 -- persistent-postgrseql-2.13.0.0 +- persistent-postgresql-2.13.0.0 +- persistent-template-2.12.0.0 From b6215582d81c29905312453b9802e7b9467d9f69 Mon Sep 17 00:00:00 2001 From: Hypercube Date: Tue, 11 May 2021 11:32:07 +0800 Subject: [PATCH 25/35] Use secure entropy source to generate CSRF tokens --- yesod-core/src/Yesod/Core/Dispatch.hs | 16 ++++++++++++++-- yesod-core/src/Yesod/Core/Types.hs | 8 +++++++- yesod-core/yesod-core.cabal | 3 ++- 3 files changed, 23 insertions(+), 4 deletions(-) diff --git a/yesod-core/src/Yesod/Core/Dispatch.hs b/yesod-core/src/Yesod/Core/Dispatch.hs index 60779532..959aaae3 100644 --- a/yesod-core/src/Yesod/Core/Dispatch.hs +++ b/yesod-core/src/Yesod/Core/Dispatch.hs @@ -46,6 +46,7 @@ import qualified Network.Wai as W import Data.ByteString.Lazy.Char8 () +import Data.Bits ((.|.), finiteBitSize, shiftL) import Data.Text (Text) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as BL @@ -59,7 +60,7 @@ import Yesod.Core.Class.Dispatch import Yesod.Core.Internal.Run import Text.Read (readMaybe) import System.Environment (getEnvironment) -import qualified System.Random as Random +import System.Entropy (getEntropy) import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction, updateFreq) import Yesod.Core.Internal.Util (getCurrentMaxExpiresRFC1123) @@ -92,8 +93,19 @@ toWaiAppPlain site = do , yreGetMaxExpires = getMaxExpires } +-- | Generate a random number uniformly distributed in the full range +-- of 'Int'. +-- +-- Note: Before 1.7.0, this generates pseudo-random number in an +-- unspecified range. The range size may not be a power of 2. Since +-- 1.7.0, this uses a secure entropy source and generates in the full +-- range of 'Int'. defaultGen :: IO Int -defaultGen = Random.getStdRandom Random.next +defaultGen = bsToInt <$> getEntropy bytes + where + bits = finiteBitSize (undefined :: Int) + bytes = div (bits + 7) 8 + bsToInt = S.foldl' (\v i -> shiftL v 8 .|. fromIntegral i) 0 -- | Pure low level function to construct WAI application. Usefull -- when you need not standard way to run your app, or want to embed it diff --git a/yesod-core/src/Yesod/Core/Types.hs b/yesod-core/src/Yesod/Core/Types.hs index a33a4f5c..322dce0a 100644 --- a/yesod-core/src/Yesod/Core/Types.hs +++ b/yesod-core/src/Yesod/Core/Types.hs @@ -196,7 +196,13 @@ data YesodRunnerEnv site = YesodRunnerEnv , yreSite :: !site , yreSessionBackend :: !(Maybe SessionBackend) , yreGen :: !(IO Int) - -- ^ Generate a random number + -- ^ Generate a random number uniformly distributed in the full + -- range of 'Int'. + -- + -- Note: Before 1.7.0, the default value generates pseudo-random + -- number in an unspecified range. The range size may not be a power + -- of 2. Since 1.7.0, the default value uses a secure entropy source + -- and generates in the full range of 'Int'. , yreGetMaxExpires :: !(IO Text) } diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 41a228b4..b37a05ba 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.19.0 +version: 1.7.0 license: MIT license-file: LICENSE author: Michael Snoyman @@ -39,6 +39,7 @@ library , containers >= 0.2 , cookie >= 0.4.3 && < 0.5 , deepseq >= 1.3 + , entropy , fast-logger >= 2.2 , http-types >= 0.7 , memory From 5deabe53e8085814906ce015c72175c997e0529e Mon Sep 17 00:00:00 2001 From: Hypercube Date: Tue, 11 May 2021 11:35:59 +0800 Subject: [PATCH 26/35] Update changelog --- yesod-core/ChangeLog.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 70041a9f..edcb7e07 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,5 +1,10 @@ # ChangeLog for yesod-core +## 1.7.0 + +* Generate CSRF tokens using a secure entropy source [#1726](https://github.com/yesodweb/yesod/pull/1726) +* Change semantics of `yreGen` and `defaultGen` + ## 1.6.19.0 * Change order of priority in `languages`[#1721](https://github.com/yesodweb/yesod/pull/1721) From 1cb0fc579c4562aa3057d2d5fb29b58811071365 Mon Sep 17 00:00:00 2001 From: Hypercube Date: Tue, 11 May 2021 14:03:51 +0800 Subject: [PATCH 27/35] Change version number --- yesod-core/ChangeLog.md | 2 +- yesod-core/src/Yesod/Core/Dispatch.hs | 4 ++-- yesod-core/src/Yesod/Core/Types.hs | 4 ++-- yesod-core/yesod-core.cabal | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index edcb7e07..45793963 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,6 +1,6 @@ # ChangeLog for yesod-core -## 1.7.0 +## 1.6.20 * Generate CSRF tokens using a secure entropy source [#1726](https://github.com/yesodweb/yesod/pull/1726) * Change semantics of `yreGen` and `defaultGen` diff --git a/yesod-core/src/Yesod/Core/Dispatch.hs b/yesod-core/src/Yesod/Core/Dispatch.hs index 959aaae3..8a2501e6 100644 --- a/yesod-core/src/Yesod/Core/Dispatch.hs +++ b/yesod-core/src/Yesod/Core/Dispatch.hs @@ -96,9 +96,9 @@ toWaiAppPlain site = do -- | Generate a random number uniformly distributed in the full range -- of 'Int'. -- --- Note: Before 1.7.0, this generates pseudo-random number in an +-- Note: Before 1.6.20, this generates pseudo-random number in an -- unspecified range. The range size may not be a power of 2. Since --- 1.7.0, this uses a secure entropy source and generates in the full +-- 1.6.20, this uses a secure entropy source and generates in the full -- range of 'Int'. defaultGen :: IO Int defaultGen = bsToInt <$> getEntropy bytes diff --git a/yesod-core/src/Yesod/Core/Types.hs b/yesod-core/src/Yesod/Core/Types.hs index 322dce0a..11a55f1a 100644 --- a/yesod-core/src/Yesod/Core/Types.hs +++ b/yesod-core/src/Yesod/Core/Types.hs @@ -199,9 +199,9 @@ data YesodRunnerEnv site = YesodRunnerEnv -- ^ Generate a random number uniformly distributed in the full -- range of 'Int'. -- - -- Note: Before 1.7.0, the default value generates pseudo-random + -- Note: Before 1.6.20, the default value generates pseudo-random -- number in an unspecified range. The range size may not be a power - -- of 2. Since 1.7.0, the default value uses a secure entropy source + -- of 2. Since 1.6.20, the default value uses a secure entropy source -- and generates in the full range of 'Int'. , yreGetMaxExpires :: !(IO Text) } diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index b37a05ba..1c258f15 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.7.0 +version: 1.6.20 license: MIT license-file: LICENSE author: Michael Snoyman From d981c87c3994b848cf7b105f2adc5de3362b252e Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Mon, 17 May 2021 20:40:09 +0200 Subject: [PATCH 28/35] yesod-core: detect loops in breadcrumbs --- yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs index 1e956ff2..34069e7f 100644 --- a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs +++ b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} module Yesod.Core.Class.Breadcrumbs where import Yesod.Core.Handler @@ -15,7 +16,7 @@ class YesodBreadcrumbs site where -- | Gets the title of the current page and the hierarchy of parent pages, -- along with their respective titles. -breadcrumbs :: YesodBreadcrumbs site => HandlerFor site (Text, [(Route site, Text)]) +breadcrumbs :: (YesodBreadcrumbs site, Eq (Route site)) => HandlerFor site (Text, [(Route site, Text)]) breadcrumbs = do x <- getCurrentRoute case x of @@ -28,4 +29,8 @@ breadcrumbs = do go back Nothing = return back go back (Just this) = do (title, next) <- breadcrumb this - go ((this, title) : back) next + if next `elem` (map (Just . fst) back) + then + error $ "infinite recursion in breadcrumbs at" <> show title + else + go ((this, title) : back) next From 96a940b60c2814513017876ab32a79d1a2a530d4 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Thu, 20 May 2021 14:25:17 +0200 Subject: [PATCH 29/35] yesod-core: test for looping breadcrumbs --- yesod-core/test/YesodCoreTest.hs | 2 + yesod-core/test/YesodCoreTest/Breadcrumb.hs | 58 +++++++++++++++++++++ 2 files changed, 60 insertions(+) create mode 100644 yesod-core/test/YesodCoreTest/Breadcrumb.hs diff --git a/yesod-core/test/YesodCoreTest.hs b/yesod-core/test/YesodCoreTest.hs index e9f42851..591f86a7 100644 --- a/yesod-core/test/YesodCoreTest.hs +++ b/yesod-core/test/YesodCoreTest.hs @@ -12,6 +12,7 @@ import YesodCoreTest.InternalRequest import YesodCoreTest.ErrorHandling import YesodCoreTest.Cache import YesodCoreTest.ParameterizedSite +import YesodCoreTest.Breadcrumb import qualified YesodCoreTest.WaiSubsite as WaiSubsite import qualified YesodCoreTest.Redirect as Redirect import qualified YesodCoreTest.JsLoader as JsLoader @@ -61,3 +62,4 @@ specs = do Ssl.sslOnlySpec Ssl.sameSiteSpec Csrf.csrfSpec + breadcrumbTest diff --git a/yesod-core/test/YesodCoreTest/Breadcrumb.hs b/yesod-core/test/YesodCoreTest/Breadcrumb.hs new file mode 100644 index 00000000..c64cfa25 --- /dev/null +++ b/yesod-core/test/YesodCoreTest/Breadcrumb.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module YesodCoreTest.Breadcrumb + ( breadcrumbTest, + ) +where + +import qualified Data.ByteString.Lazy.Char8 as L8 +import Data.Text (Text) +import Data.Typeable (Typeable) +import Network.Wai +import Network.Wai.Test +import Test.Hspec +import UnliftIO.IORef +import Yesod.Core + +data A = A + +mkYesod + "A" + [parseRoutes| +/ RootR GET +/loop LoopR GET +|] + +instance Yesod A + +instance YesodBreadcrumbs A where + breadcrumb r = case r of + RootR -> pure ("Root", Nothing) + LoopR -> pure ("Loop", Just LoopR) -- Purposefully a loop + +getRootR :: Handler Text +getRootR = fst <$> breadcrumbs + +getLoopR :: Handler Text +getLoopR = fst <$> breadcrumbs + +breadcrumbTest :: Spec +breadcrumbTest = + describe "Test.Breadcrumb" $ do + it "can fetch the root which contains breadcrumbs" $ + runner $ do + res <- request defaultRequest + assertStatus 200 res + it "gets a 500 for a route with a looping breadcrumb" $ + runner $ do + res <- request defaultRequest {pathInfo = ["loop"]} + assertStatus 500 res + +runner :: Session () -> IO () +runner f = toWaiApp A >>= runSession f From 59ef730317d0b29567a16d15688ebf2b4bfc646c Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Thu, 20 May 2021 14:28:09 +0200 Subject: [PATCH 30/35] yesod-core: refactor the loop detector to not use Just wrapping --- yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs index 34069e7f..8bce0233 100644 --- a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs +++ b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs @@ -29,8 +29,8 @@ breadcrumbs = do go back Nothing = return back go back (Just this) = do (title, next) <- breadcrumb this - if next `elem` (map (Just . fst) back) + if this `elem` map fst back then - error $ "infinite recursion in breadcrumbs at" <> show title + error $ "yesod-core: infinite recursion in breadcrumbs at " <> show title else go ((this, title) : back) next From 884d937792402fcd34b474bc60fa3664b27173b9 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Thu, 20 May 2021 16:00:55 +0200 Subject: [PATCH 31/35] use ++ instead of <> to fix the build --- yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs index 8bce0233..c1e7b5af 100644 --- a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs +++ b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs @@ -31,6 +31,6 @@ breadcrumbs = do (title, next) <- breadcrumb this if this `elem` map fst back then - error $ "yesod-core: infinite recursion in breadcrumbs at " <> show title + error $ "yesod-core: infinite recursion in breadcrumbs at " ++ show title else go ((this, title) : back) next From 0db056534c4efb968249961b08df2c4b1f7873a1 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Fri, 21 May 2021 08:41:42 +0200 Subject: [PATCH 32/35] breadcrumbs: guard refactor --- yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs index c1e7b5af..9773af1d 100644 --- a/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs +++ b/yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs @@ -16,7 +16,7 @@ class YesodBreadcrumbs site where -- | Gets the title of the current page and the hierarchy of parent pages, -- along with their respective titles. -breadcrumbs :: (YesodBreadcrumbs site, Eq (Route site)) => HandlerFor site (Text, [(Route site, Text)]) +breadcrumbs :: (YesodBreadcrumbs site, Show (Route site), Eq (Route site)) => HandlerFor site (Text, [(Route site, Text)]) breadcrumbs = do x <- getCurrentRoute case x of @@ -27,10 +27,8 @@ breadcrumbs = do return (title, z) where go back Nothing = return back - go back (Just this) = do - (title, next) <- breadcrumb this - if this `elem` map fst back - then - error $ "yesod-core: infinite recursion in breadcrumbs at " ++ show title - else + go back (Just this) + | this `elem` map fst back = error $ "yesod-core: infinite recursion in breadcrumbs at " ++ show this + | otherwise = do + (title, next) <- breadcrumb this go ((this, title) : back) next From 2d0dab20a645be2e2de0eda31b5161897c84fc1e Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Fri, 21 May 2021 17:09:10 +0200 Subject: [PATCH 33/35] minor version bump and changelog entry --- yesod-core/ChangeLog.md | 4 ++++ yesod-core/yesod-core.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 45793963..0a5ed49e 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-core +## 1.6.20.1 + +* Throw an error in `breadcrumbs` if the trail of breadcrumbs is circular. [#1727](https://github.com/yesodweb/yesod/issues/1727) + ## 1.6.20 * Generate CSRF tokens using a secure entropy source [#1726](https://github.com/yesodweb/yesod/pull/1726) diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 1c258f15..b22ade9d 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.20 +version: 1.6.20.1 license: MIT license-file: LICENSE author: Michael Snoyman From a1e18c5b6832f30e0bb119406f0660863db40dd4 Mon Sep 17 00:00:00 2001 From: Felix Yan Date: Fri, 25 Jun 2021 10:54:55 +0800 Subject: [PATCH 34/35] Fix compatibility with template-haskell 2.17 --- yesod-core/src/Yesod/Core/Internal/TH.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-core/src/Yesod/Core/Internal/TH.hs b/yesod-core/src/Yesod/Core/Internal/TH.hs index f3505b91..11bbf90b 100644 --- a/yesod-core/src/Yesod/Core/Internal/TH.hs +++ b/yesod-core/src/Yesod/Core/Internal/TH.hs @@ -107,9 +107,9 @@ mkYesodDispatch name = fmap snd . mkYesodWithParser name False return -- | Get the Handler and Widget type synonyms for the given site. masterTypeSyns :: [Name] -> Type -> [Dec] -- FIXME remove from here, put into the scaffolding itself? masterTypeSyns vs site = - [ TySynD (mkName "Handler") (fmap PlainTV vs) + [ TySynD (mkName "Handler") (fmap plainTV vs) $ ConT ''HandlerFor `AppT` site - , TySynD (mkName "Widget") (fmap PlainTV vs) + , TySynD (mkName "Widget") (fmap plainTV vs) $ ConT ''WidgetFor `AppT` site `AppT` ConT ''() ] From 9edbc05827bf2c5d4c80b2e1fb21c09d4fa9739c Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 27 Jun 2021 12:19:01 +0300 Subject: [PATCH 35/35] Version bump for #1729 --- yesod-core/ChangeLog.md | 4 ++++ yesod-core/yesod-core.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 0a5ed49e..7fb76193 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-core +## 1.6.20.2 + +* Fix compatibility with template-haskell 2.17 [#1729](https://github.com/yesodweb/yesod/pull/1729) + ## 1.6.20.1 * Throw an error in `breadcrumbs` if the trail of breadcrumbs is circular. [#1727](https://github.com/yesodweb/yesod/issues/1727) diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index b22ade9d..0e3799d5 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.20.1 +version: 1.6.20.2 license: MIT license-file: LICENSE author: Michael Snoyman