fix compiler warnings with GHC-9.10

Author: larskuhtz

pact.cabal

@@ -214,6 +214,7 @@ library
   build-depends:
     -- internal
     , pact-prettyprinter
+    , pact:unsafe
 
     -- external
     , Decimal >=0.4.2

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/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/Repl/Lib.hs

@@ -32,7 +32,9 @@ import Control.Monad.State.Strict (get,put)
 import Data.Aeson (eitherDecode)
 import qualified Data.ByteString.Lazy as BSL
 import Data.Default
+#if !MIN_VERSION_base(4,20,0)
 import Data.Foldable
+#endif
 import Data.IORef
 import qualified Data.Map.Strict as M
 import qualified Data.HashMap.Strict as HM

src/Pact/Typechecker.hs

@@ -44,6 +44,7 @@ import Data.Default
 import Data.Foldable
 import qualified Data.HashMap.Strict as HM
 import Data.List
+import Data.List.Unsafe (unsafeHead)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as M
@@ -1006,7 +1007,7 @@ toAST (TApp Term.App{..} _) = do
               return app'
             Resume -> do
               app' <- specialBind
-              case head args' of -- 'specialBind' ensures non-empty args
+              case unsafeHead args' of -- 'specialBind' ensures non-empty args
                 (Binding _ _ _ (AstBindSchema sty)) ->
                   setOrAssocYR yrResume sty
                 a -> die'' a "Expected binding"
@@ -1205,7 +1206,7 @@ showFails = do
 
 -- | unsafe lens for using `typecheckBody` with const
 singLens :: Iso' a [a]
-singLens = iso pure head
+singLens = iso pure unsafeHead
 
 -- | Typecheck a top-level production.
 typecheck :: TopLevel Node -> TC (TopLevel Node)