diff --git a/pact.cabal b/pact.cabal index 9b0c9275b..2fffc0766 100644 --- a/pact.cabal +++ b/pact.cabal @@ -214,6 +214,7 @@ library build-depends: -- internal , pact-prettyprinter + , pact:unsafe -- external , Decimal >=0.4.2 diff --git a/src-tool/Pact/Analyze/Feature.hs b/src-tool/Pact/Analyze/Feature.hs index 9e7743267..ae4467c6f 100644 --- a/src-tool/Pact/Analyze/Feature.hs +++ b/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,10,0) import Data.Foldable (foldl') +#endif import qualified Data.Map as Map import Data.Map.Strict (Map) import Data.Set (Set) diff --git a/src-tool/Pact/Analyze/Translate.hs b/src-tool/Pact/Analyze/Translate.hs index 2442ea1bd..ff07f670a 100644 --- a/src-tool/Pact/Analyze/Translate.hs +++ b/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,10,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) diff --git a/src/Crypto/Hash/PoseidonNative.hs b/src/Crypto/Hash/PoseidonNative.hs index b89644908..f46960c21 100644 --- a/src/Crypto/Hash/PoseidonNative.hs +++ b/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,10,0) import Data.List(foldl') +#endif import qualified Data.Primitive.Array as Array import qualified Data.Primitive.SmallArray as SmallArray diff --git a/src/Pact/ApiReq.hs b/src/Pact/ApiReq.hs index de9e74647..43000027c 100644 --- a/src/Pact/ApiReq.hs +++ b/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" diff --git a/src/Pact/Eval.hs b/src/Pact/Eval.hs index 08ce3271a..4cb65fd75 100644 --- a/src/Pact/Eval.hs +++ b/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 diff --git a/src/Pact/Native/Pairing.hs b/src/Pact/Native/Pairing.hs index 2ede0ed7a..eead674b5 100644 --- a/src/Pact/Native/Pairing.hs +++ b/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,10,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 diff --git a/src/Pact/Repl/Lib.hs b/src/Pact/Repl/Lib.hs index 3d59ea09c..412829074 100644 --- a/src/Pact/Repl/Lib.hs +++ b/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,10,0) import Data.Foldable +#endif import Data.IORef import qualified Data.Map.Strict as M import qualified Data.HashMap.Strict as HM diff --git a/src/Pact/Typechecker.hs b/src/Pact/Typechecker.hs index db26923a8..ca60705e0 100644 --- a/src/Pact/Typechecker.hs +++ b/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)