Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

make hlint happy

Browse source
This commit is contained in:
Emily Martins 2022-02-25 14:43:28 +01:00
parent e5afed2c46
commit 3599eadf0b
8 changed files with 45 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

2
.github/workflows/integrate.yaml vendored
View file

@ -56,7 +56,7 @@ jobs:
name: mlabs
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
check-build:

3
bench.csv
View file

@ -1,3 +1,4 @@
name,cpu,mem,size
full_scripts:authorityTokenPolicy,1399431,4800,421
full_scripts:stakePolicy,3662179,12400,1572
full_scripts:stakePolicy,3751498,12700,1610
full_scripts:stakeValidator,3126265,10600,1500

1 name cpu mem size
2 full_scripts:authorityTokenPolicy 1399431 4800 421
3 full_scripts:stakePolicy 3662179 3751498 12400 12700 1572 1610
4 full_scripts:stakeValidator 3126265 10600 1500

9
flake.nix
View file

@ -76,15 +76,18 @@
let
pkgs = nixpkgsFor system;
pkgs' = nixpkgsFor' system;
inherit (pkgs.haskell-nix.tools ghcVersion {
inherit (plutarch.tools) fourmolu hlint;
})
fourmolu hlint;
in pkgs.runCommand "format-check" {
nativeBuildInputs = [
pkgs'.git
pkgs'.fd
pkgs'.haskellPackages.cabal-fmt
pkgs'.nixpkgs-fmt
(pkgs.haskell-nix.tools ghcVersion {
inherit (plutarch.tools) fourmolu;
}).fourmolu
fourmolu
hlint
];
} ''
export LC_CTYPE=C.UTF-8

21
src/Agora/AuthorityToken.hs
View file

@ -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'
PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo
txInfo <- pletFields @'["inputs", "mint"] txInfo'
let inputs = txInfo.inputs :: Term _ (PBuiltinList (PAsData PTxInInfo))
let inputs = txInfo.inputs
let authorityTokenInputs =
pfoldr'
pfoldr' @PBuiltinList
( \txInInfo' acc -> P.do
PTxInInfo txInInfo <- pmatch (pfromData txInInfo')
PTxOut txOut' <- pmatch $ pfromData $ pfield @"resolved" # txInInfo
@ -60,17 +60,10 @@ authorityTokenPolicy params =
# inputs
let mintedValue = pfromData txInfo.mint
let tokenMoved = 0 #< authorityTokenInputs
PMinting sym' <- pmatch $ pfromData ctx.purpose
let sym = pfromData $ pfield @"_0" # sym'
let mintedATs = passetClassValueOf # sym # pconstant "" # mintedValue
PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose
let ownSymbol = pfromData $ pfield @"_0" # ownSymbol'
let mintedATs = passetClassValueOf # ownSymbol # pconstant "" # mintedValue
pif
(0 #< mintedATs)
( pif
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.
(passert "Authority token did not move in minting GATs" tokenMoved (pconstant ()))
(pconstant ())

8
src/Agora/SafeMoney.hs
View file

@ -85,8 +85,8 @@ valueDiscrete ::
valueDiscrete = phoistAcyclic $
plam $ \f ->
pcon . Discrete $
passetClassValueOf # (pconstant $ fromString $ symbolVal $ Proxy @ac)
# (pconstant $ fromString $ symbolVal $ Proxy @n)
passetClassValueOf # pconstant (fromString $ symbolVal $ Proxy @ac)
# pconstant (fromString $ symbolVal $ Proxy @n)
# f
-- NOTE: discreteValue after valueDiscrete is loses information
@ -103,8 +103,8 @@ discreteValue = phoistAcyclic $
plam $ \f -> pmatch f $ \case
Discrete p ->
psingletonValue
# (pconstant $ fromString $ symbolVal $ Proxy @ac)
# (pconstant $ fromString $ symbolVal $ Proxy @n)
# pconstant (fromString $ symbolVal $ Proxy @ac)
# pconstant (fromString $ symbolVal $ Proxy @n)
# p
-- | Create a value with a single asset class

2
src/Agora/SafeMoney/QQ.hs
View file

@ -34,7 +34,7 @@ discrete :: QuasiQuoter
discrete = QuasiQuoter discreteExp errorDiscretePat errorDiscreteType errorDiscreteDiscretelaration
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 places (i, f) = i * 10 ^ places + f

15
src/Agora/Stake.hs
View file

@ -55,14 +55,13 @@ data PStakeAction (gt :: MoneyClass) (s :: S)
newtype PStakeDatum (gt :: MoneyClass) (s :: S) = PStakeDatum
{ getStakeDatum ::
( Term
s
( PDataRecord
'[ "stakedAmount" ':= Discrete gt
, "owner" ':= PPubKeyHash
]
)
)
Term
s
( PDataRecord
'[ "stakedAmount" ':= Discrete gt
, "owner" ':= PPubKeyHash
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)

28
src/Agora/Utils.hs
View file

@ -144,7 +144,7 @@ psymbolValueOf =
PMap value <- pmatch value'
m' <- pexpectJust 0 (plookup # pdata sym # value)
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
passetClassValueOf ::
@ -173,20 +173,22 @@ pmapUnionWith = phoistAcyclic $
PMap ys <- pmatch ys'
let ls =
pmap
# ( plam $ \p -> P.do
# plam
( \p -> P.do
pf <- plet $ pfstBuiltin # p
ps <- plet $ psndBuiltin # p
pmatch (plookup # pf # ys) $ \case
PJust v ->
-- 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
)
# xs
rs =
pfilter
# ( plam $ \p ->
pnot # (pany # (plam $ \p' -> pfstBuiltin # p' #== pfstBuiltin # p) # xs)
# plam
( \p ->
pnot #$ pany # plam (\p' -> pfstBuiltin # p' #== pfstBuiltin # p) # xs
)
# ys
pcon (PMap $ pconcat # ls # rs)
@ -199,7 +201,7 @@ paddValue = phoistAcyclic $
PValue b <- pmatch b'
pcon
( 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
@ -208,12 +210,13 @@ pvalueSpent = phoistAcyclic $
plam $ \txInfo' ->
pmatch txInfo' $ \(PTxInfo txInfo) ->
pfoldr
# ( plam $ \txInInfo' v ->
# plam
( \txInInfo' v ->
pmatch
(pfromData txInInfo')
$ \(PTxInInfo txInInfo) ->
paddValue
# (pmatch (pfield @"resolved" # txInInfo) $ \(PTxOut o) -> pfromData $ pfield @"value" # o)
# pmatch (pfield @"resolved" # txInInfo) (\(PTxOut o) -> pfromData $ pfield @"value" # o)
# v
)
# pconstant mempty
@ -225,7 +228,8 @@ pfindTxInByTxOutRef = phoistAcyclic $
plam $ \txOutRef txInfo' ->
pmatch txInfo' $ \(PTxInfo txInfo) ->
pfindMap
# ( plam $ \txInInfo' ->
# plam
( \txInInfo' ->
plet (pfromData txInInfo') $ \r ->
pmatch r $ \(PTxInInfo txInInfo) ->
pif
@ -248,7 +252,8 @@ anyOutput = phoistAcyclic $
plam $ \txInfo' predicate -> P.do
txInfo <- pletFields @'["outputs"] txInfo'
pany
# ( plam $ \txOut'' -> P.do
# plam
( \txOut'' -> P.do
PTxOut txOut' <- pmatch (pfromData txOut'')
txOut <- pletFields @'["value", "datumHash", "address"] txOut'
PDJust dh <- pmatch txOut.datumHash
@ -269,7 +274,8 @@ anyInput = phoistAcyclic $
plam $ \txInfo' predicate -> P.do
txInfo <- pletFields @'["inputs"] txInfo'
pany
# ( plam $ \txInInfo'' -> P.do
# plam
( \txInInfo'' -> P.do
PTxInInfo txInInfo' <- pmatch (pfromData txInInfo'')
let txOut'' = pfield @"resolved" # txInInfo'
PTxOut txOut' <- pmatch (pfromData txOut'')