RFC: Make Some into a newtype around Some from package some

Changelog.md

@@ -8,6 +8,13 @@
     the corresponding `Eq` instances for these data types also require
     `TestEquality` constraints.
 
+  * Make `Some` a newtype around
+    [`Some`](https://hackage.haskell.org/package/some-1.0.4/docs/Data-Some.html#t:Some)
+    from [the `some` package](https://hackage.haskell.org/package/some-1.0.4).
+    This should improve performance, as the latter is a newtype. However, it
+    requires importing the `Some` pattern, rather than a data constructor.
+    Also adds `Semigroup` and `Monoid` instances.
+
 ## 2.1.5.0 -- *2022 Mar 08*
 
   * Add support for GHC 9.2.  Drop support for GHC 8.4 (or earlier).

parameterized-utils.cabal

@@ -62,6 +62,7 @@ library
                , lens           >=4.16 && <5.2
                , mtl
                , profunctors    >=5.6 && < 5.7
+               , some           >=1.0 && < 2.0
                , template-haskell
                , text
                , vector         ==0.12.*

src/Data/Parameterized/ClassesC.hs

@@ -15,9 +15,9 @@ Note that there is still some ambiguity around naming conventions, see
 <https://github.com/GaloisInc/parameterized-utils/issues/23 issue 23>.
 -}
 
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE Safe #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Data.Parameterized.ClassesC
@@ -29,7 +29,7 @@ import Data.Type.Equality ((:~:)(..))
 import Data.Kind
 import Data.Maybe (isJust)
 import Data.Parameterized.Classes (OrderingF, toOrdering)
-import Data.Parameterized.Some (Some(..))
+import Data.Parameterized.Some (Some, pattern Some)
 
 class TestEqualityC (t :: (k -> Type) -> Type) where
   testEqualityC :: (forall x y. f x -> f y -> Maybe (x :~: y))

src/Data/Parameterized/FinMap/Unsafe.hs

@@ -8,6 +8,7 @@ See "Data.Parameterized.FinMap".
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -52,7 +53,7 @@ import           Data.Parameterized.Fin (Fin, mkFin)
 import qualified Data.Parameterized.Fin as Fin
 import           Data.Parameterized.NatRepr (LeqProof, NatRepr, type (+), type (<=))
 import qualified Data.Parameterized.NatRepr as NatRepr
-import           Data.Parameterized.Some (Some(Some))
+import           Data.Parameterized.Some (pattern Some)
 import           Data.Parameterized.Vector (Vector)
 import qualified Data.Parameterized.Vector as Vec
 

src/Data/Parameterized/Some.hs

@@ -8,11 +8,15 @@
 -- This module provides 'Some', a GADT that hides a type parameter.
 ------------------------------------------------------------------------
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
 module Data.Parameterized.Some
-  ( Some(..)
+  ( Some
+  , pattern Some
   , viewSome
   , mapSome
   , traverseSome
@@ -22,12 +26,24 @@ module Data.Parameterized.Some
 
 import Control.Lens (Lens', lens, (&), (^.), (.~))
 import Data.Hashable
-import Data.Kind
 import Data.Parameterized.Classes
 import Data.Parameterized.TraversableF
+import qualified Data.Some as Some
 
+-- This used to be a @data@ type, but is now a newtype around Some.Some. The
+-- idea is that Some.Some provides an (internally unsafe) newtype-based encoding
+-- which has better performance characteristics, see the upstream documentation.
+newtype Some f = MkSome (Some.Some f)
 
-data Some (f:: k -> Type) = forall x . Some (f x)
+-- | See instances for 'Some.Some'.
+deriving instance Applicative f => Semigroup (Some f)
+-- | See instances for 'Some.Some'.
+deriving instance Applicative f => Monoid (Some f)
+
+{-# COMPLETE Some #-}
+pattern Some :: f a -> Some f
+pattern Some x <- MkSome (Some.Some x)
+  where Some x = MkSome (Some.Some x)
 
 instance TestEquality f => Eq (Some f) where
   Some x == Some y = isJust (testEquality x y)

test/Test/Fin.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# Language CPP #-}
@@ -22,7 +23,7 @@ import           Test.Tasty.HUnit (assertBool, testCase)
 
 import           Data.Parameterized.NatRepr
 import           Data.Parameterized.Fin
-import           Data.Parameterized.Some (Some(Some))
+import           Data.Parameterized.Some (pattern Some)
 
 #if __GLASGOW_HASKELL__ >= 806
 import qualified Hedgehog.Classes as HC

test/Test/Some.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Test.Some
   ( someTests
@@ -13,7 +14,7 @@ import           Test.Tasty (TestTree, testGroup)
 import           Test.Tasty.HUnit (assertEqual, testCase)
 
 import           Data.Parameterized.Classes (ShowF)
-import           Data.Parameterized.Some (Some(Some), someLens)
+import           Data.Parameterized.Some (Some, pattern Some, someLens)
 
 data Item b where
   BoolItem :: Item Bool