make hlint happy
This commit is contained in:
parent
3a1fba39b9
commit
e4d1fdfbed
8 changed files with 45 additions and 43 deletions
2
.github/workflows/integrate.yaml
vendored
2
.github/workflows/integrate.yaml
vendored
|
|
@ -56,7 +56,7 @@ jobs:
|
||||||
name: mlabs
|
name: mlabs
|
||||||
authToken: ${{ secrets.CACHIX_KEY }}
|
authToken: ${{ secrets.CACHIX_KEY }}
|
||||||
|
|
||||||
- run: nix run nixpkgs#hlint -- $(git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.hs')
|
- run: nix run nixpkgs#haskell.packages.ghc921.hlint -- $(git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.hs')
|
||||||
name: Run hlint
|
name: Run hlint
|
||||||
|
|
||||||
check-build:
|
check-build:
|
||||||
|
|
|
||||||
|
|
@ -1,3 +1,4 @@
|
||||||
name,cpu,mem,size
|
name,cpu,mem,size
|
||||||
full_scripts:authorityTokenPolicy,1399431,4800,421
|
full_scripts:authorityTokenPolicy,1399431,4800,421
|
||||||
full_scripts:stakePolicy,3662179,12400,1572
|
full_scripts:stakePolicy,3751498,12700,1610
|
||||||
|
full_scripts:stakeValidator,3126265,10600,1500
|
||||||
|
|
|
||||||
|
|
|
@ -76,15 +76,18 @@
|
||||||
let
|
let
|
||||||
pkgs = nixpkgsFor system;
|
pkgs = nixpkgsFor system;
|
||||||
pkgs' = nixpkgsFor' system;
|
pkgs' = nixpkgsFor' system;
|
||||||
|
inherit (pkgs.haskell-nix.tools ghcVersion {
|
||||||
|
inherit (plutarch.tools) fourmolu hlint;
|
||||||
|
})
|
||||||
|
fourmolu hlint;
|
||||||
in pkgs.runCommand "format-check" {
|
in pkgs.runCommand "format-check" {
|
||||||
nativeBuildInputs = [
|
nativeBuildInputs = [
|
||||||
pkgs'.git
|
pkgs'.git
|
||||||
pkgs'.fd
|
pkgs'.fd
|
||||||
pkgs'.haskellPackages.cabal-fmt
|
pkgs'.haskellPackages.cabal-fmt
|
||||||
pkgs'.nixpkgs-fmt
|
pkgs'.nixpkgs-fmt
|
||||||
(pkgs.haskell-nix.tools ghcVersion {
|
fourmolu
|
||||||
inherit (plutarch.tools) fourmolu;
|
hlint
|
||||||
}).fourmolu
|
|
||||||
];
|
];
|
||||||
} ''
|
} ''
|
||||||
export LC_CTYPE=C.UTF-8
|
export LC_CTYPE=C.UTF-8
|
||||||
|
|
|
||||||
|
|
@ -20,7 +20,7 @@ import Prelude
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
import Agora.Utils (passetClassValueOf, passetClassValueOf')
|
import Agora.Utils (passert, passetClassValueOf, passetClassValueOf')
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
@ -46,9 +46,9 @@ authorityTokenPolicy params =
|
||||||
ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
||||||
PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo
|
PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo
|
||||||
txInfo <- pletFields @'["inputs", "mint"] txInfo'
|
txInfo <- pletFields @'["inputs", "mint"] txInfo'
|
||||||
let inputs = txInfo.inputs :: Term _ (PBuiltinList (PAsData PTxInInfo))
|
let inputs = txInfo.inputs
|
||||||
let authorityTokenInputs =
|
let authorityTokenInputs =
|
||||||
pfoldr'
|
pfoldr' @PBuiltinList
|
||||||
( \txInInfo' acc -> P.do
|
( \txInInfo' acc -> P.do
|
||||||
PTxInInfo txInInfo <- pmatch (pfromData txInInfo')
|
PTxInInfo txInInfo <- pmatch (pfromData txInInfo')
|
||||||
PTxOut txOut' <- pmatch $ pfromData $ pfield @"resolved" # txInInfo
|
PTxOut txOut' <- pmatch $ pfromData $ pfield @"resolved" # txInInfo
|
||||||
|
|
@ -60,17 +60,10 @@ authorityTokenPolicy params =
|
||||||
# inputs
|
# inputs
|
||||||
let mintedValue = pfromData txInfo.mint
|
let mintedValue = pfromData txInfo.mint
|
||||||
let tokenMoved = 0 #< authorityTokenInputs
|
let tokenMoved = 0 #< authorityTokenInputs
|
||||||
PMinting sym' <- pmatch $ pfromData ctx.purpose
|
PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose
|
||||||
let sym = pfromData $ pfield @"_0" # sym'
|
let ownSymbol = pfromData $ pfield @"_0" # ownSymbol'
|
||||||
let mintedATs = passetClassValueOf # sym # pconstant "" # mintedValue
|
let mintedATs = passetClassValueOf # ownSymbol # pconstant "" # mintedValue
|
||||||
pif
|
pif
|
||||||
(0 #< mintedATs)
|
(0 #< mintedATs)
|
||||||
( pif
|
(passert "Authority token did not move in minting GATs" tokenMoved (pconstant ()))
|
||||||
tokenMoved
|
|
||||||
-- The authority token moved, we are good to go for minting.
|
|
||||||
(pconstant ())
|
|
||||||
(ptraceError "Authority token did not move in minting GATs")
|
|
||||||
)
|
|
||||||
-- We minted 0 or less Authority Tokens, we are good to go.
|
|
||||||
-- Burning is always allowed.
|
|
||||||
(pconstant ())
|
(pconstant ())
|
||||||
|
|
|
||||||
|
|
@ -85,8 +85,8 @@ valueDiscrete ::
|
||||||
valueDiscrete = phoistAcyclic $
|
valueDiscrete = phoistAcyclic $
|
||||||
plam $ \f ->
|
plam $ \f ->
|
||||||
pcon . Discrete $
|
pcon . Discrete $
|
||||||
passetClassValueOf # (pconstant $ fromString $ symbolVal $ Proxy @ac)
|
passetClassValueOf # pconstant (fromString $ symbolVal $ Proxy @ac)
|
||||||
# (pconstant $ fromString $ symbolVal $ Proxy @n)
|
# pconstant (fromString $ symbolVal $ Proxy @n)
|
||||||
# f
|
# f
|
||||||
|
|
||||||
-- NOTE: discreteValue after valueDiscrete is loses information
|
-- NOTE: discreteValue after valueDiscrete is loses information
|
||||||
|
|
@ -103,8 +103,8 @@ discreteValue = phoistAcyclic $
|
||||||
plam $ \f -> pmatch f $ \case
|
plam $ \f -> pmatch f $ \case
|
||||||
Discrete p ->
|
Discrete p ->
|
||||||
psingletonValue
|
psingletonValue
|
||||||
# (pconstant $ fromString $ symbolVal $ Proxy @ac)
|
# pconstant (fromString $ symbolVal $ Proxy @ac)
|
||||||
# (pconstant $ fromString $ symbolVal $ Proxy @n)
|
# pconstant (fromString $ symbolVal $ Proxy @n)
|
||||||
# p
|
# p
|
||||||
|
|
||||||
-- | Create a value with a single asset class
|
-- | Create a value with a single asset class
|
||||||
|
|
|
||||||
|
|
@ -34,7 +34,7 @@ discrete :: QuasiQuoter
|
||||||
discrete = QuasiQuoter discreteExp errorDiscretePat errorDiscreteType errorDiscreteDiscretelaration
|
discrete = QuasiQuoter discreteExp errorDiscretePat errorDiscreteType errorDiscreteDiscretelaration
|
||||||
|
|
||||||
discreteConstant :: forall (moneyClass :: MoneyClass) s. Integer -> Term s (Discrete moneyClass)
|
discreteConstant :: forall (moneyClass :: MoneyClass) s. Integer -> Term s (Discrete moneyClass)
|
||||||
discreteConstant n = punsafeCoerce ((pconstant n) :: Term s PInteger)
|
discreteConstant n = punsafeCoerce (pconstant n :: Term s PInteger)
|
||||||
|
|
||||||
fixedToInteger :: Integer -> (Integer, Integer) -> Integer
|
fixedToInteger :: Integer -> (Integer, Integer) -> Integer
|
||||||
fixedToInteger places (i, f) = i * 10 ^ places + f
|
fixedToInteger places (i, f) = i * 10 ^ places + f
|
||||||
|
|
|
||||||
|
|
@ -55,14 +55,13 @@ data PStakeAction (gt :: MoneyClass) (s :: S)
|
||||||
|
|
||||||
newtype PStakeDatum (gt :: MoneyClass) (s :: S) = PStakeDatum
|
newtype PStakeDatum (gt :: MoneyClass) (s :: S) = PStakeDatum
|
||||||
{ getStakeDatum ::
|
{ getStakeDatum ::
|
||||||
( Term
|
Term
|
||||||
s
|
s
|
||||||
( PDataRecord
|
( PDataRecord
|
||||||
'[ "stakedAmount" ':= Discrete gt
|
'[ "stakedAmount" ':= Discrete gt
|
||||||
, "owner" ':= PPubKeyHash
|
, "owner" ':= PPubKeyHash
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
)
|
|
||||||
}
|
}
|
||||||
deriving stock (GHC.Generic)
|
deriving stock (GHC.Generic)
|
||||||
deriving anyclass (Generic)
|
deriving anyclass (Generic)
|
||||||
|
|
|
||||||
|
|
@ -144,7 +144,7 @@ psymbolValueOf =
|
||||||
PMap value <- pmatch value'
|
PMap value <- pmatch value'
|
||||||
m' <- pexpectJust 0 (plookup # pdata sym # value)
|
m' <- pexpectJust 0 (plookup # pdata sym # value)
|
||||||
PMap m <- pmatch (pfromData m')
|
PMap m <- pmatch (pfromData m')
|
||||||
pfoldr # (plam $ \x v -> (pfromData $ psndBuiltin # x) + v) # 0 # m
|
pfoldr # plam (\x v -> pfromData (psndBuiltin # x) + v) # 0 # m
|
||||||
|
|
||||||
-- | Extract amount from PValue belonging to a Plutarch-level asset class
|
-- | Extract amount from PValue belonging to a Plutarch-level asset class
|
||||||
passetClassValueOf ::
|
passetClassValueOf ::
|
||||||
|
|
@ -173,20 +173,22 @@ pmapUnionWith = phoistAcyclic $
|
||||||
PMap ys <- pmatch ys'
|
PMap ys <- pmatch ys'
|
||||||
let ls =
|
let ls =
|
||||||
pmap
|
pmap
|
||||||
# ( plam $ \p -> P.do
|
# plam
|
||||||
|
( \p -> P.do
|
||||||
pf <- plet $ pfstBuiltin # p
|
pf <- plet $ pfstBuiltin # p
|
||||||
ps <- plet $ psndBuiltin # p
|
ps <- plet $ psndBuiltin # p
|
||||||
pmatch (plookup # pf # ys) $ \case
|
pmatch (plookup # pf # ys) $ \case
|
||||||
PJust v ->
|
PJust v ->
|
||||||
-- Data conversions here are silly, aren't they?
|
-- Data conversions here are silly, aren't they?
|
||||||
ppairDataBuiltin # pf # (pdata (f # pfromData ps # pfromData v))
|
ppairDataBuiltin # pf # pdata (f # pfromData ps # pfromData v)
|
||||||
PNothing -> p
|
PNothing -> p
|
||||||
)
|
)
|
||||||
# xs
|
# xs
|
||||||
rs =
|
rs =
|
||||||
pfilter
|
pfilter
|
||||||
# ( plam $ \p ->
|
# plam
|
||||||
pnot # (pany # (plam $ \p' -> pfstBuiltin # p' #== pfstBuiltin # p) # xs)
|
( \p ->
|
||||||
|
pnot #$ pany # plam (\p' -> pfstBuiltin # p' #== pfstBuiltin # p) # xs
|
||||||
)
|
)
|
||||||
# ys
|
# ys
|
||||||
pcon (PMap $ pconcat # ls # rs)
|
pcon (PMap $ pconcat # ls # rs)
|
||||||
|
|
@ -199,7 +201,7 @@ paddValue = phoistAcyclic $
|
||||||
PValue b <- pmatch b'
|
PValue b <- pmatch b'
|
||||||
pcon
|
pcon
|
||||||
( PValue $
|
( PValue $
|
||||||
pmapUnionWith # (plam $ \a' b' -> pmapUnionWith # (plam (+)) # a' # b') # a # b
|
pmapUnionWith # plam (\a' b' -> pmapUnionWith # plam (+) # a' # b') # a # b
|
||||||
)
|
)
|
||||||
|
|
||||||
-- | Sum of all value at input
|
-- | Sum of all value at input
|
||||||
|
|
@ -208,12 +210,13 @@ pvalueSpent = phoistAcyclic $
|
||||||
plam $ \txInfo' ->
|
plam $ \txInfo' ->
|
||||||
pmatch txInfo' $ \(PTxInfo txInfo) ->
|
pmatch txInfo' $ \(PTxInfo txInfo) ->
|
||||||
pfoldr
|
pfoldr
|
||||||
# ( plam $ \txInInfo' v ->
|
# plam
|
||||||
|
( \txInInfo' v ->
|
||||||
pmatch
|
pmatch
|
||||||
(pfromData txInInfo')
|
(pfromData txInInfo')
|
||||||
$ \(PTxInInfo txInInfo) ->
|
$ \(PTxInInfo txInInfo) ->
|
||||||
paddValue
|
paddValue
|
||||||
# (pmatch (pfield @"resolved" # txInInfo) $ \(PTxOut o) -> pfromData $ pfield @"value" # o)
|
# pmatch (pfield @"resolved" # txInInfo) (\(PTxOut o) -> pfromData $ pfield @"value" # o)
|
||||||
# v
|
# v
|
||||||
)
|
)
|
||||||
# pconstant mempty
|
# pconstant mempty
|
||||||
|
|
@ -225,7 +228,8 @@ pfindTxInByTxOutRef = phoistAcyclic $
|
||||||
plam $ \txOutRef txInfo' ->
|
plam $ \txOutRef txInfo' ->
|
||||||
pmatch txInfo' $ \(PTxInfo txInfo) ->
|
pmatch txInfo' $ \(PTxInfo txInfo) ->
|
||||||
pfindMap
|
pfindMap
|
||||||
# ( plam $ \txInInfo' ->
|
# plam
|
||||||
|
( \txInInfo' ->
|
||||||
plet (pfromData txInInfo') $ \r ->
|
plet (pfromData txInInfo') $ \r ->
|
||||||
pmatch r $ \(PTxInInfo txInInfo) ->
|
pmatch r $ \(PTxInInfo txInInfo) ->
|
||||||
pif
|
pif
|
||||||
|
|
@ -248,7 +252,8 @@ anyOutput = phoistAcyclic $
|
||||||
plam $ \txInfo' predicate -> P.do
|
plam $ \txInfo' predicate -> P.do
|
||||||
txInfo <- pletFields @'["outputs"] txInfo'
|
txInfo <- pletFields @'["outputs"] txInfo'
|
||||||
pany
|
pany
|
||||||
# ( plam $ \txOut'' -> P.do
|
# plam
|
||||||
|
( \txOut'' -> P.do
|
||||||
PTxOut txOut' <- pmatch (pfromData txOut'')
|
PTxOut txOut' <- pmatch (pfromData txOut'')
|
||||||
txOut <- pletFields @'["value", "datumHash", "address"] txOut'
|
txOut <- pletFields @'["value", "datumHash", "address"] txOut'
|
||||||
PDJust dh <- pmatch txOut.datumHash
|
PDJust dh <- pmatch txOut.datumHash
|
||||||
|
|
@ -269,7 +274,8 @@ anyInput = phoistAcyclic $
|
||||||
plam $ \txInfo' predicate -> P.do
|
plam $ \txInfo' predicate -> P.do
|
||||||
txInfo <- pletFields @'["inputs"] txInfo'
|
txInfo <- pletFields @'["inputs"] txInfo'
|
||||||
pany
|
pany
|
||||||
# ( plam $ \txInInfo'' -> P.do
|
# plam
|
||||||
|
( \txInInfo'' -> P.do
|
||||||
PTxInInfo txInInfo' <- pmatch (pfromData txInInfo'')
|
PTxInInfo txInInfo' <- pmatch (pfromData txInInfo'')
|
||||||
let txOut'' = pfield @"resolved" # txInInfo'
|
let txOut'' = pfield @"resolved" # txInInfo'
|
||||||
PTxOut txOut' <- pmatch (pfromData txOut'')
|
PTxOut txOut' <- pmatch (pfromData txOut'')
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue