support ghc-9.10

.github/workflows/applications.yml

@@ -18,15 +18,15 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ghc: ['9.6']
-        cabal: ['3.10']
+        ghc: ['9.6', '9.8', '9.10']
+        cabal: ['3.12']
         os: ['ubuntu-20.04', 'ubuntu-22.04', 'macos-latest', 'macos-14']
         cabalcache: ['true']
         flags: ['+build-tool']
         include:
         - os: 'ubuntu-20.04'
-          ghc: '9.6'
-          cabal: '3.10'
+          ghc: '9.8'
+          cabal: '3.12'
           cabalcache: 'true'
           flags: '-build-tool'
     env:

cabal.project

@@ -45,12 +45,13 @@ allow-newer: *:template-haskell
 allow-newer: *:base
 allow-newer: *:ghc-prim
 
--- Patch merged into master (upcoming verison 10.0). We are currently using 9.2
+-- Patch merged into master (upcoming verison 10.0). We are currently using 9.2.
+-- This fork contains additional fixes for using 9.2 with recent compilers. 
 source-repository-package
   type: git
-  tag: 3946a0e94470d7403a855dd60f8e54687ecc2b1d
+  tag: 1f2d042718fcf9a140398bd3dedac77c207cce27
   location: https://github.com/larskuhtz/sbv
-  --sha256: 1msbz6525nmsywpm910jh23siil4qgn3rpsm52m8j6877r7v5zw3
+  --sha256: sha256-Y2ZRU9lkrClYiNc8apwy4uO1TAvJ8JZEPKF73ZuGdlA=
 
 -- Servant is notoriously forcing outdated upper bounds onto its users.
 -- It is usually safe to just ignore those.

lib/unsafe/src/Data/Foldable/Unsafe.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE CPP #-}
+
+#if MIN_VERSION_base(4,20,0)
+{-# OPTIONS_GHC -Wno-x-partial #-}
+#endif
+
+
+-- |
+-- Module: unsafe.Data.Foldable.Unsafe
+-- Copyright: Copyright © 2024 Kadena LLC.
+-- License: MIT
+-- Maintainer: Pact Team
+-- Stability: experimental
+--
+-- This module provides unsafe versions for all functions in "Data.Foldable"
+-- that are either partial or return a 'Maybe' value.
+--
+module Data.Foldable.Unsafe
+(
+-- * Unsafe versions of partial functions
+  unsafeMaximum
+, unsafeMaximumBy
+, unsafeMinimum
+, unsafeMinimumBy
+
+-- * Unsafe versions of functions that return 'Maybe' values
+, unsafeFind
+) where
+
+import Data.Foldable
+
+import GHC.Stack
+
+-- -------------------------------------------------------------------------- --
+-- Unsafe versions of partial functions
+
+unsafeMaximum :: HasCallStack => Foldable t => Ord a => t a -> a
+unsafeMaximum = maximum
+
+unsafeMaximumBy :: HasCallStack => Foldable t => (a -> a -> Ordering) -> t a -> a
+unsafeMaximumBy = maximumBy
+
+unsafeMinimum :: HasCallStack => (Foldable t, Ord a) => t a -> a
+unsafeMinimum = minimum
+
+unsafeMinimumBy :: HasCallStack => Foldable t => (a -> a -> Ordering) -> t a -> a
+unsafeMinimumBy = minimumBy
+
+-- -------------------------------------------------------------------------- --
+-- Unsafe versions of functions that return Maybe
+
+unsafeFind :: HasCallStack => Foldable t => (a -> Bool) -> t a -> a
+unsafeFind a b = case find a b of
+    Nothing -> error "Data.List.Unsafe.unsafeFind: not found"
+    Just x -> x
+

lib/unsafe/src/Data/List/Unsafe.hs

@@ -0,0 +1,97 @@
+{-# LANGUAGE CPP #-}
+
+#if MIN_VERSION_base(4,20,0)
+{-# OPTIONS_GHC -Wno-x-partial #-}
+#endif
+
+-- |
+-- Module: Data.List.Unsafe
+-- Copyright: Copyright © 2024 Kadena LLC.
+-- License: MIT
+-- Maintainer: Pact Team
+-- Stability: experimental
+--
+-- This module provides unsafe versions for all functions in "Data.List" that
+-- are either partial or return a 'Maybe' value.
+--
+module Data.List.Unsafe
+(
+-- * Unsafe versions of partial functions
+  unsafeHead
+, unsafeLast
+, unsafeTail
+, unsafeInit
+, unsafeIndex
+, unsafeGenericIndex
+
+-- * Unsafe versions of functions that return 'Maybe' values
+, unsafeUncons
+#if MIN_VERSION_base(4,19,0)
+, unsafeUnsnoc
+#endif
+, unsafeLookup
+, unsafeElemIndex
+, unsafeFindIndex
+, unsafeStripPrefix
+) where
+
+import Data.List
+
+import GHC.Stack
+
+-- -------------------------------------------------------------------------- --
+-- Unsafe versions of partial functions
+
+unsafeHead :: HasCallStack => [a] -> a
+unsafeHead = head
+
+unsafeLast :: HasCallStack => [a] -> a
+unsafeLast = last
+
+unsafeTail :: HasCallStack => [a] -> [a]
+unsafeTail = tail
+
+unsafeInit :: HasCallStack => [a] -> [a]
+unsafeInit = init
+
+unsafeIndex :: HasCallStack => [a] -> Int -> a
+unsafeIndex = (!!)
+
+unsafeGenericIndex :: Integral i => [a] -> i -> a
+unsafeGenericIndex = genericIndex
+
+-- -------------------------------------------------------------------------- --
+-- Unsafe versions of functions that return Maybe
+
+unsafeUncons :: HasCallStack => [a] -> (a, [a])
+unsafeUncons a = case uncons a of
+    Nothing -> error "Data.List.Unsafe.unsafeUncons: empty list"
+    Just x -> x
+
+#if MIN_VERSION_base(4,19,0)
+unsafeUnsnoc :: [a] -> ([a], a)
+unsafeUnsnoc a = case unsnoc a of
+    Nothing -> error "Data.List.Unsafe.unsafeUnsnoc: empty list"
+    Just x -> x
+#endif
+
+unsafeLookup :: HasCallStack => Eq a => a -> [(a,b)] -> b
+unsafeLookup a b = case lookup a b of
+    Nothing -> error "Data.List.Unsafe.unsafeLookup: not found"
+    Just x -> x
+
+unsafeElemIndex :: Eq a => a -> [a] -> Int
+unsafeElemIndex a b = case elemIndex a b of
+    Nothing -> error "Data.List.Unsafe.unsafeElemIndex: not found"
+    Just x -> x
+
+unsafeFindIndex :: (a -> Bool) -> [a] -> Int
+unsafeFindIndex a b = case findIndex a b of
+    Nothing -> error "Data.List.Unsafe.unsafeFindIndex: not found"
+    Just x -> x
+
+unsafeStripPrefix :: Eq a => [a] -> [a] -> [a]
+unsafeStripPrefix a b = case stripPrefix a b of
+    Nothing -> error "Data.List.Unsafe.unsafeStripPrefix: not found"
+    Just x -> x
+

pact.cabal

@@ -1,4 +1,4 @@
-cabal-version:       2.2
+cabal-version:       3.0
 name:                pact
 version:             4.12
 -- ^ 4 digit is prerelease, 3- or 2-digit for prod release
@@ -64,6 +64,22 @@ library pact-prettyprinter
     , ansi-terminal >=0.4
     , prettyprinter >= 1.7
 
+-- -------------------------------------------------------------------------- --
+-- Internal: unsafe functions from base
+--
+-- This is to avoid cluttering production code with
+-- `{-# OPTIONS_GHC -Wno-x-partial #-}` pragmas with base >= 4.20
+
+library unsafe
+  visibility: public
+  hs-source-dirs: lib/unsafe/src
+  default-language: Haskell2010
+  exposed-modules:
+    Data.Foldable.Unsafe
+    Data.List.Unsafe
+  build-depends:
+    , base >= 4.5 && < 5
+
 -- -------------------------------------------------------------------------- --
 -- Pact library
 
@@ -198,6 +214,7 @@ library
   build-depends:
     -- internal
     , pact-prettyprinter
+    , pact:unsafe
 
     -- external
     , Decimal >=0.4.2
@@ -236,7 +253,7 @@ library
     , mod >=0.1.2
     , mtl >=2.3
     , pact-json >=0.1
-    , pact-time >=0.2
+    , pact-time >=0.3.0.1
     , parsers >=0.12.4
     , poly >=0.5.0
     , primitive >=0.8
@@ -260,7 +277,6 @@ library
     , utf8-string >=1.0.1.1
     , vector >=0.11.0.0
     , vector-algorithms >=0.7
-    , vector-space >=0.10.4
     , wide-word >= 0.1
     , yaml
 
@@ -424,7 +440,6 @@ test-suite hspec
     , attoparsec
     , base
     , base16-bytestring
-    , base64-bytestring
     , binary
     , bound
     , bytestring
@@ -445,7 +460,6 @@ test-suite hspec
     , trifecta
     , unordered-containers
     , vector
-    , wide-word >= 0.1
 
   other-modules:
     Blake2Spec

src-tool/Pact/Analyze/Feature.hs

@@ -12,7 +12,9 @@
 module Pact.Analyze.Feature where
 
 import           Control.Lens           (Prism', preview, prism', review)
+#if !MIN_VERSION_base(4,20,0)
 import           Data.Foldable          (foldl')
+#endif
 import qualified Data.Map               as Map
 import           Data.Map.Strict        (Map)
 import           Data.Set               (Set)

src-tool/Pact/Analyze/Translate.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE GADTs                      #-}
@@ -32,8 +33,13 @@ import           Control.Monad.Reader       (MonadReader (local),
                                              ReaderT (runReaderT))
 import           Control.Monad.State.Strict (MonadState, StateT, evalStateT,
                                              modify', runStateT)
+#if MIN_VERSION_base(4,20,0)
+import           Data.Foldable              (for_, foldlM)
+#else
 import           Data.Foldable              (foldl', for_, foldlM)
+#endif
 import           Data.List                  (sort)
+import           Data.List.Unsafe           (unsafeTail)
 import qualified Data.Map                   as Map
 import           Data.Map.Strict            (Map)
 import           Data.Maybe                 (fromMaybe, isNothing)
@@ -754,7 +760,7 @@ translatePact nodes = do
     -- The proper fix is recognizing the nested defpact dyn invoke and replacing it with
     -- the default value of what the invocation would return.
     -- For now, this unblocks the problem.
-    (if null protoSteps then [] else tail $ reverse protoSteps)
+    (if null protoSteps then [] else unsafeTail $ reverse protoSteps)
 
   let steps = zipWith3
         (\(Step exec p e _ _) mCancel mRb -> Step exec p e mCancel mRb)

src-tool/Pact/Analyze/Types/Shared.hs

@@ -35,7 +35,6 @@ import           Control.Lens                 (At (at), Index, Iso, IxValue,
                                                makePrisms, over, (%~), (&),
                                                (<&>))
 import           Data.Aeson                   (FromJSON)
-import           Data.AffineSpace             ((.+^), (.-.))
 import           Data.Coerce                  (Coercible, coerce)
 import           Data.Constraint              (Dict (Dict), withDict)
 import           Data.Data                    (Data, Proxy, Typeable)
@@ -69,6 +68,7 @@ import           Data.Type.Equality           ((:~:) (Refl))
 import           GHC.TypeLits                 (KnownSymbol, SomeSymbol(..), Symbol, symbolVal, someSymbolVal)
 import           Prelude                      hiding (Float)
 
+import           Pact.Time                    ((.-.), (.+^))
 import           Pact.Types.Pretty            hiding (list)
 import qualified Pact.Types.Pretty            as Pretty
 import qualified Pact.Types.Lang              as Pact

src/Crypto/Hash/PoseidonNative.hs

@@ -1,13 +1,16 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Crypto.Hash.PoseidonNative (poseidon) where
 
+#if !MIN_VERSION_base(4,20,0)
 import Data.List(foldl')
+#endif
 import qualified Data.Primitive.Array as Array
 import qualified Data.Primitive.SmallArray as SmallArray
 

src/Pact/ApiReq.hs

@@ -55,6 +55,7 @@ import qualified Data.ByteString.Short as SBS
 import Data.Default (def)
 import Data.Foldable
 import Data.List
+import Data.List.Unsafe
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Set as S
 import qualified Data.Map.Strict as Map
@@ -280,7 +281,7 @@ combineSigDatas sds outputLocal = do
   when (S.size hashes /= 1 || S.size cmds /= 1) $ do
     error "SigData files must contain exactly one unique hash and command.  Aborting..."
   let sigs = foldl1 f $ map _sigDataSigs sds
-  returnCommandIfDone outputLocal $ SigData (head $ S.toList hashes) sigs (Just $ head $ S.toList cmds)
+  returnCommandIfDone outputLocal $ SigData (unsafeHead $ S.toList hashes) sigs (Just $ unsafeHead $ S.toList cmds)
   where
     f accum sigs
       | length accum /= length sigs = error "Sig lists have different lengths"

src/Pact/Eval.hs

@@ -65,6 +65,7 @@ import Data.Functor.Classes
 import Data.Graph
 import qualified Data.HashMap.Strict as HM
 import Data.IORef
+import Data.List.Unsafe
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Vector as V
@@ -661,7 +662,7 @@ enforceAcyclic
 enforceAcyclic info cs = forM cs $ \c -> case c of
   AcyclicSCC v -> return v
   CyclicSCC vs -> do
-    let i = if null vs then info else _tInfo $ view _1 $ head vs
+    let i = if null vs then info else _tInfo $ view _1 $ unsafeHead vs
         pl = over (traverse . _3) (SomeDoc . prettyList)
           $ over (traverse . _1) (fmap mkSomeDoc)
           $ vs

src/Pact/Native/Pairing.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -55,7 +56,11 @@ import Data.Group(Group(..))
 import Data.Euclidean (Euclidean, GcdDomain)
 import Data.Semiring (Semiring, Ring)
 import Data.Field (Field)
+#if MIN_VERSION_base(4,20,0)
+import Data.Foldable (forM_, traverse_)
+#else
 import Data.Foldable (forM_, foldl', traverse_)
+#endif
 import qualified Data.Vector as G
 import qualified Data.Vector.Mutable as MG
 import qualified Data.Semiring as SR

src/Pact/Native/Time.hs

@@ -23,10 +23,8 @@ module Pact.Native.Time
 import Control.Monad
 import Prelude
 import Data.Decimal
-import Data.AffineSpace
 import Data.Text (Text, pack, unpack)
 import Pact.Time
-
 import Pact.Types.Pretty
 import Pact.Types.Runtime
 import Pact.Native.Internal