From 5cfe8848fe14490e09c91ee5dc19eebbff2949b8 Mon Sep 17 00:00:00 2001
From: LukeTemp <38944835+LukeTemp@users.noreply.github.com>
Date: Tue, 27 Feb 2024 14:11:30 +0000
Subject: [PATCH] Upstream helper functions to Yesod.Form.Option. (#1828)

The 2 new functions are:

- `optionsFromList'`: Creates an `OptionList` from a list using the `PathPiece` instance for the external value
and a custom function for the user-facing value.
- `optionsEnum'`: creates an `OptionList` from an enumeration.
---
 yesod-form/ChangeLog.md         |  7 +++
 yesod-form/Yesod/Form/Option.hs | 96 +++++++++++++++++++++++++++++++++
 yesod-form/yesod-form.cabal     |  3 +-
 3 files changed, 105 insertions(+), 1 deletion(-)
 create mode 100644 yesod-form/Yesod/Form/Option.hs

diff --git a/yesod-form/ChangeLog.md b/yesod-form/ChangeLog.md
index 6fa84b00b..7cbbf4518 100644
--- a/yesod-form/ChangeLog.md
+++ b/yesod-form/ChangeLog.md
@@ -1,5 +1,12 @@
 # ChangeLog for yesod-form
 
+
+## 1.7.7
+
+* Added `optionsFromList'` to create an OptionList from a List, using the PathPiece instance for the external value and
+a custom function for the user-facing value. Also added `optionsEnum'` to create an OptionList from an enumeration
+[#1828](https://github.com/yesodweb/yesod/pull/1828)
+
 ## 1.7.6
 
 * Added `datetimeLocalField` for creating a html `<input type="datetime-local">` [#1817](https://github.com/yesodweb/yesod/pull/1817)
diff --git a/yesod-form/Yesod/Form/Option.hs b/yesod-form/Yesod/Form/Option.hs
new file mode 100644
index 000000000..fcbd9dc0b
--- /dev/null
+++ b/yesod-form/Yesod/Form/Option.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Yesod.Form.Option where
+
+import Yesod.Core
+import Yesod.Form.Fields
+
+-- | Creates an `OptionList` from a `List`, using the `PathPiece` instance for
+-- the external value and a custom function for the user-facing value.
+--
+-- @since 1.7.7
+--
+-- PathPiece instances should provide suitable external values, since path
+-- pieces serve to be exposed through URLs or HTML anyway. Show/Read instances
+-- are avoided here since they could leak internal representations to forms,
+-- query params, javascript etc.
+--
+-- === __Example usage__
+--
+-- > data UserRole = URSalesTeam | URSalesHead | URTechTeam | URTechHead
+-- >
+-- > instance PathPiece UserDepartment where
+-- >   toPathPiece = \case
+-- >     URSalesTeam -> "sales-team"
+-- >     URSalesHead -> "sales-head"
+-- >     URTechTeam -> "tech-team"
+-- >     URTechHead -> "tech-head"
+-- >   fromPathPiece = \case
+-- >     "sales-team" -> Just URSalesTeam
+-- >     "sales-head" -> Just URSalesHead
+-- >     "tech-team" -> Just URTechTeam
+-- >     "tech-head" -> Just URTechHead
+-- >     _ -> Nothing
+-- >
+-- > userRoleOptions ::
+-- >   (MonadHandler m, RenderMessage (HandlerSite m) msg) => m (OptionList UserRole)
+-- > userRoleOptions = optionsFromList' userRoles toMsg
+-- >   where
+-- >   userRoles = [URSalesTeam, URSalesHead, URTechTeam, URTechHead]
+-- >   toMsg :: UserRole -> Text
+-- >   toMsg = \case
+-- >     URSalesTeam -> "Sales Team"
+-- >     URSalesHead -> "Head of Sales Team"
+-- >     URTechTeam -> "Tech Team"
+-- >     URTechHead -> "Head of Tech Team"
+--
+-- userRoleOptions, will produce an OptionList with the following attributes:
+--
+-- > +----------------+----------------+--------------------+
+-- > | Internal Value | External Value | User-facing Value  |
+-- > +----------------+----------------+--------------------+
+-- > | URSalesTeam    | sales-team     | Sales Team         |
+-- > +----------------+----------------+--------------------+
+-- > | URSalesHead    | sales-head     | Head of Sales Team |
+-- > +----------------+----------------+--------------------+
+-- > | URTechTeam     | tech-team      | Tech Team          |
+-- > +----------------+----------------+--------------------+
+-- > | URTechHead     | tech-head      | Head of Tech Team  |
+-- > +----------------+----------------+--------------------+
+--
+-- Note that the type constraint allows localizable messages in place of toMsg (see
+-- https://en.wikipedia.org/wiki/Yesod_(web_framework)#Localizable_messages).
+
+optionsFromList' ::
+     MonadHandler m
+  => RenderMessage (HandlerSite m) msg
+  => PathPiece a
+  => [a]
+  -> (a -> msg)
+  -> m (OptionList a)
+optionsFromList' lst toDisplay = do
+  mr <- getMessageRender
+  pure $ mkOptionList $ flip map lst $ \v -> Option
+    { optionDisplay = mr $ toDisplay v
+    , optionInternalValue = v
+    , optionExternalValue = toPathPiece v
+    }
+
+-- | Creates an `OptionList` from an `Enum`.
+--
+-- @since 1.7.7
+--
+-- optionsEnum' == optionsFromList' [minBound..maxBound]
+--
+-- Creates an `OptionList` containing every constructor of `a`, so that these
+-- constructors do not need to be typed out. Bounded and Enum instances must
+-- exist for `a` to use this.
+optionsEnum' ::
+     MonadHandler m
+  => RenderMessage (HandlerSite m) msg
+  => PathPiece a
+  => Enum a
+  => Bounded a
+  => (a -> msg)
+  -> m (OptionList a)
+optionsEnum' = optionsFromList' [minBound..maxBound]
diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal
index d0bcfcb43..c7d9b45c8 100644
--- a/yesod-form/yesod-form.cabal
+++ b/yesod-form/yesod-form.cabal
@@ -1,6 +1,6 @@
 cabal-version:   >= 1.10
 name:            yesod-form
-version:         1.7.6
+version:         1.7.7
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -46,6 +46,7 @@ library
       build-depends: network-uri >= 2.6
 
     exposed-modules: Yesod.Form
+                     Yesod.Form.Option
                      Yesod.Form.Types
                      Yesod.Form.Functions
                      Yesod.Form.Bootstrap3