Skip to content

Commit 538b0d3

Browse files
supermariosupermario
committed
Implement the Main:PageData wire check
1 parent 8b5f912 commit 538b0d3

File tree

9 files changed

+80
-74
lines changed

9 files changed

+80
-74
lines changed

‎compiler/src/Compile.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ compile pkg ifaces modul = do
6868
canonical0 <- canonicalize pkg ifaces modul_
6969
-- () <- debugPassText "starting canonical2" "" (pure ())
7070

71-
onlyWhen (Src.getName modul == "Main") $ Ext.ElmPages.Check.isWireCompatible "PageData" ifaces False
71+
_ <- onlyWhen (Src.getName modul == "Main") $ Ext.ElmPages.Check.isWireCompatible pkg (Src.getName modul) "PageData" canonical0 ifaces False
7272

7373
-- Add Canonical Wire gens, i.e. the `w2_[en|de]code_TYPENAME` functions
7474
canonical1 <- Lamdera.Wire3.Core.addWireGenerations canonical0 pkg ifaces modul_

‎compiler/src/Reporting/Error.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,7 @@ data Error
5959
| BadMains L.Localizer (OneOrMore.OneOrMore Main.Error)
6060
| BadPatterns (NE.List Pattern.Error)
6161
| BadDocs Docs.Error
62+
| BadLamderaWireIncompatible D.Doc
6263
| BadLamdera D.Doc
6364

6465

@@ -90,6 +91,9 @@ toReports source err =
9091
BadDocs docsErr ->
9192
Docs.toReports source docsErr
9293

94+
BadLamderaWireIncompatible doc ->
95+
NE.singleton $ Lamdera.Error.report doc
96+
9397
BadLamdera doc ->
9498
NE.singleton $ Lamdera.Error.report doc
9599

‎ext-common/Ext/TypeHash.hs‎

Lines changed: 14 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -4,21 +4,12 @@
44
module Ext.TypeHash where
55

66
import qualified Data.List as List
7-
import qualified Data.Text as T
8-
9-
import qualified Reporting.Exit as Exit
10-
import qualified Reporting.Doc as D
11-
12-
13-
14-
157
import qualified Data.Map as Map
16-
import qualified Data.List as List
178
import qualified Data.Text as T
18-
import qualified Data.Name as N
199
import qualified Data.Set as Set
2010
import Data.Map ((!))
2111

12+
import qualified Data.Name as N
2213
import qualified AST.Canonical as Can
2314
import qualified AST.Source as Valid
2415
import qualified Elm.ModuleName as ModuleName
@@ -30,15 +21,8 @@ import qualified Reporting.Doc as D
3021
import qualified Reporting.Task as Task
3122
import qualified Reporting.Exit as Exit
3223

33-
-- import Lamdera
34-
-- import Lamdera.Types
35-
-- import Lamdera.Progress
36-
-- import qualified Ext.Query.Interfaces as Interfaces
3724
import StandaloneInstances
3825

39-
40-
41-
4226
import Lamdera
4327
import Lamdera.Types
4428

@@ -48,24 +32,27 @@ type RecursionSet =
4832
Set.Set (ModuleName.Raw, N.Name, [Can.Type])
4933

5034

35+
extendInterfacesWithCanonicalModule :: Pkg.Name -> ModuleName.Raw -> Can.Module -> Interfaces -> Interfaces
36+
extendInterfacesWithCanonicalModule pkg moduleName modul ifaces =
37+
ifaces & Map.insert moduleName (Interface.Interface pkg Map.empty
38+
(Can._unions modul & fmap Interface.OpenUnion)
39+
(Can._aliases modul & fmap Interface.PublicAlias)
40+
Map.empty
41+
)
5142

52-
-- calculateHashes :: Interfaces -> Bool -> Either Exit.BuildProblem ([Text], [(Text, [Text], DiffableType)])
53-
-- calculateHashes interfaces inDebug = do
54-
-- error "todo"
5543

56-
57-
58-
59-
calculateHashes :: [ModuleName.Raw] -> Interfaces -> Bool -> Either Exit.BuildProblem ([Text], [(Text, [Text], DiffableType)])
60-
calculateHashes targetTypes interfaces inDebug = do
44+
calculateHashes :: Pkg.Name -> ModuleName.Raw -> [ModuleName.Raw] -> Can.Module -> Interfaces -> Bool -> Either Exit.BuildProblem ([Text], [(Text, [Text], DiffableType)])
45+
calculateHashes pkg modul targetTypes canonical interfaces inDebug = do
6146

6247
let
63-
iface_Types = (interfaces ! "Types")
48+
ifacesExtended = extendInterfacesWithCanonicalModule pkg modul canonical interfaces
49+
50+
iface_Types = (ifacesExtended ! modul)
6451

6552
typediffs :: [(Text, DiffableType)]
6653
typediffs =
6754
targetTypes
68-
& fmap (\t -> (nameToText t, diffableTypeByName interfaces t "Types" iface_Types))
55+
& fmap (\targetType -> (nameToText targetType, diffableTypeByName ifacesExtended targetType modul iface_Types))
6956

7057

7158
hashes :: [Text]
@@ -117,16 +104,6 @@ calculateHashes targetTypes interfaces inDebug = do
117104
] ++ notifyWarnings)
118105

119106
else do
120-
-- -- These external warnings no longer need to be written to disk, but
121-
-- -- we might find it useful to evaluate the scope of external types that
122-
-- -- users are using in their projects?
123-
-- root <- getProjectRoot
124-
--
125-
-- if (List.length warnings > 0)
126-
-- then do
127-
-- writeUtf8 (lamderaExternalWarningsPath root) $ textWarnings
128-
-- else
129-
-- remove (lamderaExternalWarningsPath root)
130107
Right (hashes, warnings)
131108

132109

‎ext-elm-pages/Ext/ElmPages/Check.hs‎

Lines changed: 24 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,33 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE BangPatterns #-}
3+
14
module Ext.ElmPages.Check where
25

6+
import qualified Data.Map as Map
7+
38
import qualified Reporting.Error as E
49
import qualified Reporting.Doc as D
5-
import qualified Ext.TypeHash
10+
import qualified Reporting.Exit as Exit
11+
import qualified Reporting.Exit.Help as Help
612

7-
isWireCompatible target ifaces inDebug = do
13+
import qualified AST.Canonical as Can
14+
import qualified Elm.ModuleName as ModuleName
15+
import qualified Elm.Package as Pkg
16+
17+
import Lamdera
18+
import Lamdera.Types
19+
import qualified Ext.TypeHash
20+
import StandaloneInstances
821

9-
-- calculateHashes :: Interfaces -> Bool -> IO (Either Exit.BuildProblem ([Text], [(Text, [Text], DiffableType)]))
10-
-- calculateHashes interfaces inDebug = do
1122

12-
let inDebug = False
13-
x = Ext.TypeHash.calculateHashes [target] ifaces inDebug
23+
isWireCompatible :: Pkg.Name -> ModuleName.Raw -> ModuleName.Raw -> Can.Module -> Interfaces -> Bool -> Either E.Error ()
24+
isWireCompatible pkg moduleName target canonical ifaces inDebug = do
25+
case Ext.TypeHash.calculateHashes pkg moduleName [target] canonical ifaces inDebug of
26+
Right _ -> Right ()
1427

28+
Left err ->
29+
case err of
30+
Exit.BuildLamderaProblem title topline ddoc ->
31+
Left $ E.BadLamderaWireIncompatible $ Help.reportToDoc $ Help.report title Nothing topline ddoc
1532

16-
Left $ E.BadLamdera $ D.fromChars "Ext.ElmPages.Check.isWireCompatible error!"
33+
_ -> error "todo: remove the impossible states"

‎extra/StandaloneInstances.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -227,6 +227,7 @@ deriving instance Show Reporting.Exit.PackageProblem
227227
deriving instance Show Reporting.Exit.Outline
228228
deriving instance Show Reporting.Exit.OutlineProblem
229229
deriving instance Show Reporting.Exit.BuildProjectProblem
230+
deriving instance Show Reporting.Exit.BuildProblem
230231

231232
deriving instance Show Reporting.Exit.Install
232233
deriving instance Show Reporting.Exit.RegistryProblem

‎test/EasyTest.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -221,8 +221,8 @@ run' seed note allow (Test t) = do
221221
note $ " " ++ intercalate "\n " (map (show . takeWhile (/= '\n')) failures)
222222
note ""
223223
note " To rerun with same random seed:\n"
224-
note $ " EasyTest.rerun " ++ show seed
225-
note $ " EasyTest.rerunOnly " ++ show seed ++ " " ++ "\"" ++ hd ++ "\""
224+
note $ " Test.rerun " ++ show seed
225+
note $ " Test.rerunOnly " ++ show seed ++ " " ++ "\"" ++ hd ++ "\""
226226
note "\n"
227227
note line
228228
note "❌"

‎test/Test.hs‎

Lines changed: 21 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ import qualified Test.Snapshot
99
import qualified Test.Lamdera
1010
import qualified Test.Check
1111
import qualified Test.Wire
12+
import qualified Test.Ext.ElmPages.Check
1213
import Test.Helpers
1314

1415
import qualified Make
@@ -18,6 +19,7 @@ import qualified Lamdera.Compile
1819
import qualified Lamdera.Evaluate
1920
import qualified Lamdera.CLI.Check
2021
import qualified Lamdera.CLI.CheckElmPages
22+
2123
import qualified Ext.Query.Canonical
2224

2325
import Develop
@@ -84,13 +86,23 @@ For more information on how to use the GHCi debugger, see the GHC User's Guide.
8486
-- Current target for ghci :rr command. See ~/.ghci config file, which should contain
8587
-- something like `:def rr const $ return $ unlines [":r","Test.target"]`
8688

89+
target = Test.all
90+
91+
8792
-- target = buildTestHarnessToProductionJs
8893
-- target = checkProjectCompiles
8994
-- target = liveReloadLive
90-
target = Lamdera.Compile.makeDev_ "/Users/mario/dev/projects/lamdera-compiler/test/scenario-elm-pages-incompatible-wire/.elm-pages/Main.elm"
91-
9295
-- target = do
9396
-- Dir.withCurrentDirectory "/Users/mario/dev/projects/lamdera-dashboard" $ Lamdera.CLI.Check.run () ()
97+
-- target = Test.Wire.all
98+
-- target = checkUserConfig
99+
-- target = Test.Wire.buildAllPackages
100+
-- target = Lamdera.CLI.Login.run () ()
101+
-- target = Dir.withCurrentDirectory "/Users/mario/dev/projects/lamdera-test" $ Lamdera.CLI.Reset.run () ()
102+
-- target = Lamdera.Diff.run
103+
-- target = Lamdera.ReverseProxy.start
104+
-- target = Test.Check.mockBuildSh "/Users/mario/lamdera-deploys/test-local-v1" "test-local"
105+
-- target = Test.Check.mockBuildSh "/Users/mario/dev/test/lamdera-init" "test-local"
94106

95107

96108
checkProjectCompiles = do
@@ -117,18 +129,6 @@ checkProjectCompiles = do
117129
}
118130

119131

120-
-- target = Test.all
121-
-- target = Test.Wire.all
122-
-- target = checkUserConfig
123-
-- target = Test.Wire.buildAllPackages
124-
-- target = Lamdera.CLI.Login.run () ()
125-
-- target = Dir.withCurrentDirectory "/Users/mario/dev/projects/lamdera-test" $ Lamdera.CLI.Reset.run () ()
126-
-- target = Lamdera.Diff.run
127-
-- target = Lamdera.ReverseProxy.start
128-
129-
-- target = Test.Check.mockBuildSh "/Users/mario/lamdera-deploys/test-local-v1" "test-local"
130-
-- target = Test.Check.mockBuildSh "/Users/mario/dev/test/lamdera-init" "test-local"
131-
132132
-- target = do
133133
-- setEnv "LOVR" "/Users/mario/dev/projects/lamdera/overrides"
134134
-- setEnv "LDEBUG" "1"
@@ -211,10 +211,15 @@ liveReloadLive = do
211211
-- Dir.withCurrentDirectory "/Users/mario/dev/projects/elmcraft" $ Lamdera.CLI.CheckElmPages.run () ()
212212

213213

214-
215214
all =
216215
EasyTest.run allTests
217216

217+
rerun seed =
218+
EasyTest.rerun seed allTests
219+
220+
rerunOnly seed label =
221+
EasyTest.rerunOnly seed label allTests
222+
218223

219224
single = do
220225

@@ -234,5 +239,6 @@ allTests =
234239
[ scope "Test.Lamdera -> " $ Test.Lamdera.suite
235240
, scope "Test.Snapshot -> " $ Test.Snapshot.suite
236241
, scope "Test.Wire -> " $ Test.Wire.suite
242+
, scope "Test.Ext.ElmPages.Check -> " $ Test.Ext.ElmPages.Check.suite
237243
, Test.LamderaGenerated.suite
238244
]

‎test/Test/Helpers.hs‎

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,14 @@
11
module Test.Helpers where
22

3-
4-
import Lamdera
53
import System.Environment (setEnv, unsetEnv, lookupEnv)
64
import System.FilePath ((</>))
75
import Data.Text as T
86

7+
import EasyTest
8+
9+
import Lamdera
10+
import Test.Main (captureProcessResult)
11+
912

1013
aggressiveCacheClear :: FilePath -> IO ()
1114
aggressiveCacheClear project = do
@@ -48,3 +51,11 @@ cp = Lamdera.copyFile
4851

4952
rm :: String -> IO ()
5053
rm path = Lamdera.remove path
54+
55+
56+
catchOutput :: IO () -> Test Text
57+
catchOutput action = do
58+
-- https://hackage.haskell.org/package/main-tester-0.2.0.1/docs/Test-Main.html
59+
pr <- io $ captureProcessResult action
60+
-- @TODO improve this to actually pull out values
61+
pure $ show_ pr

‎test/Test/Lamdera.hs‎

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -28,8 +28,6 @@ import LamderaSharedBuildHelpers (adminToken)
2828
-- import Test.Wire
2929

3030

31-
import Test.Main (captureProcessResult)
32-
3331
all = run Test.Lamdera.suite
3432

3533
suite :: Test ()
@@ -80,14 +78,6 @@ suite = tests
8078
]
8179

8280

83-
catchOutput :: IO () -> Test Text
84-
catchOutput action = do
85-
-- https://hackage.haskell.org/package/main-tester-0.2.0.1/docs/Test-Main.html
86-
pr <- io $ captureProcessResult action
87-
-- @TODO improve this to actually pull out values
88-
pure $ show_ pr
89-
90-
9181
compile :: IO ()
9282
compile = do
9383
let project = "/Users/mario/lamdera/test/v1"

0 commit comments

Comments
 (0)