From 5e1759006b1292df37d7eaa4f6150c7de8166fee Mon Sep 17 00:00:00 2001 From: jmcardon Date: Wed, 5 Jul 2023 22:24:02 -0400 Subject: [PATCH] remove most strictness changes --- src-ghc/Pact/ApiReq.hs | 12 ++++++------ src-ghc/Pact/GasModel/Utils.hs | 14 +++++++------- src-ghc/Pact/Persist/SQLite.hs | 32 ++++++++++++++++---------------- src-ghc/Pact/Types/Crypto.hs | 6 +++--- src-ghc/Pact/Types/SQLite.hs | 6 +++--- src-ghc/Pact/Types/Server.hs | 32 ++++++++++++++++---------------- src-tool/Pact/Analyze/Alloc.hs | 2 -- src/Crypto/Hash/Blake2Native.hs | 12 ++++++------ src/Pact/Analyze/Remote/Types.hs | 2 +- src/Pact/Compile.hs | 16 ++++++++-------- src/Pact/Gas.hs | 15 +++++++-------- src/Pact/Gas/Table.hs | 30 +++++++++++++++--------------- src/Pact/Persist.hs | 22 +++++++++++----------- src/Pact/Repl/Lib.hs | 2 +- src/Pact/Typechecker.hs | 8 ++++---- src/Pact/Types/API.hs | 12 ++++++------ src/Pact/Types/Capability.hs | 30 +++++++++++++++--------------- src/Pact/Types/ChainMeta.hs | 12 ++++++------ src/Pact/Types/Codec.hs | 8 ++++---- src/Pact/Types/Command.hs | 6 +++--- src/Pact/Types/Continuation.hs | 28 ++++++++++++++-------------- src/Pact/Types/Exp.hs | 8 ++++---- src/Pact/Types/ExpParser.hs | 18 +++++++++--------- src/Pact/Types/KeySet.hs | 4 ++-- src/Pact/Types/Logger.hs | 12 ++++++------ src/Pact/Types/Names.hs | 18 +++++++++--------- 26 files changed, 182 insertions(+), 185 deletions(-) diff --git a/src-ghc/Pact/ApiReq.hs b/src-ghc/Pact/ApiReq.hs index 6ab322fb8..2640396b0 100644 --- a/src-ghc/Pact/ApiReq.hs +++ b/src-ghc/Pact/ApiReq.hs @@ -145,12 +145,12 @@ instance Arbitrary ApiSigner where -- ApiPublicMeta data ApiPublicMeta = ApiPublicMeta - { _apmChainId :: !(Maybe ChainId) - , _apmSender :: !(Maybe Text) - , _apmGasLimit :: !(Maybe GasLimit) - , _apmGasPrice :: !(Maybe GasPrice) - , _apmTTL :: !(Maybe TTLSeconds) - , _apmCreationTime :: !(Maybe TxCreationTime) + { _apmChainId :: Maybe ChainId + , _apmSender :: Maybe Text + , _apmGasLimit :: Maybe GasLimit + , _apmGasPrice :: Maybe GasPrice + , _apmTTL :: Maybe TTLSeconds + , _apmCreationTime :: Maybe TxCreationTime } deriving (Eq, Show, Generic) instance FromJSON ApiPublicMeta where diff --git a/src-ghc/Pact/GasModel/Utils.hs b/src-ghc/Pact/GasModel/Utils.hs index 8704f449b..6d2937ea7 100644 --- a/src-ghc/Pact/GasModel/Utils.hs +++ b/src-ghc/Pact/GasModel/Utils.hs @@ -234,13 +234,13 @@ createPactExpr f (PactExpression arg abridged) = data MockPactType = - MockObject !(HM.HashMap T.Text Integer) - | MockBinding !(HM.HashMap T.Text Integer) - | MockList ![MockPactType] - | MockBool !Bool - | MockInt !Integer - | MockString !T.Text - | MockExpr !T.Text + MockObject (HM.HashMap T.Text Integer) + | MockBinding (HM.HashMap T.Text Integer) + | MockList [MockPactType] + | MockBool Bool + | MockInt Integer + | MockString T.Text + | MockExpr T.Text deriving (Show) toText :: MockPactType -> T.Text diff --git a/src-ghc/Pact/Persist/SQLite.hs b/src-ghc/Pact/Persist/SQLite.hs index 69cc3311f..11aaa8e45 100644 --- a/src-ghc/Pact/Persist/SQLite.hs +++ b/src-ghc/Pact/Persist/SQLite.hs @@ -35,24 +35,24 @@ import qualified Pact.JSON.Encode as J data TableStmts = TableStmts - { sInsertReplace :: !Statement - , sInsert :: !Statement - , sReplace :: !Statement - , sRead :: !Statement + { sInsertReplace :: Statement + , sInsert :: Statement + , sReplace :: Statement + , sRead :: Statement } data TxStmts = TxStmts - { tBegin :: !Statement - , tCommit :: !Statement - , tRollback :: !Statement + { tBegin :: Statement + , tCommit :: Statement + , tRollback :: Statement } data SQLite = SQLite - { conn :: !Database - , config :: !SQLiteConfig - , logger :: !Logger - , tableStmts :: !(M.Map Utf8 TableStmts) - , txStmts :: !TxStmts + { conn :: Database + , config :: SQLiteConfig + , logger :: Logger + , tableStmts :: (M.Map Utf8 TableStmts) + , txStmts :: TxStmts } toUtf8 :: Text -> Utf8 @@ -89,10 +89,10 @@ persister = Persister { } data KeyTys k = KeyTys { - textTy :: !Utf8, - inFun :: !(k -> SType), - outTy :: !RType, - outFun :: !(SType -> IO k) + textTy :: Utf8, + inFun :: k -> SType, + outTy :: RType, + outFun :: SType -> IO k } decodeText :: SType -> IO DataKey diff --git a/src-ghc/Pact/Types/Crypto.hs b/src-ghc/Pact/Types/Crypto.hs index 4ed68b6aa..cfb12f8fd 100644 --- a/src-ghc/Pact/Types/Crypto.hs +++ b/src-ghc/Pact/Types/Crypto.hs @@ -258,9 +258,9 @@ instance ConvertBS (ECDSA.Signature) where -- | Specialized KeyPair datatype for schemes data KeyPair a = KeyPair - { _kpScheme :: !a - , _kpPublicKey :: !(PublicKey a) - , _kpPrivateKey :: !(PrivateKey a) + { _kpScheme :: a + , _kpPublicKey :: PublicKey a + , _kpPrivateKey :: PrivateKey a } instance Scheme a => Show (KeyPair a) where diff --git a/src-ghc/Pact/Types/SQLite.hs b/src-ghc/Pact/Types/SQLite.hs index b535ac644..f594e32ef 100644 --- a/src-ghc/Pact/Types/SQLite.hs +++ b/src-ghc/Pact/Types/SQLite.hs @@ -60,8 +60,8 @@ instance J.Encode Pragma where build (Pragma s) = J.string s data SQLiteConfig = SQLiteConfig - { _dbFile :: !FilePath - , _pragmas :: ![Pragma] + { _dbFile :: FilePath + , _pragmas :: [Pragma] } deriving (Eq,Show,Generic) instance FromJSON SQLiteConfig makeLenses ''SQLiteConfig @@ -76,7 +76,7 @@ instance Arbitrary SQLiteConfig where arbitrary = SQLiteConfig <$> arbitrary <*> arbitrary -- | Statement input types -data SType = SInt !Int64 | SDouble !Double | SText !Utf8 | SBlob !BS.ByteString deriving (Eq,Show) +data SType = SInt Int64 | SDouble Double | SText Utf8 | SBlob BS.ByteString deriving (Eq,Show) -- | Result types data RType = RInt | RDouble | RText | RBlob deriving (Eq,Show) diff --git a/src-ghc/Pact/Types/Server.hs b/src-ghc/Pact/Types/Server.hs index 065587916..fe8a48767 100644 --- a/src-ghc/Pact/Types/Server.hs +++ b/src-ghc/Pact/Types/Server.hs @@ -73,10 +73,10 @@ userSigsToPactKeySet = S.fromList . fmap userSigToPactPubKey data CommandConfig = CommandConfig { - _ccSqlite :: !(Maybe SQLiteConfig) - , _ccEntity :: !(Maybe EntityName) - , _ccGasLimit :: !(Maybe Int) - , _ccGasRate :: !(Maybe Int) + _ccSqlite :: Maybe SQLiteConfig + , _ccEntity :: Maybe EntityName + , _ccGasLimit :: Maybe Int + , _ccGasRate :: Maybe Int , _ccExecutionConfig :: !ExecutionConfig } $(makeLenses ''CommandConfig) @@ -84,15 +84,15 @@ $(makeLenses ''CommandConfig) data CommandEnv p = CommandEnv { - _ceEntity :: !(Maybe EntityName) - , _ceMode :: !ExecutionMode - , _ceDbEnv :: !(PactDbEnv p) - , _ceLogger :: !Logger - , _ceGasEnv :: !GasEnv + _ceEntity :: Maybe EntityName + , _ceMode :: ExecutionMode + , _ceDbEnv :: PactDbEnv p + , _ceLogger :: Logger + , _ceGasEnv :: GasEnv , _cePublicData :: !PublicData , _ceSPVSupport :: !SPVSupport - , _ceNetworkId :: !(Maybe NetworkId) - , _ceExecutionConfig :: !ExecutionConfig + , _ceNetworkId :: Maybe NetworkId + , _ceExecutionConfig :: ExecutionConfig } $(makeLenses ''CommandEnv) @@ -139,8 +139,8 @@ newtype PossiblyIncompleteResults = PossiblyIncompleteResults } deriving (Show, Eq) data ListenerResult = - ListenerResult !(CommandResult Hash) | - GCed !String + ListenerResult (CommandResult Hash) | + GCed String deriving (Show, Eq) data History = @@ -156,8 +156,8 @@ data History = data Inbound = - TxCmds { iCmds :: ![Command ByteString] } | - LocalCmd { iCmd :: !(Command ByteString), - iLocalResult :: !(MVar (CommandResult Hash)) + TxCmds { iCmds :: [Command ByteString] } | + LocalCmd { iCmd :: Command ByteString, + iLocalResult :: MVar (CommandResult Hash) } deriving (Eq) diff --git a/src-tool/Pact/Analyze/Alloc.hs b/src-tool/Pact/Analyze/Alloc.hs index ea45c24e5..c4ed2a0cd 100644 --- a/src-tool/Pact/Analyze/Alloc.hs +++ b/src-tool/Pact/Analyze/Alloc.hs @@ -76,5 +76,3 @@ instance MonadAlloc Alloc where singForAll name ty = Alloc $ withSymVal ty $ sansProv <$> SBV.sbvForall name singExists name ty = Alloc $ withSymVal ty $ sansProv <$> SBV.sbvExists name singFree name ty = Alloc $ withSymVal ty $ sansProv <$> SBV.free name - -- singForAll name ty = Alloc $ withSymVal ty $ sansProv <$> error "sbvForall removed in 10.0" name - -- singExists name ty = Alloc $ withSymVal ty $ sansProv <$> error "sbvExists removed in 10.0" name diff --git a/src/Crypto/Hash/Blake2Native.hs b/src/Crypto/Hash/Blake2Native.hs index 502e74bb4..613c675c5 100644 --- a/src/Crypto/Hash/Blake2Native.hs +++ b/src/Crypto/Hash/Blake2Native.hs @@ -23,12 +23,12 @@ type V = Vector -- | state context data Blake2Ctx w = Blake2Ctx - { _b :: !ByteString -- 128 input buffer - , _h :: !(V w) -- 8 chained state - , _t0 :: !w -- total number of bytes 0 - , _t1 :: !w -- 1 - , _c :: !Int -- pointer for b[] - , _outlen :: !Int -- digest size + { _b :: ByteString -- 128 input buffer + , _h :: V w -- 8 chained state + , _t0 :: w -- total number of bytes 0 + , _t1 :: w -- 1 + , _c :: Int -- pointer for b[] + , _outlen :: Int -- digest size } deriving (Eq) instance (Show w) => Show (Blake2Ctx w) where show (Blake2Ctx b h t0 t1 c outlen) = diff --git a/src/Pact/Analyze/Remote/Types.hs b/src/Pact/Analyze/Remote/Types.hs index 560a2bc6a..75d607529 100644 --- a/src/Pact/Analyze/Remote/Types.hs +++ b/src/Pact/Analyze/Remote/Types.hs @@ -27,7 +27,7 @@ import Pact.Types.Term (ModuleDef, ModuleName, Name) import Test.QuickCheck data Request - = Request ![ModuleDef Name] !ModuleName -- ^ verify one of the modules, by name + = Request [ModuleDef Name] ModuleName -- ^ verify one of the modules, by name deriving (Eq, Show, Generic) instance A.FromJSON Request where diff --git a/src/Pact/Compile.hs b/src/Pact/Compile.hs index cc903796e..b64e4eeef 100644 --- a/src/Pact/Compile.hs +++ b/src/Pact/Compile.hs @@ -66,11 +66,11 @@ import Pact.Types.Util data ModuleState = ModuleState - { _msName :: !ModuleName - , _msHash :: !ModuleHash - , _msBlessed :: ![ModuleHash] - , _msImplements :: ![ModuleName] - , _msImports :: ![Use] + { _msName :: ModuleName + , _msHash :: ModuleHash + , _msBlessed :: [ModuleHash] + , _msImplements :: [ModuleName] + , _msImports :: [Use] } makeLenses ''ModuleState @@ -78,8 +78,8 @@ initModuleState :: ModuleName -> ModuleHash -> ModuleState initModuleState n h = ModuleState n h def def def data CompileState = CompileState - { _csFresh :: !Int - , _csModule :: !(Maybe ModuleState) + { _csFresh :: Int + , _csModule :: Maybe ModuleState } makeLenses ''CompileState @@ -390,7 +390,7 @@ data ModelAllowed = ModelAllowed | ModelNotAllowed -data AtPair = DocPair !Text | ModelPair ![Exp Info] deriving (Eq,Ord) +data AtPair = DocPair Text | ModelPair [Exp Info] deriving (Eq,Ord) modelOnly :: Compile Meta modelOnly = do diff --git a/src/Pact/Gas.hs b/src/Pact/Gas.hs index d650fb053..6fe34274a 100644 --- a/src/Pact/Gas.hs +++ b/src/Pact/Gas.hs @@ -15,7 +15,6 @@ module Pact.Gas , putGas) where -import Control.Monad import Control.Monad.State.Strict import Data.Text import Data.IORef @@ -31,16 +30,16 @@ computeGas i args = do GasEnv {..} <- view eeGasEnv g0 <- getGas let - (!info,!name) = either id (_faInfo &&& _faName) i - !g1 = runGasModel _geGasModel name args - let !gUsed = g0 + g1 - modify' $ over evalLogGas $ (<$!>) ((:) (msg name gUsed, g1)) + (info,name) = either id (_faInfo &&& _faName) i + g1 = runGasModel _geGasModel name args + let gUsed = g0 + g1 + evalLogGas %= fmap ((msg name gUsed, g1):) putGas gUsed if gUsed > fromIntegral _geGasLimit then throwErr GasError info $ "Gas limit (" <> pretty _geGasLimit <> ") exceeded: " <> pretty gUsed else return gUsed where - msg name used = renderCompactText' $! pretty name <> ":" <> pretty args <> ":currTotalGas=" <> pretty used + msg name used = renderCompactText' (pretty name <> ":" <> pretty args <> ":currTotalGas=" <> pretty used) {-# INLINABLE computeGas #-} -- | Performs gas calculation for incremental computations with some caveats: @@ -59,7 +58,7 @@ computeGasNoLog commit info name args = do putGas :: Gas -> Eval e () putGas !g = do - !gasRef <- view eeGas + gasRef <- view eeGas liftIO (writeIORef gasRef g) getGas :: Eval e Gas @@ -76,7 +75,7 @@ computeGasCommit info name args = do g0 <- getGas let !g1 = runGasModel _geGasModel name args !gUsed = g0 + g1 - evalLogGas %= (<$!>) ((renderCompactText' $! pretty name <> ":" <> pretty args <> ":currTotalGas=" <> pretty gUsed,g1):) + evalLogGas %= fmap ((renderCompactText' (pretty name <> ":" <> pretty args <> ":currTotalGas=" <> pretty gUsed),g1):) putGas gUsed if gUsed > fromIntegral _geGasLimit then throwErr GasError info $ "Gas limit (" <> pretty _geGasLimit <> ") exceeded: " <> pretty gUsed diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index c070c4700..d8df68aef 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -32,21 +32,21 @@ import Pact.Types.Term -- able to find instances where GReduced was in present use, so I've removed it for now. data GasCostConfig = GasCostConfig - { _gasCostConfig_primTable :: !(Map Text Gas) - , _gasCostConfig_selectColumnCost :: !Gas -- up-front cost per column in a select operation - , _gasCostConfig_readColumnCost :: !Gas -- cost per column to read a row - , _gasCostConfig_sortFactor :: !Gas - , _gasCostConfig_distinctFactor :: !Gas - , _gasCostConfig_concatenationFactor :: !Gas - , _gasCostConfig_moduleCost :: !Gas - , _gasCostConfig_moduleMemberCost :: !Gas - , _gasCostConfig_useModuleCost :: !Gas - , _gasCostConfig_interfaceCost :: !Gas - , _gasCostConfig_writeBytesCost :: !Gas -- cost per bytes to write to database - , _gasCostConfig_functionApplicationCost :: !Gas - , _gasCostConfig_defPactCost :: !Gas - , _gasCostConfig_foldDBCost :: !Gas - , _gasCostConfig_principalCost :: !Gas + { _gasCostConfig_primTable :: Map Text Gas + , _gasCostConfig_selectColumnCost :: Gas -- up-front cost per column in a select operation + , _gasCostConfig_readColumnCost :: Gas -- cost per column to read a row + , _gasCostConfig_sortFactor :: Gas + , _gasCostConfig_distinctFactor :: Gas + , _gasCostConfig_concatenationFactor :: Gas + , _gasCostConfig_moduleCost :: Gas + , _gasCostConfig_moduleMemberCost :: Gas + , _gasCostConfig_useModuleCost :: Gas + , _gasCostConfig_interfaceCost :: Gas + , _gasCostConfig_writeBytesCost :: Gas -- cost per bytes to write to database + , _gasCostConfig_functionApplicationCost :: Gas + , _gasCostConfig_defPactCost :: Gas + , _gasCostConfig_foldDBCost :: Gas + , _gasCostConfig_principalCost :: Gas } defaultGasConfig :: GasCostConfig diff --git a/src/Pact/Persist.hs b/src/Pact/Persist.hs index 24639cdf1..66316924d 100644 --- a/src/Pact/Persist.hs +++ b/src/Pact/Persist.hs @@ -90,8 +90,8 @@ conjToOp c = fromString $ case c of {-# INLINE conjToOp #-} data KeyQuery k = - KQKey { kqCmp :: !KeyCmp, kqKey :: !k } | - KQConj { kqL :: !(KeyQuery k), kqConj :: !KeyConj, kqR :: !(KeyQuery k) } + KQKey { kqCmp :: KeyCmp, kqKey :: k } | + KQConj { kqL :: KeyQuery k, kqConj :: KeyConj, kqR :: KeyQuery k } deriving (Eq,Show) -- | Convenience for infix usage. @@ -120,23 +120,23 @@ instance PactDbKey TxKey instance PactDbKey DataKey data Persister s = Persister { - createTable :: !(forall k . PactDbKey k => Table k -> Persist s ()) + createTable :: forall k . PactDbKey k => Table k -> Persist s () , - beginTx :: !(ExecutionMode -> Persist s ()) + beginTx :: ExecutionMode -> Persist s () , - commitTx :: !(Persist s ()) + commitTx :: Persist s () , - rollbackTx :: !(Persist s ()) + rollbackTx :: Persist s () , - queryKeys :: !(forall k . PactDbKey k => Table k -> Maybe (KeyQuery k) -> Persist s [k]) + queryKeys :: forall k . PactDbKey k => Table k -> Maybe (KeyQuery k) -> Persist s [k] , - query :: !(forall k v . (PactDbKey k, FromJSON v, Typeable v) => Table k -> Maybe (KeyQuery k) -> Persist s [(k,v)]) + query :: forall k v . (PactDbKey k, FromJSON v, Typeable v) => Table k -> Maybe (KeyQuery k) -> Persist s [(k,v)] , - readValue :: !(forall k v . (PactDbKey k, FromJSON v, Typeable v) => Table k -> k -> Persist s (Maybe v)) + readValue :: forall k v . (PactDbKey k, FromJSON v, Typeable v) => Table k -> k -> Persist s (Maybe v) , - writeValue :: !(forall k . (PactDbKey k) => Table k -> WriteType -> k -> B.ByteString -> Persist s ()) + writeValue :: forall k . (PactDbKey k) => Table k -> WriteType -> k -> B.ByteString -> Persist s () , - refreshConn :: !(Persist s ()) + refreshConn :: Persist s () } _compileQry1 :: (String,[Int]) diff --git a/src/Pact/Repl/Lib.hs b/src/Pact/Repl/Lib.hs index 6f5670df0..1775902b9 100644 --- a/src/Pact/Repl/Lib.hs +++ b/src/Pact/Repl/Lib.hs @@ -405,7 +405,7 @@ setmsg i as = case as of [TObject (Object om _ _ _) _] -> go (toLegacyJsonViaEncode (fmap toPactValueLenient om)) [a] -> go (toLegacyJsonViaEncode a) _ -> argsError i as - where go (v :: LegacyValue) = setenv eeMsgBody v >> return (tStr "Setting transaction data") + where go v = setenv eeMsgBody v >> return (tStr "Setting transaction data") continuePact :: RNativeFun LibState continuePact i as = case as of diff --git a/src/Pact/Typechecker.hs b/src/Pact/Typechecker.hs index 0562b09b7..2a56d059f 100644 --- a/src/Pact/Typechecker.hs +++ b/src/Pact/Typechecker.hs @@ -138,10 +138,10 @@ isConcreteTy ty = not (isAnyTy ty || isVarTy ty) data RoleTys = RoleTys - { _rtCandArgTy :: !(Type UserType) - , _rtAST :: !(AST Node) - , _rtTyVar :: !(TypeVar UserType) - , _rtResolvedTy :: !(Type UserType) + { _rtCandArgTy :: Type UserType + , _rtAST :: AST Node + , _rtTyVar :: TypeVar UserType + , _rtResolvedTy :: Type UserType } instance Show RoleTys where show (RoleTys a b c d) = diff --git a/src/Pact/Types/API.hs b/src/Pact/Types/API.hs index 85bfa9494..4f7d447b5 100644 --- a/src/Pact/Types/API.hs +++ b/src/Pact/Types/API.hs @@ -52,7 +52,7 @@ instance FromJSON RequestKeys where instance J.Encode RequestKeys where build o = J.object [ "requestKeys" J..= J.Array (_rkRequestKeys o) ] - {-# INLINE build #-} + {-# INLINABLE build #-} -- | Submit new commands for execution newtype SubmitBatch = SubmitBatch { _sbCmds :: NonEmpty (Command Text) } @@ -64,7 +64,7 @@ instance FromJSON SubmitBatch where instance J.Encode SubmitBatch where build o = J.object [ "cmds" J..= J.Array (_sbCmds o) ] - {-# INLINE build #-} + {-# INLINABLE build #-} -- | Poll for results by RequestKey newtype Poll = Poll { _pRequestKeys :: NonEmpty RequestKey } @@ -75,7 +75,7 @@ instance FromJSON Poll where instance J.Encode Poll where build o = J.object [ "requestKeys" J..= J.Array (_pRequestKeys o) ] - {-# INLINE build #-} + {-# INLINABLE build #-} -- | What you get back from a Poll newtype PollResponses = PollResponses (HM.HashMap RequestKey (CommandResult Hash)) @@ -87,7 +87,7 @@ instance FromJSON PollResponses where instance J.Encode PollResponses where build (PollResponses m) = J.build $ JL.legacyHashMap asString m - {-# INLINE build #-} + {-# INLINABLE build #-} -- | ListenerRequest for results by RequestKey newtype ListenerRequest = ListenerRequest { _lrListen :: RequestKey } @@ -98,7 +98,7 @@ instance FromJSON ListenerRequest where instance J.Encode ListenerRequest where build o = J.object [ "listen" J..= _lrListen o ] - {-# INLINE build #-} + {-# INLINABLE build #-} -- -------------------------------------------------------------------------- -- -- ListenResponse @@ -125,4 +125,4 @@ instance J.Encode ListenResponse where [ "status" J..= J.text "timeout" , "timeout-micros" J..= J.Aeson i ] - {-# INLINE build #-} + {-# INLINABLE build #-} diff --git a/src/Pact/Types/Capability.hs b/src/Pact/Types/Capability.hs index 6888bf932..82b751f46 100644 --- a/src/Pact/Types/Capability.hs +++ b/src/Pact/Types/Capability.hs @@ -50,8 +50,8 @@ import qualified Pact.JSON.Encode as J data Capability - = CapModuleAdmin !ModuleName - | CapUser !UserCapability + = CapModuleAdmin ModuleName + | CapUser UserCapability deriving (Eq,Show,Ord,Generic) instance NFData Capability @@ -76,7 +76,7 @@ instance J.Encode SigCapability where [ "args" J..= J.Array (_scArgs o) , "name" J..= _scName o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON SigCapability where parseJSON = withObject "SigCapability" $ \o -> SigCapability @@ -91,7 +91,7 @@ instance Arbitrary SigCapability where data CapEvalResult = NewlyAcquired | AlreadyAcquired - | NewlyInstalled !(ManagedCapability UserCapability) + | NewlyInstalled (ManagedCapability UserCapability) deriving (Eq,Show) data CapScope @@ -108,16 +108,16 @@ instance Pretty CapScope where pretty = viaShow -- | Runtime storage of acquired or managed capability. data CapSlot c = CapSlot - { _csScope :: !CapScope - , _csCap :: !c - , _csComposed :: ![c] + { _csScope :: CapScope + , _csCap :: c + , _csComposed :: [c] } deriving (Eq,Show,Ord,Functor,Foldable,Traversable,Generic) instance NFData c => NFData (CapSlot c) -- | Model a managed capability where a user-provided function -- maintains a selected parameter value. data UserManagedCap = UserManagedCap - { _umcManagedValue :: !PactValue + { _umcManagedValue :: PactValue -- ^ mutating value , _umcManageParamIndex :: Int -- ^ index of managed param value in defcap @@ -138,11 +138,11 @@ instance Pretty AutoManagedCap where pretty = viaShow data ManagedCapability c = ManagedCapability - { _mcInstalled :: !(CapSlot c) + { _mcInstalled :: CapSlot c -- ^ original installed capability - , _mcStatic :: !UserCapability + , _mcStatic :: UserCapability -- ^ Cap without any mutating components (for auto, same as cap in installed) - , _mcManaged :: !(Either AutoManagedCap UserManagedCap) + , _mcManaged :: Either AutoManagedCap UserManagedCap -- ^ either auto-managed or user-managed } deriving (Show,Generic,Foldable) @@ -180,14 +180,14 @@ instance NFData a => NFData (ManagedCapability a) -- | Runtime datastructure. data Capabilities = Capabilities - { _capStack :: ![CapSlot UserCapability] + { _capStack :: [CapSlot UserCapability] -- ^ Stack of "acquired" capabilities. - , _capManaged :: !(Set (ManagedCapability UserCapability)) + , _capManaged :: Set (ManagedCapability UserCapability) -- ^ Set of installed managed capabilities. Maybe indicates whether it has been -- initialized from signature set. - , _capModuleAdmin :: !(Set ModuleName) + , _capModuleAdmin :: Set ModuleName -- ^ Set of module admin capabilities. - , _capAutonomous :: !(Set UserCapability) + , _capAutonomous :: Set UserCapability } deriving (Eq,Show,Generic) diff --git a/src/Pact/Types/ChainMeta.hs b/src/Pact/Types/ChainMeta.hs index 95a3a1310..9c657b3a0 100644 --- a/src/Pact/Types/ChainMeta.hs +++ b/src/Pact/Types/ChainMeta.hs @@ -93,8 +93,8 @@ getCurrentCreationTime = TxCreationTime -- | Confidential/Encrypted addressing info, for use in metadata on privacy-supporting platforms. data Address = Address - { _aFrom :: !EntityName - , _aTo :: !(Set EntityName) + { _aFrom :: EntityName + , _aTo :: Set EntityName } deriving (Eq,Show,Ord,Generic) instance NFData Address @@ -108,7 +108,7 @@ instance J.Encode Address where [ "to" J..= J.Array (_aTo o) , "from" J..= _aFrom o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON Address where parseJSON = lensyParseJSON 2 makeLenses ''Address @@ -125,7 +125,7 @@ instance Arbitrary PrivateMeta where instance J.Encode PrivateMeta where build o = J.object [ "address" J..= _pmAddress o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON PrivateMeta where parseJSON = lensyParseJSON 3 instance NFData PrivateMeta @@ -169,7 +169,7 @@ instance J.Encode PublicMeta where , "gasPrice" J..= _pmGasPrice o , "sender" J..= _pmSender o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON PublicMeta where parseJSON = withObject "PublicMeta" $ \o -> PublicMeta @@ -221,7 +221,7 @@ instance J.Encode PublicData where , "prevBlockHash" J..= _pdPrevBlockHash o , "blockHeight" J..= J.Aeson (_pdBlockHeight o) ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON PublicData where parseJSON = lensyParseJSON 3 instance Default PublicData where def = PublicData def def def def diff --git a/src/Pact/Types/Codec.hs b/src/Pact/Types/Codec.hs index 95ff73fc9..b81d29123 100644 --- a/src/Pact/Types/Codec.hs +++ b/src/Pact/Types/Codec.hs @@ -53,10 +53,10 @@ isSafeInteger i = i >= l && i <= h -- | JSON codec pair. data Codec a = Codec { - encoder :: !(a -> J.Builder), - decoder :: !(Value -> Parser a), - valueEncoder :: !(a -> Value), - aesonEncoder :: !(a -> Encoding) + encoder :: a -> J.Builder, + decoder :: Value -> Parser a, + valueEncoder :: a -> Value, + aesonEncoder :: a -> Encoding } -- | Integers encode to an object that uses Number if in reasonable JS bounds or String otherwise. diff --git a/src/Pact/Types/Command.hs b/src/Pact/Types/Command.hs index 7563c2bd1..6b8e5b862 100644 --- a/src/Pact/Types/Command.hs +++ b/src/Pact/Types/Command.hs @@ -115,7 +115,7 @@ instance J.Encode a => J.Encode (Command a) where , "sigs" J..= J.Array (_cmdSigs o) , "cmd" J..= _cmdPayload o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance NFData a => NFData (Command a) @@ -417,8 +417,8 @@ type ApplyCmd l = ExecutionMode -> Command ByteString -> IO (CommandResult l) type ApplyPPCmd m a l = ExecutionMode -> Command ByteString -> ProcessedCommand m a -> IO (CommandResult l) data CommandExecInterface m a l = CommandExecInterface - { _ceiApplyCmd :: !(ApplyCmd l) - , _ceiApplyPPCmd :: !(ApplyPPCmd m a l) + { _ceiApplyCmd :: ApplyCmd l + , _ceiApplyPPCmd :: ApplyPPCmd m a l } diff --git a/src/Pact/Types/Continuation.hs b/src/Pact/Types/Continuation.hs index cea89716f..d7f737a1c 100644 --- a/src/Pact/Types/Continuation.hs +++ b/src/Pact/Types/Continuation.hs @@ -66,9 +66,9 @@ import qualified Pact.JSON.Encode as J -- data to 'endorse' a yield object. -- data Provenance = Provenance - { _pTargetChainId :: !ChainId + { _pTargetChainId :: ChainId -- ^ the target chain id for the endorsement - , _pModuleHash :: !ModuleHash + , _pModuleHash :: ModuleHash -- ^ a hash of current containing module } deriving (Eq, Show, Generic) @@ -177,21 +177,21 @@ instance FromJSON PactContinuation where parseJSON = lensyParseJSON 3 -- | Result of evaluation of a 'defpact'. -- data PactExec = PactExec - { _peStepCount :: !Int + { _peStepCount :: Int -- ^ Count of steps in pact (discovered when code is executed) - , _peYield :: !(Maybe Yield) + , _peYield :: Maybe Yield -- ^ Yield value if invoked - , _peExecuted :: !(Maybe Bool) + , _peExecuted :: Maybe Bool -- ^ Only populated for private pacts, indicates if step was executed or skipped. - , _peStep :: !Int + , _peStep :: Int -- ^ Step that was executed or skipped - , _pePactId :: !PactId + , _pePactId :: PactId -- ^ Pact id. On a new pact invocation, is copied from tx id. - , _peContinuation :: !PactContinuation + , _peContinuation :: PactContinuation -- ^ Strict (in arguments) application of pact, for future step invocations. , _peStepHasRollback :: !Bool -- ^ Track whether a current step has a rollback - , _peNested :: !(Map PactId NestedPactExec) + , _peNested :: Map PactId NestedPactExec -- ^ Track whether a current step has nested defpact evaluation results } deriving (Eq, Show, Generic) @@ -237,19 +237,19 @@ instance FromJSON PactExec where instance Pretty PactExec where pretty = viaShow data NestedPactExec = NestedPactExec - { _npeStepCount :: !Int + { _npeStepCount :: Int -- ^ Count of steps in pact (discovered when code is executed) , _npeYield :: !(Maybe Yield) -- ^ Yield value if invoked - , _npeExecuted :: !(Maybe Bool) + , _npeExecuted :: Maybe Bool -- ^ Only populated for private pacts, indicates if step was executed or skipped. - , _npeStep :: !Int + , _npeStep :: Int -- ^ Step that was executed or skipped - , _npePactId :: !PactId + , _npePactId :: PactId -- ^ Pact id. On a new pact invocation, is copied from tx id. , _npeContinuation :: !PactContinuation -- ^ Strict (in arguments) application of pact, for future step invocations. - , _npeNested :: !(Map PactId NestedPactExec) + , _npeNested :: Map PactId NestedPactExec -- ^ Track whether a current step has nested defpact evaluation results } deriving (Eq, Show, Generic) diff --git a/src/Pact/Types/Exp.hs b/src/Pact/Types/Exp.hs index 4880e3a1e..50c7db123 100644 --- a/src/Pact/Types/Exp.hs +++ b/src/Pact/Types/Exp.hs @@ -366,10 +366,10 @@ instance (SizeOf i) => SizeOf (SeparatorExp i) -- | Pact syntax expressions data Exp i = - ELiteral !(LiteralExp i) | - EAtom !(AtomExp i) | - EList !(ListExp i) | - ESeparator !(SeparatorExp i) + ELiteral (LiteralExp i) | + EAtom (AtomExp i) | + EList (ListExp i) | + ESeparator (SeparatorExp i) deriving (Eq,Ord,Generic,Functor,Foldable,Traversable,Show) instance Pretty (Exp i) where diff --git a/src/Pact/Types/ExpParser.hs b/src/Pact/Types/ExpParser.hs index 7d592d96e..cd2685c36 100644 --- a/src/Pact/Types/ExpParser.hs +++ b/src/Pact/Types/ExpParser.hs @@ -76,8 +76,8 @@ import Pact.Types.KeySet (KeySetName, parseAnyKeysetName) -- | Exp stream type. data Cursor = Cursor - { _cContext :: !(Maybe (Cursor,Exp Info)) - , _cStream :: ![Exp Info] + { _cContext :: Maybe (Cursor,Exp Info) + , _cStream :: [Exp Info] } deriving (Show) instance Default Cursor where def = Cursor def def @@ -102,8 +102,8 @@ instance Stream Cursor where -- | Capture last-parsed Exp, plus arbitrary state. data ParseState a = ParseState - { _psCurrent :: !(Exp Info) - , _psUser :: !a + { _psCurrent :: Exp Info + , _psUser :: a } makeLenses ''ParseState @@ -243,15 +243,15 @@ commit = lift (lift pCommit) {-# INLINE exp #-} exp :: String -> Prism' (Exp Info) a -> ExpParse s (a,Exp Info) exp ty prism = do - !t <- current + t <- current let test i = case firstOf prism i of - Just !a -> Just (a,i) + Just a -> Just (a,i) Nothing -> Nothing - !errs = S.fromList [ + errs = S.fromList [ strErr $ "Expected: " ++ ty, - Tokens $! fromList [t] + Tokens (fromList [t]) ] - !r <- lift $! lift $! pTokenEpsilon test errs + r <- lift $! lift $! pTokenEpsilon test errs psCurrent .= snd r return r diff --git a/src/Pact/Types/KeySet.hs b/src/Pact/Types/KeySet.hs index 280b8c93b..d96182154 100644 --- a/src/Pact/Types/KeySet.hs +++ b/src/Pact/Types/KeySet.hs @@ -164,8 +164,8 @@ instance J.Encode KeySet where data KeySetName = KeySetName - { _ksnName :: !Text - , _ksnNamespace :: !(Maybe NamespaceName) + { _ksnName :: Text + , _ksnNamespace :: Maybe NamespaceName } deriving (Eq, Ord, Show, Generic) instance IsString KeySetName where diff --git a/src/Pact/Types/Logger.hs b/src/Pact/Types/Logger.hs index 8d07e740a..07babd48c 100644 --- a/src/Pact/Types/Logger.hs +++ b/src/Pact/Types/Logger.hs @@ -33,9 +33,9 @@ newtype LogName = LogName String deriving newtype (FromJSON,Hashable,IsString,AsString) data Logger = Logger { - logName :: !LogName, - logDesc :: !(Maybe String), - logLog :: !(String -> String -> IO ()) + logName :: LogName, + logDesc :: Maybe String, + logLog :: String -> String -> IO () } instance Show Logger where show l = T.unpack (asString (logName l)) ++ maybe "" (": " ++) (logDesc l) @@ -54,9 +54,9 @@ logDebug = log "DEBUG" newtype Loggers = Loggers { newLogger :: LogName -> Logger } data LogRule = LogRule { - enable :: !(Maybe Bool), - include :: !(Maybe (HS.HashSet String)), - exclude :: !(Maybe (HS.HashSet String)) + enable :: Maybe Bool, + include :: Maybe (HS.HashSet String), + exclude :: Maybe (HS.HashSet String) } deriving (Eq,Generic) instance FromJSON LogRule diff --git a/src/Pact/Types/Names.hs b/src/Pact/Types/Names.hs index 46e2a21e8..197b33d3c 100644 --- a/src/Pact/Types/Names.hs +++ b/src/Pact/Types/Names.hs @@ -77,8 +77,8 @@ instance Arbitrary NamespaceName where arbitrary = NamespaceName <$> genBareText data ModuleName = ModuleName - { _mnName :: !Text - , _mnNamespace :: !(Maybe NamespaceName) + { _mnName :: Text + , _mnNamespace :: Maybe NamespaceName } deriving (Eq, Ord, Generic, Show) instance Arbitrary ModuleName where @@ -153,9 +153,9 @@ instance Arbitrary DefName where arbitrary = DefName <$> genBareText data QualifiedName = QualifiedName - { _qnQual :: !ModuleName - , _qnName :: !Text - , _qnInfo :: !Info + { _qnQual :: ModuleName + , _qnName :: Text + , _qnInfo :: Info } deriving (Generic,Show) instance Arbitrary QualifiedName where @@ -295,10 +295,10 @@ instance Arbitrary FullyQualifiedName where -- | A named reference from source. data Name - = QName !QualifiedName - | Name !BareName - | DName !DynamicName - | FQName !FullyQualifiedName + = QName QualifiedName + | Name BareName + | DName DynamicName + | FQName FullyQualifiedName deriving (Generic, Show) instance Arbitrary Name where