From c277af5826792655852c5220fcdd6a530060ef75 Mon Sep 17 00:00:00 2001 From: Martin Janiczek Date: Thu, 20 Aug 2026 15:43:53 +0200 Subject: [PATCH 1/2] Add regression test using select-list dependency --- test/Test/TypeHashes.hs | 16 ++++++++++ test/scenario-select-list/elm.json | 19 ++++++++++++ .../Test/Wire_Package_Types_SelectList.elm | 7 +++++ test/scenario-select-list/src/Types.elm | 31 +++++++++++++++++++ 4 files changed, 73 insertions(+) create mode 100644 test/scenario-select-list/elm.json create mode 100644 test/scenario-select-list/src/Test/Wire_Package_Types_SelectList.elm create mode 100644 test/scenario-select-list/src/Types.elm diff --git a/test/Test/TypeHashes.hs b/test/Test/TypeHashes.hs index 47bac4704..e45753fea 100644 --- a/test/Test/TypeHashes.hs +++ b/test/Test/TypeHashes.hs @@ -123,6 +123,22 @@ suite = tests expectEqualTextTrimmed thash "4684f0e30ca7421c497e79b5dfc88cec77010699" expectEqualTextTrimmed ttext "R[LD[C[[][]],S]LS[C[[][]]]]" + scope "package type aliasing its internal Types module (miyamoen/select-list)" $ do + -- Regression test: miyamoen/select-list's SelectList.SelectList is a + -- type alias for its internal Types.SelectList. The Types module gets + -- confused with user's Types module. Tracking the package properly is + -- needed to distinguish the two. + project_ <- io $ Lamdera.Relative.requireDir "test/scenario-select-list" + let + modulePath = "src/Test/Wire_Package_Types_SelectList.elm" + moduleName = "Test.Wire_Package_Types_SelectList" + typeName = "PackageTypesSelectList" + + (thash, ttext) <- ioSilenced $ withDebug $ Ext.Common.withProjectRoot project_ $ do + Lamdera.TypeHash.calculateHashPair modulePath moduleName typeName + + expectEqualTextTrimmed ttext "C[[L[I]IL[I]]]" + , scope "sha1 should not collide" $ do diff --git a/test/scenario-select-list/elm.json b/test/scenario-select-list/elm.json new file mode 100644 index 000000000..66e5a72fa --- /dev/null +++ b/test/scenario-select-list/elm.json @@ -0,0 +1,19 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/core": "1.0.5", + "elm/json": "1.1.3", + "miyamoen/select-list": "4.1.0" + }, + "indirect": {} + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/test/scenario-select-list/src/Test/Wire_Package_Types_SelectList.elm b/test/scenario-select-list/src/Test/Wire_Package_Types_SelectList.elm new file mode 100644 index 000000000..7c96fe5fc --- /dev/null +++ b/test/scenario-select-list/src/Test/Wire_Package_Types_SelectList.elm @@ -0,0 +1,7 @@ +module Test.Wire_Package_Types_SelectList exposing (..) + +import SelectList exposing (SelectList) + + +type alias PackageTypesSelectList = + SelectList Int diff --git a/test/scenario-select-list/src/Types.elm b/test/scenario-select-list/src/Types.elm new file mode 100644 index 000000000..2a4b4ff74 --- /dev/null +++ b/test/scenario-select-list/src/Types.elm @@ -0,0 +1,31 @@ +module Types exposing (..) + +{-| Lamdera app's Types module (as opposed to the SelectList's Types module - +see elm.json in this test) +-} + + +type alias FrontendModel = + { message : String + } + + +type alias BackendModel = + { message : String + } + + +type FrontendMsg + = NoOpFrontendMsg + + +type ToBackend + = NoOpToBackend + + +type BackendMsg + = NoOpBackendMsg + + +type ToFrontend + = NoOpToFrontend From 8ecdfc81d3e4ca0494720d502d9da6e8b53931fe Mon Sep 17 00:00:00 2001 From: Martin Janiczek Date: Thu, 20 Aug 2026 16:57:54 +0200 Subject: [PATCH 2/2] Fix the Types collision issue Packages like miyamoen/select-list have their own internal `Types` module. This doesn't play nice with Lamdera Wire logic which didn't take the possibility into account and just tracked raw module names instead of also the package that owns them. The fix involves tracking ModuleName.Canonical instead of ModuleName.Raw. --- ext-common/Ext/Query/Canonical.hs | 3 +- ext-common/Ext/Query/Interfaces.hs | 45 +++++++++---------- ext-elm-pages/Ext/ElmPages.hs | 14 +++--- extra/Lamdera/Evergreen/MigrationGenerator.hs | 4 +- .../Evergreen/MigrationGeneratorHelpers.hs | 2 +- extra/Lamdera/Evergreen/Snapshot.hs | 4 +- extra/Lamdera/Make.hs | 4 +- extra/Lamdera/TypeHash.hs | 14 +++--- extra/Lamdera/Types.hs | 2 +- 9 files changed, 43 insertions(+), 49 deletions(-) diff --git a/ext-common/Ext/Query/Canonical.hs b/ext-common/Ext/Query/Canonical.hs index bf34f159d..3b1414300 100644 --- a/ext-common/Ext/Query/Canonical.hs +++ b/ext-common/Ext/Query/Canonical.hs @@ -51,10 +51,11 @@ loadSingleObjects path = do loadSingleArtifacts :: FilePath -> IO Compile.Artifacts loadSingleArtifacts path = do ifaces <- Ext.Query.Interfaces.all [path] + let ifacesRaw = Map.mapKeys Module._module ifaces source <- File.readUtf8 path case Parse.fromByteString Parse.Application source of Right modul -> - case Compile.compile Nothing Pkg.dummyName ifaces modul of + case Compile.compile Nothing Pkg.dummyName ifacesRaw modul of Right artifacts -> pure artifacts diff --git a/ext-common/Ext/Query/Interfaces.hs b/ext-common/Ext/Query/Interfaces.hs index aafee15cf..cb41e97c7 100644 --- a/ext-common/Ext/Query/Interfaces.hs +++ b/ext-common/Ext/Query/Interfaces.hs @@ -6,7 +6,6 @@ module Ext.Query.Interfaces where import Control.Monad (liftM2) import qualified Data.Map as Map -import qualified Data.OneOrMore as OneOrMore import Control.Concurrent.MVar import qualified Data.NonEmptyList as NE @@ -15,6 +14,7 @@ import qualified AST.Optimized as Opt import qualified Elm.Details as Details import qualified Elm.Interface as I import qualified Elm.ModuleName as ModuleName +import qualified Elm.Package as Pkg import qualified Reporting import qualified Reporting.Exit as Exit import qualified Reporting.Task as Task @@ -26,7 +26,7 @@ import qualified Json.Encode as Encode import Ext.Common -all :: [FilePath] -> IO (Map.Map ModuleName.Raw I.Interface) +all :: [FilePath] -> IO (Map.Map ModuleName.Canonical I.Interface) all paths = do debug $ "Loading Interfaces.all on paths: " ++ show paths artifactsDeps <- allDepArtifacts @@ -39,7 +39,7 @@ all paths = do -- Takes Build.Artifacts and extracts project interfaces, loads all package dep interfaces, and merges them -artifactsToFullInterfaces :: Details.Details -> Build.Artifacts -> IO (Map.Map ModuleName.Raw I.Interface) +artifactsToFullInterfaces :: Details.Details -> Build.Artifacts -> IO (Map.Map ModuleName.Canonical I.Interface) artifactsToFullInterfaces details artifacts = do ifaces <- extractInterfaces $ Build._modules artifacts @@ -57,7 +57,7 @@ allGraph = do data Artifacts = Artifacts - { _ifaces :: Map.Map ModuleName.Raw I.Interface + { _ifaces :: Map.Map ModuleName.Canonical I.Interface , _graph :: Opt.GlobalGraph } @@ -97,27 +97,26 @@ allDepArtifacts_ details = do return $ Artifacts (toInterfaces deps) objs -toInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Raw I.Interface +toInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Canonical I.Interface toInterfaces deps = - Map.mapMaybe toUnique $ Map.fromListWith OneOrMore.more $ - Map.elems (Map.mapMaybeWithKey getPublic deps) + Map.map toInterface deps -getPublic :: ModuleName.Canonical -> I.DependencyInterface -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore I.Interface) -getPublic (ModuleName.Canonical _ name) dep = +toInterface :: I.DependencyInterface -> I.Interface +toInterface dep = case dep of - I.Public iface -> Just (name, OneOrMore.one iface) - I.Private _ _ _ -> Nothing - - -toUnique :: OneOrMore.OneOrMore a -> Maybe a -toUnique oneOrMore = - case oneOrMore of - OneOrMore.One value -> Just value - OneOrMore.More _ _ -> Nothing - - -allProjectInterfaces :: NE.List FilePath -> IO (Map.Map ModuleName.Raw I.Interface) + I.Public iface -> iface + I.Private pkg unions aliases -> + I.Interface + { I._home = pkg + , I._values = Map.empty + , I._unions = Map.map I.PrivateUnion unions + , I._aliases = Map.map I.PrivateAlias aliases + , I._binops = Map.empty + } + + +allProjectInterfaces :: NE.List FilePath -> IO (Map.Map ModuleName.Canonical I.Interface) allProjectInterfaces paths = BW.withScope $ \scope -> do root <- getProjectRoot "allProjectInterfaces" @@ -146,7 +145,7 @@ runTaskUnsafe task = do \\n" ++ (exit & Exit.reactorToReport & Exit.toJson & Encode.encode & builderToString) -extractInterfaces :: [Build.Module] -> IO (Map.Map ModuleName.Raw I.Interface) +extractInterfaces :: [Build.Module] -> IO (Map.Map ModuleName.Canonical I.Interface) extractInterfaces modu = do k <- modu & mapM (\m -> @@ -156,7 +155,7 @@ extractInterfaces modu = do Build.Cached name _ mCachedInterface -> cachedHelp name mCachedInterface ) - pure $ Map.fromList $ justs k + pure $ Map.fromList $ fmap (\(nameRaw, iface) -> (ModuleName.Canonical Pkg.dummyName nameRaw, iface)) $ justs k {- Appropriated from Build.loadInterface -} diff --git a/ext-elm-pages/Ext/ElmPages.hs b/ext-elm-pages/Ext/ElmPages.hs index 6cc3d72ae..6640cfcc3 100644 --- a/ext-elm-pages/Ext/ElmPages.hs +++ b/ext-elm-pages/Ext/ElmPages.hs @@ -65,7 +65,7 @@ data DiffableType checkPageDataType :: Interfaces -> Either Reporting.Exit.BuildProblem () checkPageDataType interfaces = - case Map.lookup "Main" interfaces of + case Map.lookup (ModuleName.Canonical Pkg.dummyName "Main") interfaces of Just targetInterface -> if typeExists "PageData" targetInterface then do @@ -125,11 +125,7 @@ wireError formattedErrors = {- Tracks types that have already been seen to ensure we can break cycles -} type RecursionSet = - Set.Set (ModuleName.Raw, N.Name, [Can.Type]) - - -nameRaw :: ModuleName.Canonical -> ModuleName.Raw -nameRaw (ModuleName.Canonical (Pkg.Name author pkg) module_) = module_ + Set.Set (ModuleName.Canonical, N.Name, [Can.Type]) diffableTypeByName :: Interfaces -> N.Name -> ModuleName.Canonical -> Interface.Interface -> DiffableType @@ -137,7 +133,7 @@ diffableTypeByName interfaces targetName modul interface = do let moduleName = ModuleName._module modul currentModule = modul - recursionSet = Set.singleton (moduleName, targetName, []) + recursionSet = Set.singleton (modul, targetName, []) case Map.lookup targetName $ Interface._aliases interface of Just alias -> do @@ -228,7 +224,7 @@ canonicalToDiffableType targetName currentModule interfaces recursionSet canonic let currentModule_ = moduleName - recursionIdentifier = (nameRaw moduleName, name, tvarResolvedParams) + recursionIdentifier = (moduleName, name, tvarResolvedParams) newRecursionSet = Set.insert recursionIdentifier recursionSet @@ -367,7 +363,7 @@ canonicalToDiffableType targetName currentModule interfaces recursionSet canonic (author, pkg, module_, tipe) -> -- Anything else must not be a core type, recurse to find it - case Map.lookup (nameRaw moduleName) interfaces of + case Map.lookup moduleName interfaces of Just subInterface -> -- Try unions diff --git a/extra/Lamdera/Evergreen/MigrationGenerator.hs b/extra/Lamdera/Evergreen/MigrationGenerator.hs index 3bb7b3fa9..5a0b3f919 100644 --- a/extra/Lamdera/Evergreen/MigrationGenerator.hs +++ b/extra/Lamdera/Evergreen/MigrationGenerator.hs @@ -43,10 +43,10 @@ betweenVersions coreTypeDiffs oldVersion newVersion root = do res <- Ext.Common.withProjectRoot root $ do interfaces <- Ext.Query.Interfaces.all (NE.toList paths) - case Map.lookup (N.fromChars moduleNameString) interfaces of + case Map.lookup (ModuleName.Canonical Pkg.dummyName (N.fromChars moduleNameString)) interfaces of Just interface -> do debug $ "starting generatefor" - generateFor coreTypeDiffs oldVersion newVersion interfaces (interfaces Sanity.! (N.fromChars $ "Evergreen.V" <> show newVersion <> ".Types")) + generateFor coreTypeDiffs oldVersion newVersion interfaces (interfaces Sanity.! (ModuleName.Canonical Pkg.dummyName (N.fromChars $ "Evergreen.V" <> show newVersion <> ".Types"))) Nothing -> error $ "Fatal: could not find the module `" <> moduleNameString <> "`, please report this issue in Discord with your project code." diff --git a/extra/Lamdera/Evergreen/MigrationGeneratorHelpers.hs b/extra/Lamdera/Evergreen/MigrationGeneratorHelpers.hs index 972caeb25..24f36c0b7 100644 --- a/extra/Lamdera/Evergreen/MigrationGeneratorHelpers.hs +++ b/extra/Lamdera/Evergreen/MigrationGeneratorHelpers.hs @@ -601,7 +601,7 @@ findTypeDef tipe interfaces = findDef :: ModuleName.Canonical -> N.Name -> Interfaces -> Maybe TypeDef findDef moduleNameCan typeName interfaces = - case Map.lookup (dropCan moduleNameCan) interfaces of + case Map.lookup moduleNameCan interfaces of Just moduleInterface -> findDef_ moduleNameCan typeName moduleInterface diff --git a/extra/Lamdera/Evergreen/Snapshot.hs b/extra/Lamdera/Evergreen/Snapshot.hs index 0c54d98f9..028c212d4 100644 --- a/extra/Lamdera/Evergreen/Snapshot.hs +++ b/extra/Lamdera/Evergreen/Snapshot.hs @@ -47,7 +47,7 @@ type snapshots -} run :: Int -> IO () run version = do ifaces <- Interfaces.all [ "src/Types.elm" ] - snapshotCurrentTypes version ifaces (ifaces ! "Types") + snapshotCurrentTypes version ifaces (ifaces ! ModuleName.Canonical Pkg.dummyName "Types") snapshotCurrentTypes :: Int -> Interfaces -> Interface.Interface -> IO () @@ -665,7 +665,7 @@ canonicalToFt version scope interfaces recursionSet canonical tvarMap = (author, pkg, module_, tipe) -> -- Anything else must not be a core type, recurse to find it - case Map.lookup moduleNameRaw interfaces of + case Map.lookup moduleName interfaces of Just subInterface -> -- Try unions diff --git a/extra/Lamdera/Make.hs b/extra/Lamdera/Make.hs index 57ffb710b..5971ec554 100644 --- a/extra/Lamdera/Make.hs +++ b/extra/Lamdera/Make.hs @@ -25,8 +25,8 @@ import qualified Ext.Query.Interfaces --- compileToInterfaces :: FilePath -> FilePath -> IO (Map.Map ModuleName.Raw I.Interface) -compileToInterfaces :: FilePath -> FilePath -> [FilePath] -> IO (Either Exit.Make (Map.Map ModuleName.Raw I.Interface)) +-- compileToInterfaces :: FilePath -> FilePath -> IO (Map.Map ModuleName.Canonical I.Interface) +compileToInterfaces :: FilePath -> FilePath -> [FilePath] -> IO (Either Exit.Make (Map.Map ModuleName.Canonical I.Interface)) compileToInterfaces root path additional = do Ext.Common.withProjectRoot root $ do let diff --git a/extra/Lamdera/TypeHash.hs b/extra/Lamdera/TypeHash.hs index a29f0023e..48f4e9b6a 100644 --- a/extra/Lamdera/TypeHash.hs +++ b/extra/Lamdera/TypeHash.hs @@ -80,13 +80,13 @@ buildCheckHashes artifacts = do {- Tracks types that have already been seen to ensure we can break cycles -} type RecursionSet = - Set.Set (ModuleName.Raw, N.Name, [Type]) + Set.Set (ModuleName.Canonical, N.Name, [Type]) calculateHashPair :: FilePath -> N.Name -> N.Name -> IO (Text, Text) calculateHashPair path modulename typename = do interfaces <- Interfaces.all [ path ] - case Map.lookup modulename interfaces of + case Map.lookup (ModuleName.Canonical Pkg.dummyName modulename) interfaces of Just interfaceModule -> do let dt = diffableTypeByName interfaces typename modulename interfaceModule pure $ (diffableTypeToHash dt, diffableTypeToText dt) @@ -99,7 +99,7 @@ calculateLamderaHashes = do debug $ "#️⃣ typehash: full with interface load" interfaces <- Interfaces.all [ "src/Types.elm" ] inDebug <- Lamdera.isDebug - case Map.lookup "Types" interfaces of + case Map.lookup (ModuleName.Canonical Pkg.dummyName "Types") interfaces of Just iface_Types -> calculateLamderaHashes_ interfaces iface_Types inDebug @@ -172,7 +172,7 @@ calculateLamderaHashes_ interfaces iface_Types inDebug = do diffableTypeByName :: Interfaces -> N.Name -> N.Name -> Interface.Interface -> DiffableType diffableTypeByName interfaces targetName moduleName interface = do let - recursionSet = Set.singleton (moduleName, targetName, []) + recursionSet = Set.singleton (ModuleName.Canonical Pkg.dummyName moduleName, targetName, []) case Map.lookup targetName $ Interface._aliases interface of Just alias -> do @@ -240,8 +240,6 @@ aliasToDiffableType targetName interfaces recursionSet tvarMap aliasInterface pa Interface.PublicAlias a -> treat a Interface.PrivateAlias a -> treat a -nameRaw (ModuleName.Canonical (Pkg.Name author pkg) module_) = module_ - -- = TLambda Type Type -- | TVar N.Name -- | TType ModuleName.Canonical N.Name [Type] @@ -254,7 +252,7 @@ canonicalToDiffableType targetName interfaces recursionSet canonical tvarMap = case canonical of TType moduleName name params -> let - recursionIdentifier = (nameRaw moduleName, name, tvarResolvedParams) + recursionIdentifier = (moduleName, name, tvarResolvedParams) newRecursionSet = Set.insert recursionIdentifier recursionSet @@ -420,7 +418,7 @@ canonicalToDiffableType targetName interfaces recursionSet canonical tvarMap = (author, pkg, module_, tipe) -> -- Anything else must not be a core type, recurse to find it - case Map.lookup (nameRaw moduleName) interfaces of + case Map.lookup moduleName interfaces of Just subInterface -> -- Try unions diff --git a/extra/Lamdera/Types.hs b/extra/Lamdera/Types.hs index 446547e77..10967a9a6 100644 --- a/extra/Lamdera/Types.hs +++ b/extra/Lamdera/Types.hs @@ -11,7 +11,7 @@ import qualified Elm.ModuleName as ModuleName import Lamdera type Interfaces = - Map.Map ModuleName.Raw Interface.Interface + Map.Map ModuleName.Canonical Interface.Interface data DiffableType