Skip to content

Commit c7330e1

Browse files
bladyjokerbladyjoker
authored
Merge pull request #140 from mlabs-haskell/bladyjoker/small-fix-catastrophic
Demo fixes
2 parents 079e348 + 3708232 commit c7330e1

File tree

20 files changed

+266
-72
lines changed

20 files changed

+266
-72
lines changed

‎extras/build.nix‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
};
1313

1414
# Sets the above set option to system ones.
15-
config.lbf-nix = lib.genAttrs config.systems (system: (config.perSystem { inherit system; }).lbf-nix);
15+
config.lbf-nix = lib.genAttrs config.systems (system: (config.perSystem system).lbf-nix);
1616

1717
# Makes `lib.x86_64-linux.xyz` available
1818
config.flake.lib = config.lbf-nix;

‎extras/flake-purescript.nix‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,10 @@ let
3030
};
3131

3232
checks = {
33-
"purescript:${projectName}:check" = purs.runPursTest { testMain = "Test.Main"; };
33+
"purescript:${projectName}:check-nodejs" = purs.runPursTest {
34+
testMain = "Test.Main";
35+
buildInputs = if pursProjOpts ? "shell" then if pursProjOpts.shell ? "packages" then pursProjOpts.shell.packages else [ ] else [ ];
36+
};
3437
};
3538

3639
devShell = purs.devShell;

‎flake.lock‎

Lines changed: 4 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎flake.nix‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
pre-commit-hooks.url = "github:cachix/pre-commit-hooks.nix";
77
protobufs-nix.url = "github:mlabs-haskell/protobufs.nix";
88
hci-effects.url = "github:hercules-ci/hercules-ci-effects";
9-
ctl.url = "github:plutonomicon/cardano-transaction-lib?rev=fbf56b2965752ced05fd7f3a2d7ae6778e566df9";
9+
ctl.url = "github:plutonomicon/cardano-transaction-lib?ref=bladyjoker/runpurstest-fix";
1010
iohk-nix.url = "github:input-output-hk/iohk-nix";
1111
flake-parts.url = "github:hercules-ci/flake-parts";
1212
plutarch = {
@@ -55,6 +55,6 @@
5555
./experimental/build.nix
5656
];
5757
debug = true;
58-
systems = [ "x86_64-linux" ];
58+
systems = [ "x86_64-linux" "x86_64-darwin" ];
5959
};
6060
}

‎lambda-buffers-codegen/data/haskell-plutus-plutustx.json‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -167,6 +167,13 @@
167167
]
168168
},
169169
"classesConfig": {
170+
"Prelude.Eq": [
171+
[
172+
"plutus-tx",
173+
"PlutusTx.Eq",
174+
"Eq"
175+
]
176+
],
170177
"Plutus.V1.PlutusData": [
171178
[
172179
"plutus-tx",
@@ -178,13 +185,6 @@
178185
"PlutusTx",
179186
"FromData"
180187
]
181-
],
182-
"Prelude.Eq": [
183-
[
184-
"plutus-tx",
185-
"PlutusTx.Eq",
186-
"Eq"
187-
]
188188
]
189189
}
190190
}

‎lambda-buffers-codegen/data/haskell-prelude-base.json‎

Lines changed: 0 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -40,46 +40,6 @@
4040
"Prelude",
4141
"Char"
4242
],
43-
"Prelude.UInt64": [
44-
"base",
45-
"Data.Word",
46-
"Word64"
47-
],
48-
"Prelude.UInt32": [
49-
"base",
50-
"Data.Word",
51-
"Word32"
52-
],
53-
"Prelude.UInt16": [
54-
"base",
55-
"Data.Word",
56-
"Word16"
57-
],
58-
"Prelude.UInt8": [
59-
"base",
60-
"Data.Word",
61-
"Word8"
62-
],
63-
"Prelude.Int64": [
64-
"base",
65-
"Data.Int",
66-
"Int64"
67-
],
68-
"Prelude.Int32": [
69-
"base",
70-
"Data.Int",
71-
"Int32"
72-
],
73-
"Prelude.Int16": [
74-
"base",
75-
"Data.Int",
76-
"Int16"
77-
],
78-
"Prelude.Int8": [
79-
"base",
80-
"Data.Int",
81-
"Int8"
82-
],
8343
"Prelude.Integer": [
8444
"base",
8545
"Prelude",

‎lambda-buffers-codegen/data/haskell-prelude-plutustx.json‎

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
{
2+
"opaquesConfig": {
3+
"Prelude.Map": [
4+
"plutus-tx",
5+
"PlutusTx.AssocMap",
6+
"Map"
7+
],
8+
"Prelude.Set": [
9+
"containers",
10+
"Data.Set",
11+
"Set"
12+
],
13+
"Prelude.List": [
14+
"lbr-prelude",
15+
"LambdaBuffers.Runtime.Prelude",
16+
"List"
17+
],
18+
"Prelude.Either": [
19+
"plutus-tx",
20+
"PlutusTx.Either",
21+
"Either"
22+
],
23+
"Prelude.Maybe": [
24+
"plutus-tx",
25+
"PlutusTx.Maybe",
26+
"Maybe"
27+
],
28+
"Prelude.Bytes": [
29+
"plutus-tx",
30+
"PlutusTx.Builtins",
31+
"BuiltinByteString"
32+
],
33+
"Prelude.Text": [
34+
"plutus-tx",
35+
"PlutusTx.Builtins",
36+
"BuiltinString"
37+
],
38+
"Prelude.Char": [
39+
"base",
40+
"Prelude",
41+
"Char"
42+
],
43+
"Prelude.Integer": [
44+
"plutus-tx",
45+
"PlutusTx.Builtins",
46+
"Integer"
47+
],
48+
"Prelude.Bool": [
49+
"plutus-tx",
50+
"PlutusTx.Bool",
51+
"Bool"
52+
]
53+
},
54+
"classesConfig": {
55+
"Prelude.Eq": [
56+
[
57+
"plutus-tx",
58+
"PlutusTx.Eq",
59+
"Eq"
60+
],
61+
[
62+
"base",
63+
"Prelude",
64+
"Eq"
65+
]
66+
],
67+
"Prelude.Json": [
68+
[
69+
"lbr-prelude",
70+
"LambdaBuffers.Runtime.Prelude",
71+
"Json"
72+
]
73+
]
74+
}
75+
}

‎lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,4 +39,10 @@ hsPrintModuleEnv =
3939
HsSyntax.printModName
4040
HsDerive.hsClassImplPrinters
4141
HsPrint.printTyDef
42-
[]
42+
["NoImplicitPrelude", "NoPolyKinds"] -- NOTE(bladyjoker): NoPolyKinds is needed for PlutusTx compiler, quite safe.
43+
[ "-fno-ignore-interface-pragmas" -- NOTE(bladyjoker): All this is necessary for PlutusTx compiler, apparently safe.
44+
, "-fno-omit-interface-pragmas"
45+
, "-fno-specialise"
46+
, "-fno-strictness"
47+
, "-fobject-code"
48+
]

‎lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Print.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ import LambdaBuffers.Codegen.Haskell.Print.Syntax qualified as H
2929
import LambdaBuffers.Codegen.Print (throwInternalError)
3030
import LambdaBuffers.Codegen.Print qualified as Print
3131
import LambdaBuffers.ProtoCompat qualified as PC
32-
import Prettyprinter (Doc, Pretty (pretty), align, comma, encloseSep, group, line, lparen, rparen, space, vsep, (<+>))
32+
import Prettyprinter (Doc, Pretty (pretty), align, comma, encloseSep, group, hsep, line, lparen, rparen, space, vsep, (<+>))
3333

3434
data PrintModuleEnv m ann = PrintModuleEnv
3535
{ env'printModuleName :: PC.ModuleName -> Doc ann
@@ -44,6 +44,7 @@ data PrintModuleEnv m ann = PrintModuleEnv
4444
)
4545
, env'printTyDef :: MonadPrint m => PC.TyDef -> m (Doc ann)
4646
, env'languageExtensions :: [Text]
47+
, env'ghcOptions :: [Text]
4748
}
4849

4950
printModule :: MonadPrint m => PrintModuleEnv m ann -> m (Doc ann, Set Text)
@@ -55,6 +56,7 @@ printModule env = do
5556
let modDoc =
5657
align . vsep $
5758
[ printLanguageExtensions (env'languageExtensions env)
59+
, printGhcOptions (env'ghcOptions env)
5860
, printModuleHeader env (ctx ^. Print.ctxModule . #moduleName) (ctx ^. Print.ctxTyExports)
5961
, mempty
6062
, printImports
@@ -119,6 +121,10 @@ printLanguageExtensions :: Pretty a => [a] -> Doc ann
119121
printLanguageExtensions [] = mempty
120122
printLanguageExtensions exts = "{-# LANGUAGE" <+> align (encloseSep mempty mempty comma (pretty <$> exts)) <+> "#-}"
121123

124+
printGhcOptions :: Pretty a => [a] -> Doc ann
125+
printGhcOptions [] = mempty
126+
printGhcOptions opts = "{-# OPTIONS_GHC" <+> align (hsep (pretty <$> opts)) <+> "#-}"
127+
122128
printModuleHeader :: PrintModuleEnv m ann -> PC.ModuleName -> Set (PC.InfoLess PC.TyName) -> Doc ann
123129
printModuleHeader env mn exports = "module" <+> env'printModuleName env mn <+> printExports exports <+> "where"
124130

‎lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Print/Derive.hs‎

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ import LambdaBuffers.Codegen.LamVal.MonadPrint qualified as LV
1515
import LambdaBuffers.Codegen.LamVal.PlutusData (deriveFromPlutusDataImpl, deriveToPlutusDataImpl)
1616
import LambdaBuffers.Codegen.Print qualified as Print
1717
import LambdaBuffers.ProtoCompat qualified as PC
18-
import Prettyprinter (Doc, align, equals, vsep, (<+>))
18+
import Prettyprinter (Doc, align, equals, hardline, vsep, (<+>))
1919
import Proto.Codegen qualified as P
2020
import Proto.Codegen_Fields qualified as P
2121

@@ -80,9 +80,9 @@ lvEqBuiltinsPlutusTx :: Map LV.ValueName (H.CabalPackageName, H.ModuleName, H.Va
8080
lvEqBuiltinsPlutusTx =
8181
Map.fromList
8282
[ ("eq", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Eq", H.MkValueName "=="))
83-
, ("and", (H.MkCabalPackageName "base", H.MkModuleName "Prelude", H.MkValueName "&&"))
84-
, ("true", (H.MkCabalPackageName "base", H.MkModuleName "Prelude", H.MkValueName "True"))
85-
, ("false", (H.MkCabalPackageName "base", H.MkModuleName "Prelude", H.MkValueName "False"))
83+
, ("and", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Bool", H.MkValueName "&&"))
84+
, ("true", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Bool", H.MkValueName "True"))
85+
, ("false", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Bool", H.MkValueName "False"))
8686
]
8787

8888
printDeriveEqPlutusTx :: MonadPrint m => PC.ModuleName -> PC.TyDefs -> (Doc ann -> Doc ann) -> PC.Ty -> m (Doc ann)
@@ -93,10 +93,13 @@ printDeriveEqPlutusTx mn iTyDefs mkInstanceDoc ty = do
9393
case LV.runPrint lvEqBuiltinsPlutusTx (printValueE valE) of
9494
Left err -> Print.throwInternalError' (mn ^. #sourceInfo) ("Interpreting LamVal into Haskell failed with: " <> err ^. P.msg)
9595
Right (implDoc, imps) -> do
96-
let instanceDoc = mkInstanceDoc (printValueDef eqClassMethodName implDoc)
96+
let instanceDoc = mkInstanceDoc (align $ printInlineable eqClassMethodName <> hardline <> printValueDef eqClassMethodName implDoc)
9797
for_ imps Print.importValue
9898
return instanceDoc
9999

100+
printInlineable :: H.ValueName -> Doc ann
101+
printInlineable valName = "{-# INLINABLE" <+> H.printHsValName valName <+> "#-}"
102+
100103
lvPlutusDataBuiltins :: Map LV.ValueName H.QValName
101104
lvPlutusDataBuiltins =
102105
Map.fromList
@@ -106,9 +109,9 @@ lvPlutusDataBuiltins =
106109
, ("integerData", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Builtins", H.MkValueName "mkI"))
107110
, ("constrData", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Builtins", H.MkValueName "mkConstr"))
108111
, ("listData", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Builtins", H.MkValueName "mkList"))
109-
, ("succeedParse", (H.MkCabalPackageName "base", H.MkModuleName "Prelude", H.MkValueName "Just"))
110-
, ("failParse", (H.MkCabalPackageName "base", H.MkModuleName "Prelude", H.MkValueName "Nothing"))
111-
, ("bindParse", (H.MkCabalPackageName "base", H.MkModuleName "Prelude", H.MkValueName ">>="))
112+
, ("succeedParse", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Maybe", H.MkValueName "Just"))
113+
, ("failParse", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Maybe", H.MkValueName "Nothing"))
114+
, ("bindParse", (H.MkCabalPackageName "plutus-tx", H.MkModuleName "PlutusTx.Prelude", H.MkValueName ">>="))
112115
]
113116

114117
toPlutusDataClassMethodName :: H.ValueName
@@ -122,7 +125,7 @@ printDeriveToPlutusData mn iTyDefs mkInstanceDoc ty = do
122125
case LV.runPrint lvPlutusDataBuiltins (printValueE valE) of
123126
Left err -> Print.throwInternalError' (mn ^. #sourceInfo) ("Interpreting LamVal into Haskell failed with: " <> err ^. P.msg)
124127
Right (implDoc, imps) -> do
125-
let instanceDoc = mkInstanceDoc (printValueDef toPlutusDataClassMethodName implDoc)
128+
let instanceDoc = mkInstanceDoc (align $ printInlineable toPlutusDataClassMethodName <> hardline <> printValueDef toPlutusDataClassMethodName implDoc)
126129
for_ imps Print.importValue
127130
return instanceDoc
128131

@@ -143,7 +146,7 @@ printDeriveFromPlutusData mn iTyDefs mkInstanceDoc ty = do
143146
case LV.runPrint lvPlutusDataBuiltins (printValueE valE) of
144147
Left err -> Print.throwInternalError' (mn ^. #sourceInfo) ("Interpreting LamVal into Haskell failed with: " <> err ^. P.msg)
145148
Right (implDoc, imps) -> do
146-
let instanceDoc = mkInstanceDoc (printValueDef fromPlutusDataClassMethodName implDoc)
149+
let instanceDoc = mkInstanceDoc (align $ printInlineable fromPlutusDataClassMethodName <> hardline <> printValueDef fromPlutusDataClassMethodName implDoc)
147150
Print.importValue builtinDataToDataRef
148151
for_ imps Print.importValue
149152
return instanceDoc

0 commit comments

Comments
 (0)