Skip to content

Commit

Permalink
fmt haskell
Browse files Browse the repository at this point in the history
  • Loading branch information
@stanislav-az
stanislav-az committed Jun 14, 2021
1 parent 2d465c3 commit 18ff764
Show file tree
Hide file tree
Showing 8 changed files with 88 additions and 45 deletions.
29 changes: 19 additions & 10 deletions MetaLamp/lending-pool/generate-purs/AaveTypes.hs
View file
Expand Up @@ -11,19 +11,28 @@

module AaveTypes where

import Language.PureScript.Bridge (BridgePart, Language (Haskell), SumType,
TypeInfo (TypeInfo), buildBridge, equal, genericShow,
haskType, mkSumType, order, typeModule, typeName,
writePSTypesWith, (^==), PSType, psTypeParameters)
import Data.Proxy (Proxy (Proxy))
import qualified Plutus.Contracts.Core as Aave
import qualified Plutus.Contracts.Endpoints as Aave
import Plutus.PAB.Simulation (AaveContracts(..))
import Language.PureScript.Bridge.TypeParameters (A)
import Control.Monad.Reader (MonadReader)
import Data.Proxy (Proxy (Proxy))
import Language.PureScript.Bridge (BridgePart,
Language (Haskell),
PSType, SumType,
TypeInfo (TypeInfo),
buildBridge, equal,
genericShow,
haskType, mkSumType,
order,
psTypeParameters,
typeModule,
typeName,
writePSTypesWith,
(^==))
import Language.PureScript.Bridge.Builder (BridgeData)
import Language.PureScript.Bridge.TypeParameters (A)
import qualified PSGenerator.Common
import Plutus.V1.Ledger.Value (AssetClass)
import qualified Plutus.Contracts.Core as Aave
import qualified Plutus.Contracts.Endpoints as Aave
import Plutus.PAB.Simulation (AaveContracts (..))
import Plutus.V1.Ledger.Value (AssetClass)

ratioBridge :: BridgePart
ratioBridge = do
Expand Down
77 changes: 54 additions & 23 deletions MetaLamp/lending-pool/generate-purs/Main.hs
View file
@@ -1,5 +1,6 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
Expand All @@ -8,55 +9,85 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE EmptyDataDecls #-}

module Main where

import Cardano.Metadata.Types (AnnotatedSignature, HashFunction, Property, PropertyKey,
Subject, SubjectProperties)
import AaveTypes (aaveTypes,
ratioBridge)
import Cardano.Metadata.Types (AnnotatedSignature,
HashFunction,
Property,
PropertyKey,
Subject,
SubjectProperties)
import Cardano.Wallet.Types (WalletInfo)
import Control.Applicative ((<|>))
import Control.Lens (set, view, (&))
import Control.Monad.Freer.Extras.Log (LogLevel, LogMessage)
import Control.Monad (when)
import Control.Monad.Freer.Extras.Log (LogLevel,
LogMessage)
import Data.Proxy (Proxy (Proxy))
import qualified Data.Text as Text
import Language.PureScript.Bridge (BridgePart, Language (Haskell), SumType,
TypeInfo (TypeInfo), buildBridge, equal, genericShow,
haskType, mkSumType, order, typeModule, typeName,
writePSTypesWith, (^==))
import Language.PureScript.Bridge.CodeGenSwitches (ForeignOptions (ForeignOptions), genForeign,
import Language.PureScript.Bridge (BridgePart,
Language (Haskell),
SumType,
TypeInfo (TypeInfo),
buildBridge, equal,
genericShow,
haskType,
mkSumType, order,
typeModule,
typeName,
writePSTypesWith,
(^==))
import Language.PureScript.Bridge.CodeGenSwitches (ForeignOptions (ForeignOptions),
genForeign,
unwrapSingleConstructors)
import Language.PureScript.Bridge.TypeParameters (A)
import Ledger.Constraints.OffChain (UnbalancedTx)
import qualified PSGenerator.Common
import Plutus.Contract.Checkpoint (CheckpointKey, CheckpointStore, CheckpointStoreItem)
import Plutus.Contract.Checkpoint (CheckpointKey,
CheckpointStore,
CheckpointStoreItem)
import Plutus.Contract.Effects.AwaitSlot (WaitingForSlot)
import Plutus.Contract.Effects.AwaitTxConfirmed (TxConfirmed)
import Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint, EndpointValue)
import Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint,
EndpointValue)
import Plutus.Contract.Effects.Instance (OwnIdRequest)
import Plutus.Contract.Effects.OwnPubKey (OwnPubKeyRequest)
import Plutus.Contract.Effects.UtxoAt (UtxoAtAddress)
import Plutus.Contract.Effects.WriteTx (WriteTxResponse)
import Plutus.Contract.Resumable (Responses)
import Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
import Plutus.PAB.Events.Contract (ContractPABRequest, ContractPABResponse)
import Plutus.PAB.Events.Contract (ContractPABRequest,
ContractPABResponse)
import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse)
import qualified Plutus.PAB.Webserver.API as API
import Plutus.PAB.Webserver.Types (ChainReport, CombinedWSStreamToClient,
CombinedWSStreamToServer, ContractActivationArgs,
ContractInstanceClientState, ContractReport,
ContractSignatureResponse, FullReport,
import Plutus.PAB.Webserver.Types (ChainReport,
CombinedWSStreamToClient,
CombinedWSStreamToServer,
ContractActivationArgs,
ContractInstanceClientState,
ContractReport,
ContractSignatureResponse,
FullReport,
InstanceStatusToClient)
import Plutus.V1.Ledger.Value (AssetClass,
TokenName (..))
import Servant ((:<|>))
import Servant.PureScript (HasBridge, Settings, _generateSubscriberAPI, apiModuleName,
defaultBridge, defaultSettings, languageBridge,
import Servant.PureScript (HasBridge,
Settings,
_generateSubscriberAPI,
apiModuleName,
defaultBridge,
defaultSettings,
languageBridge,
writeAPIModuleWithSettings)
import Wallet.Effects (AddressChangeRequest (..), AddressChangeResponse (..))
import System.Directory (doesDirectoryExist,
removeDirectoryRecursive)
import Wallet.Effects (AddressChangeRequest (..),
AddressChangeResponse (..))
import Wallet.Emulator.Wallet (Wallet (..))
import AaveTypes (aaveTypes, ratioBridge)
import System.Directory (removeDirectoryRecursive, doesDirectoryExist)
import Plutus.V1.Ledger.Value (AssetClass, TokenName (..))
import Control.Monad (when)

myBridge :: BridgePart
myBridge =
Expand Down
2 changes: 1 addition & 1 deletion MetaLamp/lending-pool/pab-simulation/Main.hs
View file
@@ -1,4 +1,4 @@
import Plutus.PAB.Simulation (runLendingPoolSimulation)
import Plutus.PAB.Simulation (runLendingPoolSimulation)

main :: IO ()
main = runLendingPoolSimulation
9 changes: 5 additions & 4 deletions MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs
View file
Expand Up @@ -13,17 +13,18 @@ import Ledger (Address (Address),
ValidatorHash, Value, findDatum)
import Plutus.V1.Ledger.Credential (Credential (PubKeyCredential, ScriptCredential))
import qualified PlutusTx
import PlutusTx.Prelude (Eq ((==)), Maybe (..), find, fst,filter,otherwise,
mapMaybe, mconcat, snd, ($), (.),
(<$>), (>>=))
import PlutusTx.Prelude (Eq ((==)), Maybe (..), filter,
find, fst, mapMaybe, mconcat,
otherwise, snd, ($), (.), (<$>),
(>>=))

{-# INLINABLE findOnlyOneDatumHashByValue #-}
-- | Find the hash of a datum, if it is part of the script's outputs.
-- Assume search failed if more than one correspondence is found.
findOnlyOneDatumHashByValue :: Value -> [(DatumHash, Value)] -> Maybe DatumHash
findOnlyOneDatumHashByValue val outs = fst <$> case filter f outs of
[res] -> Just res
_ -> Nothing
_ -> Nothing
where
f (_, val') = val' == val

Expand Down
5 changes: 3 additions & 2 deletions MetaLamp/lending-pool/src/Plutus/Contracts/Core.hs
View file
Expand Up @@ -24,8 +24,9 @@ import qualified Data.Map as Map
import Data.Text (Text, pack)
import Data.Void (Void)
import Ext.Plutus.Ledger.Contexts (findOnlyOneDatumHashByValue,
findValueByDatumHash,scriptInputsAt,
parseDatum, valueSpentFrom)
findValueByDatumHash,
parseDatum, scriptInputsAt,
valueSpentFrom)
import Ledger hiding (singleton)
import Ledger.Constraints as Constraints
import Ledger.Constraints.OnChain as Constraints
Expand Down
3 changes: 2 additions & 1 deletion MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs
View file
Expand Up @@ -53,7 +53,8 @@ import qualified PlutusTx.AssocMap as AssocMap
import PlutusTx.Prelude hiding (Monoid (..),
Semigroup (..), mconcat,
unless)
import Prelude (Monoid (..), Semigroup (..), show, subtract)
import Prelude (Monoid (..), Semigroup (..),
show, subtract)
import qualified Prelude
import Text.Printf (printf)

Expand Down
4 changes: 2 additions & 2 deletions MetaLamp/lending-pool/src/Plutus/Contracts/TxUtils.hs
View file
Expand Up @@ -18,8 +18,8 @@ import Ledger hiding (singleton)
import qualified Ledger.Constraints as Constraints
import qualified Ledger.Constraints.OnChain as Constraints
import qualified Ledger.Constraints.TxConstraints as Constraints
import Ledger.Typed.Scripts (MonetaryPolicy,
TypedValidator, RedeemerType, DatumType)
import Ledger.Typed.Scripts (DatumType, MonetaryPolicy,
RedeemerType, TypedValidator)
import qualified Ledger.Typed.Scripts as Scripts
import Plutus.Contract
import Plutus.Contracts.Core (Aave, Reserve (..))
Expand Down
4 changes: 2 additions & 2 deletions MetaLamp/lending-pool/src/Plutus/State/Update.hs
View file
Expand Up @@ -22,14 +22,14 @@ import qualified Data.Map as Map
import Data.Text (Text, pack)
import qualified Data.Text as Text
import Data.Void (Void)
import Ext.Plutus.Ledger.Contexts (scriptInputsAt)
import Ledger hiding (getDatum, singleton)
import Ledger.Constraints as Constraints
import Ledger.Constraints.OnChain as Constraints
import Ledger.Constraints.TxConstraints as Constraints
import qualified Ledger.Scripts as UntypedScripts
import Ledger.Typed.Scripts (DatumType, RedeemerType)
import qualified Ledger.Typed.Scripts as Scripts
import Ledger.Typed.Scripts (RedeemerType, DatumType)
import Ext.Plutus.Ledger.Contexts (scriptInputsAt)
import Playground.Contract
import Plutus.Contract hiding (when)
import qualified Plutus.Contracts.TxUtils as TxUtils
Expand Down

0 comments on commit 18ff764

Please sign in to comment.