From 31545d1252ac8f4efe456a2710e43777e45accc0 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Fri, 28 Aug 2015 16:24:43 -0700 Subject: [PATCH] canonicalize module names, generate unambiguous names in JS Begging to address #826 --- elm-compiler.cabal | 1 + src/AST/Module.hs | 55 ++++---------- src/AST/Module/Name.hs | 50 ++++++++++++ src/AST/Variable.hs | 27 ++++--- src/Canonicalize.hs | 25 ++++-- src/Canonicalize/Declaration.hs | 6 +- src/Canonicalize/Environment.hs | 6 +- src/Canonicalize/Result.hs | 8 +- src/Canonicalize/Setup.hs | 70 +++++++++-------- src/Canonicalize/Variable.hs | 22 +++--- src/Compile.hs | 42 +++------- src/Elm/Compiler.hs | 23 +++--- src/Elm/Compiler/Module.hs | 35 ++------- src/Elm/Package.hs | 29 ++++--- src/Generate/JavaScript.hs | 114 ++-------------------------- src/Generate/JavaScript/Variable.hs | 57 +++++++++----- src/Nitpick/PatternMatches.hs | 5 +- src/Nitpick/TopLevelTypes.hs | 78 ++++++++++++------- src/Parse/Module.hs | 12 ++- src/Parse/Parse.hs | 29 ++++--- src/Reporting/Error/Canonicalize.hs | 16 ++-- src/Reporting/Warning.hs | 6 +- src/Type/Inference.hs | 49 +++++++----- 23 files changed, 360 insertions(+), 405 deletions(-) create mode 100644 src/AST/Module/Name.hs diff --git a/elm-compiler.cabal b/elm-compiler.cabal index 24099cd1f..5e8af2741 100644 --- a/elm-compiler.cabal +++ b/elm-compiler.cabal @@ -56,6 +56,7 @@ Library AST.Helpers, AST.Literal, AST.Module, + AST.Module.Name, AST.Pattern, AST.Type, AST.Variable, diff --git a/src/AST/Module.hs b/src/AST/Module.hs index 8f4f78feb..ba147b9ab 100644 --- a/src/AST/Module.hs +++ b/src/AST/Module.hs @@ -1,24 +1,22 @@ module AST.Module - ( Interfaces, CanonicalInterfaces + ( Interfaces , Types, Aliases, ADTs , AdtInfo, CanonicalAdt , SourceModule, ValidModule, CanonicalModule, Optimized , Module(..), Body(..) , Header(..) - , Name, nameToString, nameIsNative - , CanonicalName(..), canonPkg, canonModul , Interface(..), toInterface , UserImport, DefaultImport, ImportMethod(..) ) where import Control.Applicative ((<$>),(<*>)) import Data.Binary -import qualified Data.List as List import qualified Data.Map as Map import qualified AST.Declaration as Decl import qualified AST.Expression.Canonical as Canonical import qualified AST.Expression.Optimized as Optimized +import qualified AST.Module.Name as Name import qualified AST.Type as Type import qualified AST.Variable as Var import qualified Docs.AST as Docs @@ -29,8 +27,7 @@ import qualified Reporting.Annotation as A -- HELPFUL TYPE ALIASES -type Interfaces = Map.Map Name Interface -type CanonicalInterfaces = Map.Map CanonicalName Interface +type Interfaces = Map.Map Name.Canonical Interface type Types = Map.Map String Type.Canonical type Aliases = Map.Map String ([String], Type.Canonical) @@ -59,15 +56,15 @@ type ValidModule = type CanonicalModule = - Module Docs.Centralized [Name] [Var.Value] (Body Canonical.Expr) + Module Docs.Centralized [Name.Raw] [Var.Value] (Body Canonical.Expr) type Optimized = - Module Docs.Centralized [Name] [Var.Value] (Body Optimized.Expr) + Module Docs.Centralized [Name.Raw] [Var.Value] (Body Optimized.Expr) data Module docs imports exports body = Module - { names :: Name + { name :: Name.Canonical , path :: FilePath , docs :: A.Located (Maybe docs) , exports :: exports @@ -90,41 +87,19 @@ data Body expr = Body {-| Basic info needed to identify modules and determine dependencies. -} data Header imports = Header - { _names :: Name + { _name :: Name.Raw , _docs :: A.Located (Maybe String) , _exports :: Var.Listing (A.Located Var.Value) , _imports :: imports } -type Name = [String] -- must be non-empty - - -data CanonicalName = - CanonicalName - { canonPkg :: Package.Name - , canonModul :: Name - } - - -nameToString :: Name -> String -nameToString = - List.intercalate "." - - -nameIsNative :: Name -> Bool -nameIsNative name = - case name of - "Native" : _ -> True - _ -> False - - -- IMPORTs -type UserImport = A.Located (Name, ImportMethod) +type UserImport = A.Located (Name.Raw, ImportMethod) -type DefaultImport = (Name, ImportMethod) +type DefaultImport = (Name.Raw, ImportMethod) data ImportMethod = ImportMethod @@ -137,15 +112,15 @@ data ImportMethod = ImportMethod {-| Key facts about a module, used when reading info from .elmi files. -} data Interface = Interface - { iVersion :: String + { iVersion :: Package.Version + , iPackage :: Package.Name , iExports :: [Var.Value] , iTypes :: Types - , iImports :: [Name] + , iImports :: [Name.Raw] , iAdts :: ADTs , iAliases :: Aliases , iFixities :: [(Decl.Assoc, Int, String)] , iPorts :: [String] - , iPackage :: Package.Name } @@ -153,7 +128,8 @@ toInterface :: Package.Name -> CanonicalModule -> Interface toInterface pkgName modul = let body' = body modul in Interface - { iVersion = Package.versionToString Compiler.version + { iVersion = Compiler.version + , iPackage = pkgName , iExports = exports modul , iTypes = types body' , iImports = imports modul @@ -161,7 +137,6 @@ toInterface pkgName modul = , iAliases = aliases body' , iFixities = fixities body' , iPorts = ports body' - , iPackage = pkgName } @@ -169,6 +144,7 @@ instance Binary Interface where get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get put modul = do put (iVersion modul) + put (iPackage modul) put (iExports modul) put (iTypes modul) put (iImports modul) @@ -176,4 +152,3 @@ instance Binary Interface where put (iAliases modul) put (iFixities modul) put (iPorts modul) - put (iPackage modul) diff --git a/src/AST/Module/Name.hs b/src/AST/Module/Name.hs new file mode 100644 index 000000000..d8baaa692 --- /dev/null +++ b/src/AST/Module/Name.hs @@ -0,0 +1,50 @@ +module AST.Module.Name where + +import Control.Applicative ((<$>),(<*>)) +import Data.Binary +import qualified Data.List as List + +import qualified Elm.Package as Package + + +type Raw = [String] -- must be non-empty + + +data Canonical = Canonical + { _package :: Package.Name + , _module :: Raw + } + deriving (Eq, Ord, Show) + + +inCore :: Raw -> Canonical +inCore raw = + Canonical Package.coreName raw + + +toString :: Raw -> String +toString rawName = + List.intercalate "." rawName + + +canonicalToString :: Canonical -> String +canonicalToString (Canonical _ rawName) = + toString rawName + + +isNative :: Raw -> Bool +isNative name = + case name of + "Native" : _ -> + True + + _ -> + False + + +instance Binary Canonical where + put (Canonical home name) = + put home >> put name + + get = + Canonical <$> get <*> get \ No newline at end of file diff --git a/src/AST/Variable.hs b/src/AST/Variable.hs index e6cf611b4..f75fa821f 100644 --- a/src/AST/Variable.hs +++ b/src/AST/Variable.hs @@ -2,12 +2,12 @@ module AST.Variable where import Control.Applicative ((<$>), (<*>)) import Data.Binary -import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Maybe as Maybe import Text.PrettyPrint as P import qualified AST.Helpers as Help +import qualified AST.Module.Name as ModuleName import qualified Reporting.PrettyPrint as P @@ -19,8 +19,8 @@ newtype Raw = Raw String data Home = BuiltIn - | Module [String] - | TopLevel [String] + | Module ModuleName.Canonical + | TopLevel ModuleName.Canonical | Local deriving (Eq, Ord, Show) @@ -37,9 +37,9 @@ local x = Canonical Local x -topLevel :: [String] -> String -> Canonical -topLevel names x = - Canonical (TopLevel names) x +topLevel :: ModuleName.Canonical -> String -> Canonical +topLevel home x = + Canonical (TopLevel home) x builtin :: String -> Canonical @@ -47,16 +47,21 @@ builtin x = Canonical BuiltIn x -fromModule :: [String] -> String -> Canonical +fromModule :: ModuleName.Canonical -> String -> Canonical fromModule home name = Canonical (Module home) name +inCore :: ModuleName.Raw -> String -> Canonical +inCore home name = + Canonical (Module (ModuleName.inCore home)) name + + -- VARIABLE RECOGNIZERS -is :: [String] -> String -> Canonical -> Bool +is :: ModuleName.Raw -> String -> Canonical -> Bool is home name var = - var == Canonical (Module home) name + var == inCore home name isJson :: Canonical -> Bool @@ -133,8 +138,8 @@ instance ToString Canonical where BuiltIn -> name - Module path -> - List.intercalate "." (path ++ [name]) + Module moduleName -> + ModuleName.canonicalToString moduleName ++ "." ++ name TopLevel _ -> name diff --git a/src/Canonicalize.hs b/src/Canonicalize.hs index 69c7dc04f..2c4750450 100644 --- a/src/Canonicalize.hs +++ b/src/Canonicalize.hs @@ -10,12 +10,14 @@ import qualified Data.Foldable as T import AST.Expression.General (Expr'(..), dummyLet) import AST.Module (Body(..)) +import Elm.Utils ((|>)) import qualified AST.Declaration as D import qualified AST.Expression.General as E import qualified AST.Expression.Valid as Valid import qualified AST.Expression.Canonical as Canonical import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Pattern as P import qualified AST.Type as Type import qualified AST.Variable as Var @@ -41,13 +43,19 @@ import qualified Canonicalize.Variable as Canonicalize -- MODULES module' - :: Module.Interfaces + :: [ModuleName.Canonical] + -> Module.Interfaces -> Module.ValidModule -> R.Result Warning.Warning Error.Error Module.CanonicalModule -module' interfaces modul = +module' canonicalImports interfaces modul = let + importDict = + canonicalImports + |> map (\cName -> (ModuleName._module cName, cName)) + |> Map.fromList + (Result.Result uses rawResults) = - moduleHelp interfaces modul + moduleHelp importDict interfaces modul in case rawResults of Result.Ok (env, almostCanonicalModule) -> @@ -67,10 +75,11 @@ type AlmostCanonicalModule = moduleHelp - :: Module.Interfaces + :: Map.Map ModuleName.Raw ModuleName.Canonical + -> Module.Interfaces -> Module.ValidModule -> Result.ResultErr (Env.Environment, AlmostCanonicalModule) -moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) = +moduleHelp importDict interfaces modul@(Module.Module _ _ comment exports _ decls) = canonicalModule <$> canonicalDeclsResult <*> resolveExports locals exports @@ -88,7 +97,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) = concatMap declToValue decls canonicalDeclsResult = - Setup.environment interfaces modul + Setup.environment importDict interfaces modul `Result.andThen` \env -> (,) env <$> T.traverse (declaration env) decls body :: [D.CanonicalDecl] -> Module.Body Canonical.Expr @@ -97,7 +106,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) = in Module.Body { program = - let expr = Decls.toExpr (Module.names modul) decls + let expr = Decls.toExpr (Module.name modul) decls in Sort.definitions (dummyLet expr) @@ -121,7 +130,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) = -- IMPORTS filterImports - :: Set.Set Module.Name + :: Set.Set ModuleName.Raw -> AlmostCanonicalModule -> R.Result Warning.Warning e Module.CanonicalModule filterImports uses modul@(Module.Module _ _ _ _ (defaults, imports) _) = diff --git a/src/Canonicalize/Declaration.hs b/src/Canonicalize/Declaration.hs index 0ce7dd7c1..54b6efb40 100644 --- a/src/Canonicalize/Declaration.hs +++ b/src/Canonicalize/Declaration.hs @@ -4,7 +4,7 @@ module Canonicalize.Declaration (toExpr) where import qualified AST.Declaration as D import qualified AST.Expression.General as E import qualified AST.Expression.Canonical as Canonical -import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Pattern as P import qualified AST.Type as T import qualified AST.Variable as Var @@ -12,12 +12,12 @@ import qualified Reporting.Annotation as A import qualified Reporting.Region as R -toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def] +toExpr :: ModuleName.Canonical -> [D.CanonicalDecl] -> [Canonical.Def] toExpr moduleName decls = concatMap (toDefs moduleName) decls -toDefs :: Module.Name -> D.CanonicalDecl -> [Canonical.Def] +toDefs :: ModuleName.Canonical -> D.CanonicalDecl -> [Canonical.Def] toDefs moduleName (A.A (region,_) decl) = let typeVar = Var.fromModule moduleName diff --git a/src/Canonicalize/Environment.hs b/src/Canonicalize/Environment.hs index efc366ada..da81a4705 100644 --- a/src/Canonicalize/Environment.hs +++ b/src/Canonicalize/Environment.hs @@ -7,7 +7,7 @@ import qualified Data.Maybe as Maybe import qualified Data.Set as Set import AST.Expression.General (saveEnvName) -import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Pattern as P import qualified AST.Type as Type import qualified AST.Variable as Var @@ -17,7 +17,7 @@ import Elm.Utils ((|>)) -- ENVIRONMENT data Environment = Env - { _home :: Module.Name + { _home :: ModuleName.Canonical , _values :: Dict Var.Canonical , _adts :: Dict Var.Canonical , _aliases :: Dict (Var.Canonical, [String], Type.Canonical) @@ -29,7 +29,7 @@ type Dict a = Map.Map String (Set.Set a) -fromPatches :: Module.Name -> [Patch] -> Environment +fromPatches :: ModuleName.Canonical -> [Patch] -> Environment fromPatches moduleName patches = addPatches patches diff --git a/src/Canonicalize/Result.hs b/src/Canonicalize/Result.hs index 6c2d7dc53..c80a9ce3f 100644 --- a/src/Canonicalize/Result.hs +++ b/src/Canonicalize/Result.hs @@ -6,7 +6,7 @@ import qualified Control.Applicative as A import qualified Data.Functor as F import qualified Data.Set as Set -import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Variable as Var import qualified Reporting.Annotation as A import qualified Reporting.Error.Canonicalize as Error @@ -16,7 +16,7 @@ type ResultErr a = Result (A.Located Error.Error) a data Result err a = - Result (Set.Set Module.Name) (RawResult err a) + Result (Set.Set ModuleName.Raw) (RawResult err a) data RawResult err a @@ -95,7 +95,7 @@ instance A.Applicative (Result e) where -- TRACK USES OF IMPORTS -addModule :: Module.Name -> Result e a -> Result e a +addModule :: ModuleName.Raw -> Result e a -> Result e a addModule home (Result uses result) = Result (Set.insert home uses) result @@ -103,7 +103,7 @@ addModule home (Result uses result) = var' :: (a -> Var.Canonical) -> a -> Result e a var' toVar value = case toVar value of - Var.Canonical (Var.Module moduleName) _name -> + Var.Canonical (Var.Module (ModuleName.Canonical _ moduleName)) _name -> Result (Set.singleton moduleName) (Ok value) Var.Canonical _ _ -> diff --git a/src/Canonicalize/Setup.hs b/src/Canonicalize/Setup.hs index eaddb23bd..9322ae0bb 100644 --- a/src/Canonicalize/Setup.hs +++ b/src/Canonicalize/Setup.hs @@ -11,6 +11,7 @@ import qualified Data.Traversable as Trav import qualified AST.Declaration as D import qualified AST.Expression.Valid as Valid import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Pattern as P import qualified AST.Type as Type import qualified AST.Variable as Var @@ -25,50 +26,57 @@ import qualified Canonicalize.Type as Canonicalize environment - :: Module.Interfaces + :: Map.Map ModuleName.Raw ModuleName.Canonical + -> Module.Interfaces -> Module.ValidModule -> Result.ResultErr Env.Environment -environment interfaces modul@(Module.Module _ _ _ _ (defaults, imports) decls) = - let moduleName = - Module.names modul +environment importDict interfaces (Module.Module name _ _ _ (defaults, imports) decls) = + let + allImports = + imports ++ map (A.A (error "default import not found")) defaults - allImports = - imports ++ map (A.A (error "default import not found")) defaults + importPatchesResult = + concat <$> Trav.traverse (importPatches importDict interfaces) allImports - importPatchesResult = - concat <$> Trav.traverse (importPatches interfaces) allImports + (typeAliasNodes, declPatches) = + declarationsToPatches name decls - (typeAliasNodes, declPatches) = - declarationsToPatches moduleName decls - - patches = - (++) (Env.builtinPatches ++ declPatches) <$> importPatchesResult + patches = + (++) (Env.builtinPatches ++ declPatches) <$> importPatchesResult in - (Env.fromPatches moduleName <$> patches) - `Result.andThen` addTypeAliases moduleName typeAliasNodes + (Env.fromPatches name <$> patches) + `Result.andThen` addTypeAliases name typeAliasNodes -- PATCHES FOR IMPORTS importPatches - :: Module.Interfaces - -> A.Located (Module.Name, Module.ImportMethod) + :: Map.Map ModuleName.Raw ModuleName.Canonical + -> Module.Interfaces + -> A.Located (ModuleName.Raw, Module.ImportMethod) -> Result.ResultErr [Env.Patch] -importPatches allInterfaces (A.A region (importName, method)) = - case restrictToPublicApi <$> Map.lookup importName allInterfaces of +importPatches importDict allInterfaces (A.A region (rawImportName, method)) = + let + maybeInterface = + do canonicalName <- Map.lookup rawImportName importDict + interface <- Map.lookup canonicalName allInterfaces + return (canonicalName, restrictToPublicApi interface) + in + case maybeInterface of Nothing -> - if Module.nameIsNative importName then + if ModuleName.isNative rawImportName then Result.ok [] else allInterfaces |> Map.keys - |> Error.nearbyNames Module.nameToString importName - |> Error.moduleNotFound importName + |> map ModuleName._module + |> Error.nearbyNames ModuleName.toString rawImportName + |> Error.moduleNotFound rawImportName |> A.A region |> Result.err - Just interface -> + Just (importName, interface) -> let (Module.ImportMethod maybeAlias listing) = method @@ -76,7 +84,7 @@ importPatches allInterfaces (A.A region (importName, method)) = listing qualifier = - maybe (Module.nameToString importName) id maybeAlias + maybe (ModuleName.toString rawImportName) id maybeAlias qualifiedPatches = interfacePatches importName (qualifier ++ ".") interface @@ -89,7 +97,7 @@ importPatches allInterfaces (A.A region (importName, method)) = (++) qualifiedPatches <$> unqualifiedPatches -interfacePatches :: Module.Name -> String -> Module.Interface -> [Env.Patch] +interfacePatches :: ModuleName.Canonical -> String -> Module.Interface -> [Env.Patch] interfacePatches moduleName prefix interface = let genericPatch mkPatch name value = mkPatch (prefix ++ name) value @@ -124,7 +132,7 @@ interfacePatches moduleName prefix interface = valueToPatches :: R.Region - -> Module.Name + -> ModuleName.Canonical -> Module.Interface -> Var.Value -> Result.ResultErr [Env.Patch] @@ -139,7 +147,7 @@ valueToPatches region moduleName interface value = Module.iExports interface |> getNames |> Error.nearbyNames id x - |> Error.valueNotFound moduleName x + |> Error.valueNotFound (ModuleName._module moduleName) x |> A.A region |> Result.err in @@ -232,7 +240,7 @@ node region name tvars alias = addTypeAliases - :: Module.Name + :: ModuleName.Canonical -> [Node] -> Env.Environment -> Result.ResultErr Env.Environment @@ -244,7 +252,7 @@ addTypeAliases moduleName typeAliasNodes initialEnv = addTypeAlias - :: Module.Name + :: ModuleName.Canonical -> Graph.SCC (R.Region, String, [String], Type.Raw) -> Env.Environment -> Result.ResultErr Env.Environment @@ -272,7 +280,7 @@ addTypeAlias moduleName scc env = -- DECLARATIONS TO PATCHES declarationsToPatches - :: Module.Name + :: ModuleName.Canonical -> [D.ValidDecl] -> ([Node], [Env.Patch]) declarationsToPatches moduleName decls = @@ -288,7 +296,7 @@ declarationsToPatches moduleName decls = -- _values that are defined as top-level declarations are (Var.TopLevel ...) -- all other _values are local (Var.Local) declToPatches - :: Module.Name + :: ModuleName.Canonical -> D.ValidDecl -> (Maybe Node, [Env.Patch]) declToPatches moduleName (A.A (region,_) decl) = diff --git a/src/Canonicalize/Variable.hs b/src/Canonicalize/Variable.hs index 815f07f43..3cb64cec7 100644 --- a/src/Canonicalize/Variable.hs +++ b/src/Canonicalize/Variable.hs @@ -6,7 +6,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified AST.Helpers as Help -import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Type as Type import qualified AST.Variable as Var import qualified Reporting.Annotation as A @@ -22,8 +22,8 @@ variable :: R.Region -> Env.Environment -> String -> Result.ResultErr Var.Canoni variable region env var = case toVarName var of Right (name, varName) - | Module.nameIsNative name -> - Result.var (Var.Canonical (Var.Module name) varName) + | ModuleName.isNative name -> + error "TODO" "Result.var (Var.Canonical (Var.Module name) varName)" _ -> case Set.toList `fmap` Map.lookup var (Env._values env) of @@ -134,7 +134,7 @@ preferLocals' region env extract kind possibilities var = vars = map (Var.toString . extract) possibleVars -isLocal :: [String] -> Var.Canonical -> Bool +isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool isLocal contextName (Var.Canonical home _) = case home of Var.Local -> @@ -163,7 +163,7 @@ isTopLevel (Var.Canonical home _) = -- NOT FOUND HELPERS type VarName = - Either String (Module.Name, String) + Either String (ModuleName.Raw, String) toVarName :: String -> VarName @@ -180,9 +180,9 @@ noQualifier name = Right (_, x) -> x -qualifiedToString :: (Module.Name, String) -> String +qualifiedToString :: (ModuleName.Raw, String) -> String qualifiedToString (modul, name) = - Module.nameToString (modul ++ [name]) + ModuleName.toString modul ++ "." ++ name isOp :: VarName -> Bool @@ -225,16 +225,16 @@ exposedProblem name possibleNames = qualifiedProblem - :: Module.Name + :: ModuleName.Raw -> String - -> [(Module.Name, String)] + -> [(ModuleName.Raw, String)] -> (Error.VarProblem, [String]) qualifiedProblem moduleName name allQualified = let availableModules = Set.fromList (map fst allQualified) moduleNameString = - Module.nameToString moduleName + ModuleName.toString moduleName in case Set.member moduleName availableModules of True -> @@ -248,6 +248,6 @@ qualifiedProblem moduleName name allQualified = False -> ( Error.UnknownQualifier moduleNameString name , Set.toList availableModules - |> map Module.nameToString + |> map ModuleName.toString |> Error.nearbyNames id moduleNameString ) diff --git a/src/Compile.hs b/src/Compile.hs index 5a982de40..756c91952 100644 --- a/src/Compile.hs +++ b/src/Compile.hs @@ -3,6 +3,7 @@ module Compile (compile) where import qualified Data.Map as Map import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified Canonicalize import Elm.Utils ((|>)) import qualified Elm.Package as Package @@ -17,31 +18,23 @@ import qualified Type.Inference as TI compile - :: Map.Map Module.Name Package.Name - -> Package.Name + :: Package.Name -> Bool - -> Module.CanonicalInterfaces + -> [ModuleName.Canonical] + -> Module.Interfaces -> String -> Result.Result Warning.Warning Error.Error Module.CanonicalModule -compile importedPackages packageName isRoot interfaces source = +compile packageName isRoot canonicalImports interfaces source = do - -- determine if default imports should be added - -- only elm-lang/core is exempt - let needsDefaults = - not (packageName == Package.coreName) - - let normalInterfaces = - unCanonicalizeInterfaces importedPackages interfaces - -- Parse the source code validModule <- Result.mapError Error.Syntax $ - Parse.program needsDefaults isRoot (getOpTable interfaces) source + Parse.program packageName isRoot (getOpTable interfaces) source -- Canonicalize all variables, pinning down where they came from. canonicalModule <- - Canonicalize.module' normalInterfaces validModule + Canonicalize.module' canonicalImports interfaces validModule -- Run type inference on the program. types <- @@ -52,7 +45,7 @@ compile importedPackages packageName isRoot interfaces source = Result.mapError Error.Type $ Nitpick.topLevelTypes types (Module.body validModule) - Nitpick.patternMatches normalInterfaces canonicalModule + Nitpick.patternMatches interfaces canonicalModule -- Add the real list of types let body = (Module.body canonicalModule) { Module.types = types } @@ -60,26 +53,9 @@ compile importedPackages packageName isRoot interfaces source = return $ canonicalModule { Module.body = body } -getOpTable :: Module.CanonicalInterfaces -> Parse.OpTable +getOpTable :: Module.Interfaces -> Parse.OpTable getOpTable interfaces = Map.elems interfaces |> concatMap Module.iFixities |> map (\(assoc,lvl,op) -> (op,(lvl,assoc))) |> Map.fromList - - -unCanonicalizeInterfaces - :: Map.Map Module.Name Package.Name - -> Module.CanonicalInterfaces - -> Module.Interfaces -unCanonicalizeInterfaces packageInfo ifaces = - let - foldFun canonName iface mapSoFar = - case Map.lookup (Module.canonModul canonName) packageInfo of - Just pkg | pkg == Module.iPackage iface -> - Map.insert (Module.canonModul canonName) iface mapSoFar - - _ -> - mapSoFar - in - Map.foldrWithKey foldFun Map.empty ifaces diff --git a/src/Elm/Compiler.hs b/src/Elm/Compiler.hs index 8bf78c13d..cbeb48121 100644 --- a/src/Elm/Compiler.hs +++ b/src/Elm/Compiler.hs @@ -50,9 +50,9 @@ parseDependencies sourceCode = Result.Err msgs -> Left $ map (Error . A.map Error.Syntax) msgs - Result.Ok (Module.Header names _docs _exports imports) -> + Result.Ok (Module.Header name _docs _exports imports) -> Right - ( PublicModule.Name names + ( PublicModule.Name name , map (PublicModule.Name . fst . A.drop) imports ) @@ -63,22 +63,16 @@ parseDependencies sourceCode = compile :: Context -> String - -> Map.Map PublicModule.CanonicalName PublicModule.Interface + -> PublicModule.Interfaces -> (Dealiaser, [Warning], Either [Error] Result) compile context source interfaces = let - (Context packageName isRoot isExposed modulePackages) = + (Context packageName isRoot isExposed dependencies) = context - unwrappedInterfaces = - Map.mapKeysMonotonic PublicModule.fromCanonicalName interfaces - - unwrappedPackages = - Map.mapKeysMonotonic (\(PublicModule.Name strs) -> strs ) modulePackages - (Result.Result (dealiaser, warnings) rawResult) = - do modul <- Compile.compile unwrappedPackages packageName isRoot unwrappedInterfaces source + do modul <- Compile.compile packageName isRoot dependencies interfaces source docs <- docsGen isExposed modul let interface = Module.toInterface packageName modul @@ -97,7 +91,7 @@ data Context = Context { _packageName :: Package.Name , _isRoot :: Bool , _isExposed :: Bool - , _modulePackages :: Map.Map PublicModule.Name Package.Name + , _dependencies :: [PublicModule.Canonical] } @@ -120,8 +114,11 @@ docsGen isExposed modul = getChecked = Docs.check (Module.exports modul) (Module.docs modul) + name = + PublicModule.Name (PublicModule._module (Module.name modul)) + toDocs checked = - Docs.fromCheckedDocs (PublicModule.Name (Module.names modul)) checked + Docs.fromCheckedDocs name checked in (Just . toDocs) `fmap` Result.mapError Error.Docs getChecked diff --git a/src/Elm/Compiler/Module.hs b/src/Elm/Compiler/Module.hs index 260760b12..39f4bac12 100644 --- a/src/Elm/Compiler/Module.hs +++ b/src/Elm/Compiler/Module.hs @@ -1,13 +1,12 @@ module Elm.Compiler.Module - ( Interface, Name(Name), name - , CanonicalName(CanonicalName), canonicalName, canonPkg, canonModul - , fromCanonicalName, canonFromPackage + ( Interface, Interfaces, Name(Name) , nameToPath , nameToString, nameFromString , hyphenate, dehyphenate , defaultImports , interfacePorts , interfaceAliasedTypes + , ModuleName.Canonical(..) ) where @@ -21,10 +20,10 @@ import qualified Data.Text as Text import System.FilePath (()) import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified Elm.Compiler.Imports as Imports import qualified Elm.Compiler.Type as Type import qualified Elm.Compiler.Type.Extract as Extract -import qualified Elm.Package as Package -- EXPOSED TYPES @@ -32,33 +31,11 @@ import qualified Elm.Package as Package type Interface = Module.Interface -newtype Name = Name [String] - deriving (Eq, Ord) - -data CanonicalName = - CanonicalName - { canonPkg :: Package.Name - , canonVersion :: Package.Version - , canonModul :: Name - } deriving (Eq, Ord) - - -canonFromPackage :: Package.Package -> Name -> CanonicalName -canonFromPackage (pk, vr) nm = - CanonicalName pk vr nm - +type Interfaces = Module.Interfaces -fromCanonicalName :: CanonicalName -> Module.CanonicalName -fromCanonicalName (CanonicalName p _ (Name n)) = - Module.CanonicalName p n - -canonicalName :: Package.Name -> Package.Version -> Name -> CanonicalName -canonicalName = CanonicalName - - -name :: [String] -> Name -name = Name +newtype Name = Name ModuleName.Raw + deriving (Eq, Ord) defaultImports :: [Name] diff --git a/src/Elm/Package.hs b/src/Elm/Package.hs index 1989f4477..555b4e2d2 100644 --- a/src/Elm/Package.hs +++ b/src/Elm/Package.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE FlexibleContexts #-} module Elm.Package where import Control.Applicative ((<$>), (<*>)) -import Control.Monad.Error.Class (MonadError, throwError) import Data.Aeson import Data.Binary import qualified Data.List as List @@ -12,11 +10,14 @@ import System.FilePath (()) import Data.Char (isDigit) import Data.Function (on) + +-- PACKGE NAMES + data Name = Name { user :: String , project :: String } - deriving (Eq, Ord) + deriving (Eq, Ord, Show) type Package = (Name, Version) @@ -55,11 +56,6 @@ fromString string = _ -> Nothing -fromString' :: (MonadError String m) => String -> m Name -fromString' string = - Maybe.maybe (throwError $ errorMsg string) return (fromString string) - - instance Binary Name where get = Name <$> get <*> get put (Name user project) = @@ -69,10 +65,13 @@ instance Binary Name where instance FromJSON Name where parseJSON (String text) = - let string = T.unpack text in - Maybe.maybe (fail $ errorMsg string) return (fromString string) + let + string = T.unpack text + in + Maybe.maybe (fail (errorMsg string)) return (fromString string) - parseJSON _ = fail "Project name must be a string." + parseJSON _ = + fail "Project name must be a string." instance ToJSON Name where @@ -88,12 +87,12 @@ errorMsg string = ] - +-- PACKAGE VERSIONS data Version = Version - { major :: Int - , minor :: Int - , patch :: Int + { _major :: Int + , _minor :: Int + , _patch :: Int } deriving (Eq, Ord) diff --git a/src/Generate/JavaScript.hs b/src/Generate/JavaScript.hs index 1a5104164..8acf01c68 100644 --- a/src/Generate/JavaScript.hs +++ b/src/Generate/JavaScript.hs @@ -6,19 +6,16 @@ import Control.Monad.State import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Maybe as Maybe -import qualified Data.Set as Set -import Language.ECMAScript3.PrettyPrint import Language.ECMAScript3.Syntax -import AST.Module import AST.Expression.General as Expr import qualified AST.Expression.Optimized as Opt import qualified AST.Helpers as Help import AST.Literal import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Pattern as P import qualified AST.Variable as Var -import Elm.Utils ((|>)) import Generate.JavaScript.Helpers as Help import qualified Generate.JavaScript.Crash as Crash import qualified Generate.JavaScript.Port as Port @@ -28,20 +25,12 @@ import qualified Reporting.Annotation as A import qualified Reporting.Crash as Crash --- HELPERS +generate :: Module.Optimized -> String +generate modul = + error "TODO" modul exprToCode -internalImports :: Module.Name -> [VarDecl ()] -internalImports name = - [ varDecl "_N" (obj ["Elm","Native"]) - , include "_U" "Utils" - , include "_L" "List" - , varDecl Crash.localModuleName (string (Module.nameToString name)) - ] - where - include :: String -> String -> VarDecl () - include alias modul = - varDecl alias (Help.make ["_N", modul]) +-- HELPERS _Utils :: String -> Expression () _Utils x = @@ -419,9 +408,6 @@ crushIfsHelp visitedBranches unvisitedBranches finally = (A.A _ (Literal (Boolean True)), branch) : _ -> crushIfsHelp visitedBranches [] branch - (A.A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), branch) : _ -> - crushIfsHelp visitedBranches [] branch - visiting : unvisited -> crushIfsHelp (visiting : visitedBranches) unvisited finally @@ -597,92 +583,6 @@ flattenLets defs lexpr@(A.A _ expr) = _ -> (defs, lexpr) -generate :: Module.Optimized -> String -generate modul = - show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++ - [ assign ("Elm" : names ++ ["make"]) (function [localRuntime] programStmts) ] - where - names :: [String] - names = Module.names modul - - thisModule :: Expression () - thisModule = obj (localRuntime : names ++ ["values"]) - - programStmts :: [Statement ()] - programStmts = - concat - [ [ ExprStmt () (string "use strict") ] - , setup localRuntime (names ++ ["values"]) - , [ IfSingleStmt () thisModule (ret thisModule) ] - , [ VarDeclStmt () localVars ] - , body - , [ jsExports ] - , [ ret thisModule ] - ] - - localVars :: [VarDecl ()] - localVars = - varDecl "_op" (ObjectLit () []) - : internalImports (Module.names modul) - ++ explicitImports - where - explicitImports :: [VarDecl ()] - explicitImports = - Module.imports modul - |> Set.fromList - |> Set.toList - |> map jsImport - - jsImport :: Module.Name -> VarDecl () - jsImport name = - varDecl (Var.moduleName name) $ - obj ("Elm" : name ++ ["make"]) <| ref localRuntime - - body :: [Statement ()] - body = - concat (evalState defs 0) - where - defs = - Module.program (Module.body modul) - |> flattenLets [] - |> fst - |> mapM defToStatements - - setup namespace path = - map create paths - where - create name = - assign name (InfixExpr () OpLOr (obj name) (ObjectLit () [])) - paths = - namespace : path - |> List.inits - |> init - |> drop 2 - - jsExports = - assign (localRuntime : names ++ ["values"]) (ObjectLit () exs) - where - exs = map entry $ "_op" : concatMap extract (exports modul) - entry x = (prop x, ref x) - extract value = - case value of - Var.Alias _ -> [] - - Var.Value x - | Help.isOp x -> [] - | otherwise -> [Var.varName x] - - Var.Union _ (Var.Listing ctors _) -> - map Var.varName ctors - - assign path expr = - case path of - [x] -> VarDeclStmt () [ varDecl x expr ] - _ -> - ExprStmt () $ - AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr - - -- BINARY OPERATORS binop @@ -753,7 +653,7 @@ backwardApply = inBasics :: String -> Var.Canonical inBasics name = - Var.Canonical (Var.Module ["Basics"]) name + Var.inCore ["Basics"] name -- BINARY OPERATOR HELPERS @@ -764,7 +664,7 @@ makeExpr qualifiedOp@(Var.Canonical home op) = simpleMake left right = ref "A2" `call` [ Var.canonical qualifiedOp, left, right ] in - if home == Var.Module ["Basics"] then + if home == Var.Module (ModuleName.inCore ["Basics"]) then Map.findWithDefault simpleMake op basicOps else simpleMake diff --git a/src/Generate/JavaScript/Variable.hs b/src/Generate/JavaScript/Variable.hs index bc97c8a5f..729a488c0 100644 --- a/src/Generate/JavaScript/Variable.hs +++ b/src/Generate/JavaScript/Variable.hs @@ -1,13 +1,15 @@ module Generate.JavaScript.Variable where -import qualified AST.Helpers as Help -import qualified AST.Module as Module -import qualified AST.Variable as Var import qualified Data.List as List import qualified Data.Set as Set -import qualified Generate.JavaScript.Helpers as JS import qualified Language.ECMAScript3.Syntax as JS +import qualified AST.Helpers as Help +import qualified AST.Module.Name as ModuleName +import qualified AST.Variable as Var +import qualified Elm.Package as Pkg +import qualified Generate.JavaScript.Helpers as JS + swap :: Char -> Char -> Char -> Char swap from to c = @@ -16,21 +18,36 @@ swap from to c = canonical :: Var.Canonical -> JS.Expression () canonical (Var.Canonical home name) = - case Help.isOp name of - True -> JS.BracketRef () (JS.obj (home' ++ ["_op"])) (JS.string name) - False -> JS.obj (home' ++ [ varName name ]) - where - home' = - case home of - Var.Local -> [] - Var.TopLevel _ -> [] - Var.BuiltIn -> [] - Var.Module path -> [ moduleName path ] + if Help.isOp name then + JS.BracketRef () (JS.ref (addRoot home "_op")) (JS.string name) + + else + JS.ref (addRoot home (varName name)) + + +addRoot :: Var.Home -> String -> String +addRoot home name = + case home of + Var.Local -> + name + + Var.TopLevel moduleName -> + canonicalName moduleName name + + Var.BuiltIn -> + name + + Var.Module moduleName -> + canonicalName moduleName name + +canonicalName :: ModuleName.Canonical -> String -> String +canonicalName (ModuleName.Canonical (Pkg.Name user project) moduleName) name = + map (swap '-' '_') user + ++ '$' : map (swap '-' '_') project + ++ '$' : List.intercalate "$" moduleName + ++ '$' : name -moduleName :: Module.Name -> String -moduleName name = - '$' : List.intercalate "$" name varName :: String -> String @@ -41,9 +58,9 @@ varName name = map (swap '\'' '$') saferName -value :: Module.Name -> String -> JS.Expression () -value home name = - canonical (Var.Canonical (Var.Module home) name) +--value :: Module.Name -> String -> JS.Expression () +--value home name = +-- canonical (Var.Canonical (Var.Module home) name) jsReserveds :: Set.Set String diff --git a/src/Nitpick/PatternMatches.hs b/src/Nitpick/PatternMatches.hs index bfd49be7c..88eed14e0 100644 --- a/src/Nitpick/PatternMatches.hs +++ b/src/Nitpick/PatternMatches.hs @@ -11,6 +11,7 @@ import qualified AST.Expression.General as E import qualified AST.Expression.Canonical as Canonical import qualified AST.Helpers as Help import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Pattern as Pattern import qualified AST.Variable as Var import Elm.Utils ((|>)) @@ -27,7 +28,7 @@ patternMatches -> Result.Result Warning.Warning e () patternMatches interfaces modul = let - name = Module.names modul + name = Module.name modul body = Module.body modul in checkExpression @@ -44,7 +45,7 @@ type TagDict = type Tag = String -toTagDict :: Module.Interfaces -> Module.Name -> Module.ADTs -> TagDict +toTagDict :: Module.Interfaces -> ModuleName.Canonical -> Module.ADTs -> TagDict toTagDict interfaces localName localAdts = let listTags = diff --git a/src/Nitpick/TopLevelTypes.hs b/src/Nitpick/TopLevelTypes.hs index 34c428103..01e3685d0 100644 --- a/src/Nitpick/TopLevelTypes.hs +++ b/src/Nitpick/TopLevelTypes.hs @@ -7,9 +7,11 @@ import qualified Data.Map as Map import qualified AST.Expression.Valid as Valid import qualified AST.Declaration as Decl +import qualified AST.Module.Name as ModuleName import qualified AST.Pattern as P import qualified AST.Type as Type import qualified AST.Variable as Var +import qualified Elm.Package as Pkg import qualified Reporting.Annotation as A import qualified Reporting.Error.Type as Error import qualified Reporting.Result as Result @@ -77,39 +79,57 @@ validMainTypes = , signal element , signal html ] - where - fromModule :: [String] -> String -> Type.Canonical - fromModule home name = - Type.Type (Var.fromModule home name) - html = - fromModule ["VirtualDom"] "Node" - signal tipe = - Type.App (fromModule ["Signal"] "Signal") [ tipe ] +html :: Type.Canonical +html = + Type.Type (Var.fromModule virtualDom "Node") - element = - let builtin name = - Type.Type (Var.builtin name) - maybe tipe = - Type.App (fromModule ["Maybe"] "Maybe") [ tipe ] - in +virtualDom :: ModuleName.Canonical +virtualDom = + ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"] + + +element :: Type.Canonical +element = + Type.Record + [ ("element", core ["Graphics","Element"] "ElementPrim") + , ("props", Type.Record - [ ("element", fromModule ["Graphics","Element"] "ElementPrim") - , ("props", - Type.Record - [ ("click" , builtin "_Tuple0") - , ("color" , maybe (fromModule ["Color"] "Color")) - , ("height" , builtin "Int") - , ("hover" , builtin "_Tuple0") - , ("href" , builtin "String") - , ("id" , builtin "Int") - , ("opacity", builtin "Float") - , ("tag" , builtin "String") - , ("width" , builtin "Int") - ] - Nothing - ) + [ ("click" , builtin "_Tuple0") + , ("color" , maybe (core ["Color"] "Color")) + , ("height" , builtin "Int") + , ("hover" , builtin "_Tuple0") + , ("href" , builtin "String") + , ("id" , builtin "Int") + , ("opacity", builtin "Float") + , ("tag" , builtin "String") + , ("width" , builtin "Int") ] Nothing + ) + ] + Nothing + + +core :: [String] -> String -> Type.Canonical +core home name = + Type.Type (Var.inCore home name) + + +signal :: Type.Canonical -> Type.Canonical +signal tipe = + Type.App (core ["Signal"] "Signal") [ tipe ] + + +maybe :: Type.Canonical -> Type.Canonical +maybe tipe = + Type.App (core ["Maybe"] "Maybe") [ tipe ] + + +builtin :: String -> Type.Canonical +builtin name = + Type.Type (Var.builtin name) + + diff --git a/src/Parse/Module.hs b/src/Parse/Module.hs index 1130845a6..fd7d43717 100644 --- a/src/Parse/Module.hs +++ b/src/Parse/Module.hs @@ -5,6 +5,7 @@ import Text.Parsec hiding (newline, spaces) import Parse.Helpers import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Variable as Var import Reporting.Annotation as A @@ -12,13 +13,16 @@ import Reporting.Annotation as A getModuleName :: String -> Maybe String getModuleName source = case iParse getModuleName source of - Right name -> Just name - Left _ -> Nothing + Right name -> + Just name + + Left _ -> + Nothing where getModuleName = do optional freshLine (names, _) <- moduleDecl - return (Module.nameToString names) + return (ModuleName.toString names) header :: IParser (Module.Header [Module.UserImport]) @@ -60,7 +64,7 @@ import' = do try (reserved "import") whitespace names <- dotSep1 capVar - (,) names <$> method (Module.nameToString names) + (,) names <$> method (ModuleName.toString names) where method :: String -> IParser Module.ImportMethod method defaultAlias = diff --git a/src/Parse/Parse.hs b/src/Parse/Parse.hs index 5a73aee7d..5846389a2 100644 --- a/src/Parse/Parse.hs +++ b/src/Parse/Parse.hs @@ -9,7 +9,9 @@ import qualified Text.Parsec.Error as Parsec import qualified AST.Declaration as D import qualified AST.Module as M +import qualified AST.Module.Name as ModuleName import qualified Elm.Compiler.Imports as Imports +import qualified Elm.Package as Package import Parse.Helpers import qualified Parse.Module as Module import qualified Parse.Declaration as Decl @@ -20,33 +22,40 @@ import qualified Validate program - :: Bool + :: Package.Name -> Bool -> OpTable -> String -> Result.Result wrn Error.Error M.ValidModule -program needsDefaults isRoot table src = - do (M.Module names filePath docs exports imports sourceDecls) <- - parseWithTable table src programParser +program pkgName isRoot table src = + do (M.Module name filePath docs exports imports sourceDecls) <- + parseWithTable table src (programParser pkgName) validDecls <- Validate.declarations isRoot sourceDecls + -- determine if default imports should be added, only elm-lang/core is exempt let ammendedImports = - (if needsDefaults then Imports.defaults else [], imports) + ( if pkgName == Package.coreName then [] else Imports.defaults + , imports + ) - return (M.Module names filePath docs exports ammendedImports validDecls) + return (M.Module name filePath docs exports ammendedImports validDecls) -- HEADERS AND DECLARATIONS -programParser :: IParser M.SourceModule -programParser = - do (M.Header names docs exports imports) <- Module.header +programParser :: Package.Name -> IParser M.SourceModule +programParser pkgName = + do (M.Header name docs exports imports) <- Module.header decls <- declarations optional freshLine optional spaces eof - return $ M.Module names "" docs exports imports decls + + let canonicalName = + ModuleName.Canonical pkgName name + + return $ M.Module canonicalName "" docs exports imports decls declarations :: IParser [D.SourceDecl] diff --git a/src/Reporting/Error/Canonicalize.hs b/src/Reporting/Error/Canonicalize.hs index 89c32fb74..0cecf50b3 100644 --- a/src/Reporting/Error/Canonicalize.hs +++ b/src/Reporting/Error/Canonicalize.hs @@ -3,7 +3,7 @@ module Reporting.Error.Canonicalize where import qualified Text.PrettyPrint as P -import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Type as Type import qualified AST.Variable as Var import qualified Reporting.Error.Helpers as Help @@ -16,7 +16,7 @@ data Error = Var VarError | Pattern PatternError | Alias AliasError - | Import Module.Name ImportError + | Import ModuleName.Raw ImportError | Export String [String] | DuplicateExport String | Port PortError @@ -58,16 +58,16 @@ argMismatch name expected actual = -- IMPORTS data ImportError - = ModuleNotFound [Module.Name] + = ModuleNotFound [ModuleName.Raw] | ValueNotFound String [String] -moduleNotFound :: Module.Name -> [Module.Name] -> Error +moduleNotFound :: ModuleName.Raw -> [ModuleName.Raw] -> Error moduleNotFound name possibilities = Import name (ModuleNotFound possibilities) -valueNotFound :: Module.Name -> String -> [String] -> Error +valueNotFound :: ModuleName.Raw -> String -> [String] -> Error valueNotFound name value possibilities = Import name (ValueNotFound value possibilities) @@ -178,13 +178,13 @@ toReport dealiaser err = ++ "line " ++ show (Region.line start) Import name importError -> - let moduleName = Module.nameToString name + let moduleName = ModuleName.toString name in case importError of ModuleNotFound suggestions -> namingError ("Could not find a module named `" ++ moduleName ++ "`") - (Help.maybeYouWant (map Module.nameToString suggestions)) + (Help.maybeYouWant (map ModuleName.toString suggestions)) ValueNotFound value suggestions -> namingError @@ -249,7 +249,7 @@ extractSuggestions err = Import _ importError -> case importError of ModuleNotFound suggestions -> - Just (map Module.nameToString suggestions) + Just (map ModuleName.toString suggestions) ValueNotFound _ suggestions -> Just suggestions diff --git a/src/Reporting/Warning.hs b/src/Reporting/Warning.hs index fbb61bef0..1cdc56a82 100644 --- a/src/Reporting/Warning.hs +++ b/src/Reporting/Warning.hs @@ -7,7 +7,7 @@ import qualified Data.Aeson as Json import qualified Text.PrettyPrint as P import Text.PrettyPrint ((<+>)) -import qualified AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Type as Type import qualified Nitpick.Pattern as Pattern import qualified Reporting.Annotation as A @@ -18,7 +18,7 @@ import qualified Reporting.Report as Report -- ALL POSSIBLE WARNINGS data Warning - = UnusedImport Module.Name + = UnusedImport ModuleName.Raw | MissingTypeAnnotation String Type.Canonical | InexhaustivePatternMatch [Pattern.Pattern] | RedundantPatternMatch @@ -42,7 +42,7 @@ toReport dealiaser warning = UnusedImport moduleName -> Report.simple "unused import" - ("Module `" ++ Module.nameToString moduleName ++ "` is unused.") + ("Module `" ++ ModuleName.toString moduleName ++ "` is unused.") "" MissingTypeAnnotation name inferredType -> diff --git a/src/Type/Inference.hs b/src/Type/Inference.hs index d9c7cfb44..3b8fd99a5 100644 --- a/src/Type/Inference.hs +++ b/src/Type/Inference.hs @@ -6,6 +6,7 @@ import qualified Data.Map as Map import qualified Data.Traversable as Traverse import AST.Module as Module +import qualified AST.Module.Name as ModuleName import qualified AST.Type as Type import qualified AST.Variable as Var import qualified Reporting.Annotation as A @@ -22,7 +23,7 @@ import System.IO.Unsafe infer - :: CanonicalInterfaces + :: Module.Interfaces -> Module.CanonicalModule -> Except [A.Located Error.Error] (Map.Map String Type.Canonical) infer interfaces modul = @@ -39,7 +40,7 @@ infer interfaces modul = genConstraints - :: CanonicalInterfaces + :: Module.Interfaces -> Module.CanonicalModule -> IO (Env.TypeDict, T.TypeConstraint) genConstraints interfaces modul = @@ -69,34 +70,40 @@ genConstraints interfaces modul = canonicalizeValues :: Env.Environment - -> (Module.CanonicalName, Interface) + -> (ModuleName.Canonical, Interface) -> IO [(String, ([T.Variable], T.Type))] canonicalizeValues env (moduleName, iface) = forM (Map.toList (iTypes iface)) $ \(name,tipe) -> do tipe' <- Env.instantiateType env tipe Map.empty - return ((Module.nameToString $ Module.canonModul moduleName) ++ "." ++ name, tipe') + return + ( ModuleName.canonicalToString moduleName ++ "." ++ name + , tipe' + ) -canonicalizeAdts :: CanonicalInterfaces -> Module.CanonicalModule -> [CanonicalAdt] +canonicalizeAdts :: Module.Interfaces -> Module.CanonicalModule -> [CanonicalAdt] canonicalizeAdts interfaces modul = localAdts ++ importedAdts where localAdts :: [CanonicalAdt] - localAdts = format (Module.names modul, datatypes (body modul)) + localAdts = + format (Module.name modul, datatypes (body modul)) importedAdts :: [CanonicalAdt] - importedAdts = concatMap (format . second iAdts) - (map (\(nm, iface) -> (Module.canonModul nm, iface )) $ Map.toList $ interfaces) - - format :: (Module.Name, Module.ADTs) -> [CanonicalAdt] - format (home, adts) = - map canonical (Map.toList adts) - where - canonical :: (String, AdtInfo String) -> CanonicalAdt - canonical (name, (tvars, ctors)) = - ( toVar name - , (tvars, map (first toVar) ctors) - ) - - toVar :: String -> Var.Canonical - toVar = Var.Canonical (Var.Module home) + importedAdts = + concatMap (format . second iAdts) (Map.toList interfaces) + + +format :: (ModuleName.Canonical, Module.ADTs) -> [CanonicalAdt] +format (home, adts) = + map canonical (Map.toList adts) + where + canonical :: (String, AdtInfo String) -> CanonicalAdt + canonical (name, (tvars, ctors)) = + ( toVar name + , (tvars, map (first toVar) ctors) + ) + + toVar :: String -> Var.Canonical + toVar name = + Var.fromModule home name