From ef89b431b88743e5fc686a744e24ae42a678c3f1 Mon Sep 17 00:00:00 2001 From: Robin Heggelund Hansen Date: Fri, 11 Feb 2022 14:20:49 +0100 Subject: [PATCH] First pass at renaming all elmy things in code. --- builder/src/Build.hs | 32 +- builder/src/Deps/Diff.hs | 16 +- builder/src/Deps/Package.hs | 6 +- builder/src/Deps/Solver.hs | 26 +- builder/src/Directories.hs | 26 +- builder/src/Generate.hs | 14 +- builder/src/Git.hs | 4 +- builder/src/{Elm => Gren}/Details.hs | 38 +- builder/src/{Elm => Gren}/Outline.hs | 32 +- builder/src/Reporting.hs | 14 +- builder/src/Reporting/Exit.hs | 386 +++++++++--------- compiler/src/AST/Canonical.hs | 10 +- compiler/src/AST/Optimized.hs | 14 +- compiler/src/AST/Source.hs | 4 +- compiler/src/Canonicalize/Effects.hs | 2 +- compiler/src/Canonicalize/Environment.hs | 2 +- .../src/Canonicalize/Environment/Foreign.hs | 6 +- .../src/Canonicalize/Environment/Local.hs | 2 +- compiler/src/Canonicalize/Expression.hs | 9 +- compiler/src/Canonicalize/Module.hs | 6 +- compiler/src/Canonicalize/Pattern.hs | 2 +- compiler/src/Compile.hs | 6 +- compiler/src/Data/Name.hs | 22 +- compiler/src/Generate/JavaScript.hs | 8 +- .../src/Generate/JavaScript/Expression.hs | 32 +- compiler/src/Generate/JavaScript/Name.hs | 10 +- compiler/src/Generate/Mode.hs | 2 +- .../src/{Elm => Gren}/Compiler/Imports.hs | 4 +- compiler/src/{Elm => Gren}/Compiler/Type.hs | 2 +- .../{Elm => Gren}/Compiler/Type/Extract.hs | 8 +- compiler/src/{Elm => Gren}/Constraint.hs | 18 +- compiler/src/{Elm => Gren}/Docs.hs | 8 +- compiler/src/{Elm => Gren}/Float.hs | 8 +- compiler/src/{Elm => Gren}/Interface.hs | 4 +- compiler/src/{Elm => Gren}/Kernel.hs | 28 +- compiler/src/{Elm => Gren}/Licenses.hs | 2 +- compiler/src/{Elm => Gren}/Magnitude.hs | 2 +- compiler/src/{Elm => Gren}/ModuleName.hs | 36 +- compiler/src/{Elm => Gren}/Package.hs | 55 +-- compiler/src/{Elm => Gren}/String.hs | 8 +- compiler/src/{Elm => Gren}/Version.hs | 4 +- compiler/src/Nitpick/PatternMatches.hs | 6 +- compiler/src/Optimize/DecisionTree.hs | 4 +- compiler/src/Optimize/Expression.hs | 6 +- compiler/src/Optimize/Module.hs | 2 +- compiler/src/Optimize/Names.hs | 2 +- compiler/src/Optimize/Port.hs | 6 +- compiler/src/Parse/Module.hs | 4 +- compiler/src/Parse/Number.hs | 2 +- compiler/src/Parse/String.hs | 2 +- compiler/src/Reporting/Doc.hs | 8 +- compiler/src/Reporting/Error.hs | 2 +- compiler/src/Reporting/Error/Canonicalize.hs | 40 +- compiler/src/Reporting/Error/Import.hs | 10 +- compiler/src/Reporting/Error/Pattern.hs | 2 +- compiler/src/Reporting/Error/Syntax.hs | 68 +-- .../src/Reporting/Render/Type/Localizer.hs | 2 +- compiler/src/Type/Constrain/Expression.hs | 45 +- compiler/src/Type/Constrain/Module.hs | 2 +- compiler/src/Type/Constrain/Pattern.hs | 2 +- compiler/src/Type/Error.hs | 2 +- compiler/src/Type/Type.hs | 29 +- compiler/src/Type/Unify.hs | 2 +- gren.cabal | 34 +- terminal/impl/Terminal.hs | 4 +- terminal/impl/Terminal/Helpers.hs | 32 +- terminal/src/Bump.hs | 18 +- terminal/src/Diff.hs | 14 +- terminal/src/Init.hs | 18 +- terminal/src/Install.hs | 20 +- terminal/src/Main.hs | 52 +-- terminal/src/Make.hs | 8 +- terminal/src/Publish.hs | 12 +- terminal/src/Repl.hs | 18 +- 74 files changed, 635 insertions(+), 761 deletions(-) rename builder/src/{Elm => Gren}/Details.hs (96%) rename builder/src/{Elm => Gren}/Outline.hs (93%) rename compiler/src/{Elm => Gren}/Compiler/Imports.hs (95%) rename compiler/src/{Elm => Gren}/Compiler/Type.hs (99%) rename compiler/src/{Elm => Gren}/Compiler/Type/Extract.hs (97%) rename compiler/src/{Elm => Gren}/Constraint.hs (95%) rename compiler/src/{Elm => Gren}/Docs.hs (98%) rename compiler/src/{Elm => Gren}/Float.hs (85%) rename compiler/src/{Elm => Gren}/Interface.hs (99%) rename compiler/src/{Elm => Gren}/Kernel.hs (93%) rename compiler/src/{Elm => Gren}/Licenses.hs (99%) rename compiler/src/{Elm => Gren}/Magnitude.hs (92%) rename compiler/src/{Elm => Gren}/ModuleName.hs (86%) rename compiler/src/{Elm => Gren}/Package.hs (89%) rename compiler/src/{Elm => Gren}/String.hs (96%) rename compiler/src/{Elm => Gren}/Version.hs (97%) diff --git a/builder/src/Build.hs b/builder/src/Build.hs index 52de4ba8..95637994 100644 --- a/builder/src/Build.hs +++ b/builder/src/Build.hs @@ -37,13 +37,13 @@ import qualified Data.NonEmptyList as NE import qualified Data.OneOrMore as OneOrMore import qualified Data.Set as Set import qualified Directories as Dirs -import qualified Elm.Details as Details -import qualified Elm.Docs as Docs -import qualified Elm.Interface as I -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg import qualified File +import qualified Gren.Details as Details +import qualified Gren.Docs as Docs +import qualified Gren.Interface as I +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg import qualified Json.Encode as E import qualified Parse.Module as Parse import qualified Reporting @@ -240,7 +240,7 @@ crawlDeps env mvar deps blockedValue = crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar docsNeed name = do - let fileName = ModuleName.toFilePath name <.> "elm" + let fileName = ModuleName.toFilePath name <.> "gren" paths <- filterM File.exists (map (`addRelative` fileName) srcDirs) @@ -492,7 +492,7 @@ loadInterface root (name, ciMvar) = return (Just (name, iface)) Unneeded -> do - maybeIface <- File.readBinary (Dirs.elmi root name) + maybeIface <- File.readBinary (Dirs.greni root name) case maybeIface of Nothing -> do @@ -626,9 +626,9 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path ti do let name = Src.getName modul let iface = I.fromModule pkg canonical annotations - let elmi = Dirs.elmi root name - File.writeBinary (Dirs.elmo root name) objects - maybeOldi <- File.readBinary elmi + let greni = Dirs.greni root name + File.writeBinary (Dirs.greno root name) objects + maybeOldi <- File.readBinary greni case maybeOldi of Just oldi | oldi == iface -> do @@ -639,7 +639,7 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path ti _ -> do -- iface may be lazy still - File.writeBinary elmi iface + File.writeBinary greni iface Reporting.report key Reporting.BDone let local = Details.Local path time deps main buildID buildID return (RNew local iface objects docs) @@ -885,7 +885,7 @@ getRootInfoHelp :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectPr getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath = let (dirs, file) = FP.splitFileName absolutePath (final, ext) = FP.splitExtension file - in if ext /= ".elm" + in if ext /= ".gren" then return $ Left $ Exit.BP_WithBadExtension path else let absoluteSegments = FP.splitDirectories dirs ++ [final] @@ -899,8 +899,8 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath = case matchingDirs of d1 : d2 : _ -> do - let p1 = addRelative d1 (FP.joinPath names <.> "elm") - let p2 = addRelative d2 (FP.joinPath names <.> "elm") + let p1 = addRelative d1 (FP.joinPath names <.> "gren") + let p2 = addRelative d2 (FP.joinPath names <.> "gren") return $ Left $ Exit.BP_RootNameDuplicate name p1 p2 _ -> return $ Right $ RootInfo absolutePath path (LInside name) @@ -911,7 +911,7 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath = isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool isInsideSrcDirByName names srcDir = - File.exists (addRelative srcDir (FP.joinPath names <.> "elm")) + File.exists (addRelative srcDir (FP.joinPath names <.> "gren")) isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String]) isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) = diff --git a/builder/src/Deps/Diff.hs b/builder/src/Deps/Diff.hs index d3540d7e..2ac7f6f1 100644 --- a/builder/src/Deps/Diff.hs +++ b/builder/src/Deps/Diff.hs @@ -23,15 +23,15 @@ import qualified Data.NonEmptyList as NE import qualified Data.Set as Set import qualified Deps.Package as Package import qualified Directories as Dirs -import qualified Elm.Compiler.Type as Type -import qualified Elm.Details as Details -import qualified Elm.Docs as Docs -import qualified Elm.Magnitude as M -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified File +import qualified Gren.Compiler.Type as Type +import qualified Gren.Details as Details +import qualified Gren.Docs as Docs +import qualified Gren.Magnitude as M +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Json.Decode as D import qualified Reporting import qualified Reporting.Exit as Exit diff --git a/builder/src/Deps/Package.hs b/builder/src/Deps/Package.hs index 9532a9cc..0856ac83 100644 --- a/builder/src/Deps/Package.hs +++ b/builder/src/Deps/Package.hs @@ -7,10 +7,10 @@ where import qualified Data.List as List import qualified Directories as Dirs -import qualified Elm.Magnitude as M -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified Git +import qualified Gren.Magnitude as M +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified System.Directory as Dir -- GET VERSIONS diff --git a/builder/src/Deps/Solver.hs b/builder/src/Deps/Solver.hs index 2b90ee44..6128dba3 100644 --- a/builder/src/Deps/Solver.hs +++ b/builder/src/Deps/Solver.hs @@ -21,11 +21,11 @@ import Data.Map ((!)) import qualified Data.Map as Map import qualified Deps.Package as Package import qualified Directories as Dirs -import qualified Elm.Constraint as C -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified File +import qualified Gren.Constraint as C +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Json.Decode as D import qualified Reporting.Exit as Exit import System.FilePath (()) @@ -48,7 +48,7 @@ data State = State } data Constraints = Constraints - { _elm :: C.Constraint, + { _gren :: C.Constraint, _deps :: Map.Map Pkg.Name C.Constraint } @@ -60,7 +60,7 @@ data Result a | NoOfflineSolution | Err Exit.Solver --- VERIFY -- used by Elm.Details +-- VERIFY -- used by Gren.Details data Details = Details V.Version (Map.Map Pkg.Name C.Constraint) @@ -114,12 +114,12 @@ addToApp cache pkg outline@(Outline.AppOutline _ _ direct indirect testDirect te (\e -> return $ Err e) toApp :: State -> Pkg.Name -> Outline.AppOutline -> Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name V.Version -> AppSolution -toApp (State _ constraints) pkg (Outline.AppOutline elm srcDirs direct _ testDirect _) old new = +toApp (State _ constraints) pkg (Outline.AppOutline gren srcDirs direct _ testDirect _) old new = let d = Map.intersection new (Map.insert pkg V.one direct) i = Map.difference (getTransitive constraints new (Map.toList d) Map.empty) d td = Map.intersection new (Map.delete pkg testDirect) ti = Map.difference new (Map.unions [d, i, td]) - in AppSolution old new (Outline.AppOutline elm srcDirs d i td ti) + in AppSolution old new (Outline.AppOutline gren srcDirs d i td ti) getTransitive :: Map.Map (Pkg.Name, V.Version) Constraints -> Map.Map Pkg.Name V.Version -> [(Pkg.Name, V.Version)] -> Map.Map Pkg.Name V.Version -> Map.Map Pkg.Name V.Version getTransitive constraints solution unvisited visited = @@ -165,8 +165,8 @@ exploreGoals (Goals pending solved) = addVersion :: Goals -> Pkg.Name -> V.Version -> Solver Goals addVersion (Goals pending solved) name version = do - (Constraints elm deps) <- getConstraints name version - if C.goodElm elm + (Constraints gren deps) <- getConstraints name version + if C.goodGren gren then do newPending <- foldM (addConstraint solved) pending (Map.toList deps) return (Goals newPending (Map.insert name version solved)) @@ -225,7 +225,7 @@ getConstraints pkg vsn = Left gitErr -> err $ Exit.SolverBadGitOperationVersionedPkg pkg vsn gitErr Right () -> do - let path = home "elm.json" + let path = home "gren.json" outlineExists <- File.exists path if outlineExists then do @@ -242,8 +242,8 @@ constraintsDecoder = do outline <- D.mapError (const ()) Outline.decoder case outline of - Outline.Pkg (Outline.PkgOutline _ _ _ _ _ deps _ elmConstraint) -> - return (Constraints elmConstraint deps) + Outline.Pkg (Outline.PkgOutline _ _ _ _ _ deps _ grenConstraint) -> + return (Constraints grenConstraint deps) Outline.App _ -> D.failure () diff --git a/builder/src/Directories.hs b/builder/src/Directories.hs index 73ddd024..ccbe238e 100644 --- a/builder/src/Directories.hs +++ b/builder/src/Directories.hs @@ -5,8 +5,8 @@ module Directories interfaces, objects, prepublishDir, - elmi, - elmo, + greni, + greno, temp, findRoot, withRootLock, @@ -20,9 +20,9 @@ module Directories ) where -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg -import qualified Elm.Version as V +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified System.Directory as Dir import qualified System.Environment as Env import qualified System.FileLock as Lock @@ -55,15 +55,15 @@ compilerVersion :: FilePath compilerVersion = V.toChars V.compiler --- ELMI and ELMO +-- GRENI and GRENO -elmi :: FilePath -> ModuleName.Raw -> FilePath -elmi root name = - toArtifactPath root name "elmi" +greni :: FilePath -> ModuleName.Raw -> FilePath +greni root name = + toArtifactPath root name "greni" -elmo :: FilePath -> ModuleName.Raw -> FilePath -elmo root name = - toArtifactPath root name "elmo" +greno :: FilePath -> ModuleName.Raw -> FilePath +greno root name = + toArtifactPath root name "greno" toArtifactPath :: FilePath -> ModuleName.Raw -> String -> FilePath toArtifactPath root name ext = @@ -90,7 +90,7 @@ findRootHelp dirs = return Nothing _ : _ -> do - exists <- Dir.doesFileExist (FP.joinPath dirs "elm.json") + exists <- Dir.doesFileExist (FP.joinPath dirs "gren.json") if exists then return (Just (FP.joinPath dirs)) else findRootHelp (init dirs) diff --git a/builder/src/Generate.hs b/builder/src/Generate.hs index 7968004a..32386b61 100644 --- a/builder/src/Generate.hs +++ b/builder/src/Generate.hs @@ -19,14 +19,14 @@ import qualified Data.Maybe as Maybe import qualified Data.Name as N import qualified Data.NonEmptyList as NE import qualified Directories as Dirs -import qualified Elm.Compiler.Type.Extract as Extract -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 File import qualified Generate.JavaScript as JS import qualified Generate.Mode as Mode +import qualified Gren.Compiler.Type.Extract as Extract +import qualified Gren.Details as Details +import qualified Gren.Interface as I +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg import qualified Nitpick.Debug as Nitpick import qualified Reporting.Exit as Exit import qualified Reporting.Task as Task @@ -125,7 +125,7 @@ loadObject root modul = Build.Cached name _ _ -> do mvar <- newEmptyMVar - _ <- forkIO $ putMVar mvar =<< File.readBinary (Dirs.elmo root name) + _ <- forkIO $ putMVar mvar =<< File.readBinary (Dirs.greno root name) return (name, mvar) -- FINALIZE OBJECTS @@ -176,7 +176,7 @@ loadTypesHelp root modul = mvar <- newEmptyMVar _ <- forkIO $ do - maybeIface <- File.readBinary (Dirs.elmi root name) + maybeIface <- File.readBinary (Dirs.greni root name) putMVar mvar (Extract.fromInterface name <$> maybeIface) return mvar Build.Loaded iface -> diff --git a/builder/src/Git.hs b/builder/src/Git.hs index 0fc68616..b4f21473 100644 --- a/builder/src/Git.hs +++ b/builder/src/Git.hs @@ -16,8 +16,8 @@ where import qualified Data.ByteString.Char8 as BS import qualified Data.Either as Either import qualified Data.List as List -import qualified Elm.Package as Pkg -import qualified Elm.Version as V +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Parse.Primitives as Parser import System.Directory (findExecutable) import qualified System.Exit as Exit diff --git a/builder/src/Elm/Details.hs b/builder/src/Gren/Details.hs similarity index 96% rename from builder/src/Elm/Details.hs rename to builder/src/Gren/Details.hs index 0c25097d..9464bc22 100644 --- a/builder/src/Elm/Details.hs +++ b/builder/src/Gren/Details.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Details +module Gren.Details ( Details (..), BuildID, ValidOutline (..), @@ -35,15 +35,15 @@ import qualified Data.Set as Set import Data.Word (Word64) import qualified Deps.Solver as Solver import qualified Directories as Dirs -import qualified Elm.Constraint as Con -import qualified Elm.Docs as Docs -import qualified Elm.Interface as I -import qualified Elm.Kernel as Kernel -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified File +import qualified Gren.Constraint as Con +import qualified Gren.Docs as Docs +import qualified Gren.Interface as I +import qualified Gren.Kernel as Kernel +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Json.Encode as E import qualified Parse.Module as Parse import qualified Reporting @@ -120,7 +120,7 @@ loadInterfaces root (Details _ _ _ _ _ extras) = verifyInstall :: BW.Scope -> FilePath -> Solver.Env -> Outline.Outline -> IO (Either Exit.Details ()) verifyInstall scope root (Solver.Env cache) outline = do - time <- File.getTime (root "elm.json") + time <- File.getTime (root "gren.json") let key = Reporting.ignorer let env = Env key scope root cache case outline of @@ -132,7 +132,7 @@ verifyInstall scope root (Solver.Env cache) outline = load :: Reporting.Style -> BW.Scope -> FilePath -> IO (Either Exit.Details Details) load style scope root = do - newTime <- File.getTime (root "elm.json") + newTime <- File.getTime (root "gren.json") maybeDetails <- File.readBinary (Dirs.details root) case maybeDetails of Nothing -> @@ -184,25 +184,25 @@ initEnv key scope root = type Task a = Task.Task Exit.Details a verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details -verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect elm) = - if Con.goodElm elm +verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect gren) = + if Con.goodGren gren then do solution <- verifyConstraints env =<< union noDups direct testDirect let exposedList = Outline.flattenExposed exposed let exactDeps = Map.map (\(Solver.Details v _) -> v) solution -- for pkg docs in reactor verifyDependencies env time (ValidPkg pkg exposedList exactDeps) solution direct - else Task.throw $ Exit.DetailsBadElmInPkg elm + else Task.throw $ Exit.DetailsBadGrenInPkg gren verifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details -verifyApp env time outline@(Outline.AppOutline elmVersion srcDirs direct _ _ _) = - if elmVersion == V.compiler +verifyApp env time outline@(Outline.AppOutline grenVersion srcDirs direct _ _ _) = + if grenVersion == V.compiler then do stated <- checkAppDeps outline actual <- verifyConstraints env (Map.map Con.exactly stated) if Map.size stated == Map.size actual then verifyDependencies env time (ValidApp srcDirs) actual direct else Task.throw Exit.DetailsHandEditedDependencies - else Task.throw $ Exit.DetailsBadElmInAppOutline elmVersion + else Task.throw $ Exit.DetailsBadGrenInAppOutline grenVersion checkAppDeps :: Outline.AppOutline -> Task (Map.Map Pkg.Name V.Version) checkAppDeps (Outline.AppOutline _ _ direct indirect testDirect testIndirect) = @@ -413,7 +413,7 @@ addLocalGraph name status graph = gatherInterfaces :: Map.Map ModuleName.Raw () -> Map.Map ModuleName.Raw Result -> Map.Map ModuleName.Raw I.DependencyInterface gatherInterfaces exposed artifacts = - let onLeft = Map.mapMissing (error "compiler bug manifesting in Elm.Details.gatherInterfaces") + let onLeft = Map.mapMissing (error "compiler bug manifesting in Gren.Details.gatherInterfaces") onRight = Map.mapMaybeMissing (\_ iface -> toLocalInterface I.private iface) onBoth = Map.zipWithMaybeMatched (\_ () iface -> toLocalInterface I.public iface) in Map.merge onLeft onRight onBoth exposed artifacts @@ -467,7 +467,7 @@ data Status crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> IO (Maybe Status) crawlModule foreignDeps mvar pkg src docsStatus name = do - let path = src ModuleName.toFilePath name <.> "elm" + let path = src ModuleName.toFilePath name <.> "gren" exists <- File.exists path case Map.lookup name foreignDeps of Just ForeignAmbiguous -> diff --git a/builder/src/Elm/Outline.hs b/builder/src/Gren/Outline.hs similarity index 93% rename from builder/src/Elm/Outline.hs rename to builder/src/Gren/Outline.hs index d34ff068..89aec76a 100644 --- a/builder/src/Elm/Outline.hs +++ b/builder/src/Gren/Outline.hs @@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Outline +module Gren.Outline ( Outline (..), AppOutline (..), PkgOutline (..), @@ -22,13 +22,13 @@ import Data.Binary (Binary, get, getWord8, put, putWord8) import qualified Data.Map as Map import qualified Data.NonEmptyList as NE import qualified Data.OneOrMore as OneOrMore -import qualified Elm.Constraint as Con -import qualified Elm.Licenses as Licenses -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified File import Foreign.Ptr (minusPtr) +import qualified Gren.Constraint as Con +import qualified Gren.Licenses as Licenses +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Json.Decode as D import Json.Encode ((==>)) import qualified Json.Encode as E @@ -47,7 +47,7 @@ data Outline | Pkg PkgOutline data AppOutline = AppOutline - { _app_elm_version :: V.Version, + { _app_gren_version :: V.Version, _app_source_dirs :: NE.List SrcDir, _app_deps_direct :: Map.Map Pkg.Name V.Version, _app_deps_indirect :: Map.Map Pkg.Name V.Version, @@ -63,7 +63,7 @@ data PkgOutline = PkgOutline _pkg_exposed :: Exposed, _pkg_deps :: Map.Map Pkg.Name Con.Constraint, _pkg_test_deps :: Map.Map Pkg.Name Con.Constraint, - _pkg_elm_version :: Con.Constraint + _pkg_gren_version :: Con.Constraint } data Exposed @@ -94,18 +94,18 @@ flattenExposed exposed = write :: FilePath -> Outline -> IO () write root outline = - E.write (root "elm.json") (encode outline) + E.write (root "gren.json") (encode outline) -- JSON ENCODE encode :: Outline -> E.Value encode outline = case outline of - App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) -> + App (AppOutline gren srcDirs depsDirect depsTrans testDirect testTrans) -> E.object [ "type" ==> E.chars "application", "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs), - "elm-version" ==> V.encode elm, + "gren-version" ==> V.encode gren, "dependencies" ==> E.object [ "direct" ==> encodeDeps V.encode depsDirect, @@ -117,7 +117,7 @@ encode outline = "indirect" ==> encodeDeps V.encode testTrans ] ] - Pkg (PkgOutline name summary license version exposed deps tests elm) -> + Pkg (PkgOutline name summary license version exposed deps tests gren) -> E.object [ "type" ==> E.string (Json.fromChars "package"), "name" ==> Pkg.encode name, @@ -125,7 +125,7 @@ encode outline = "license" ==> Licenses.encode license, "version" ==> V.encode version, "exposed-modules" ==> encodeExposed exposed, - "elm-version" ==> Con.encode elm, + "gren-version" ==> Con.encode gren, "dependencies" ==> encodeDeps Con.encode deps, "test-dependencies" ==> encodeDeps Con.encode tests ] @@ -157,7 +157,7 @@ encodeSrcDir srcDir = read :: FilePath -> IO (Either Exit.Outline Outline) read root = do - bytes <- File.readUtf8 (root "elm.json") + bytes <- File.readUtf8 (root "gren.json") case D.fromByteString decoder bytes of Left err -> return $ Left (Exit.OutlineHasBadStructure err) @@ -244,7 +244,7 @@ decoder = appDecoder :: Decoder AppOutline appDecoder = AppOutline - <$> D.field "elm-version" versionDecoder + <$> D.field "gren-version" versionDecoder <*> D.field "source-directories" dirsDecoder <*> D.field "dependencies" (D.field "direct" (depsDecoder versionDecoder)) <*> D.field "dependencies" (D.field "indirect" (depsDecoder versionDecoder)) @@ -261,7 +261,7 @@ pkgDecoder = <*> D.field "exposed-modules" exposedDecoder <*> D.field "dependencies" (depsDecoder constraintDecoder) <*> D.field "test-dependencies" (depsDecoder constraintDecoder) - <*> D.field "elm-version" constraintDecoder + <*> D.field "gren-version" constraintDecoder -- JSON DECODE HELPERS diff --git a/builder/src/Reporting.hs b/builder/src/Reporting.hs index 4cf624e0..ca6fb8ab 100644 --- a/builder/src/Reporting.hs +++ b/builder/src/Reporting.hs @@ -34,9 +34,9 @@ import Control.Exception (AsyncException (UserInterrupt), SomeException, catch, import Control.Monad (when) import qualified Data.ByteString.Builder as B import qualified Data.NonEmptyList as NE -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg -import qualified Elm.Version as V +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Json.Encode as Encode import Reporting.Doc ((<+>)) import qualified Reporting.Doc as D @@ -398,15 +398,15 @@ putException e = do D.vcat $ map (\line -> D.red ">" <> " " <> D.fromChars line) (lines (show e)), D.reflow $ "These errors are usually pretty confusing, so start by asking around on one of\ - \ forums listed at https://elm-lang.org/community to see if anyone can get you\ + \ forums listed at https://gren-lang.org/community to see if anyone can get you\ \ unstuck quickly.", D.dullyellow "-- REQUEST ---------------------------------------------------------------------", D.reflow $ "If you are feeling up to it, please try to get your code down to the smallest\ - \ version that still triggers this message. Ideally in a single Main.elm and\ - \ elm.json file.", + \ version that still triggers this message. Ideally in a single Main.gren and\ + \ gren.json file.", D.reflow $ - "From there open a NEW issue at https://github.com/elm/compiler/issues with\ + "From there open a NEW issue at https://github.com/gren/compiler/issues with\ \ your reduced example pasted in directly. (Not a link to a repo or gist!) Do not\ \ worry about if someone else saw something similar. More examples is better!", D.reflow $ diff --git a/builder/src/Reporting/Exit.hs b/builder/src/Reporting/Exit.hs index f7a42400..c487040f 100644 --- a/builder/src/Reporting/Exit.hs +++ b/builder/src/Reporting/Exit.hs @@ -41,13 +41,13 @@ import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Name as N import qualified Data.NonEmptyList as NE -import qualified Elm.Constraint as C -import qualified Elm.Magnitude as M -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified File import qualified Git +import qualified Gren.Constraint as C +import qualified Gren.Magnitude as M +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Json.Decode as Decode import qualified Json.Encode as Encode import qualified Json.String as Json @@ -91,28 +91,28 @@ initToReport exit = Help.report "NO SOLUTION" Nothing - "I tried to create an elm.json with the following direct dependencies:" + "I tried to create an gren.json with the following direct dependencies:" [ D.indent 4 $ D.vcat $ map (D.dullyellow . D.fromChars . Pkg.toChars) pkgs, D.reflow $ "I could not find compatible versions though! This should not happen, so please\ - \ ask around one of the community forums at https://elm-lang.org/community to learn\ + \ ask around one of the community forums at https://gren-lang.org/community to learn\ \ what is going on!" ] InitNoOfflineSolution pkgs -> Help.report "NO OFFLINE SOLUTION" Nothing - "I tried to create an elm.json with the following direct dependencies:" + "I tried to create an gren.json with the following direct dependencies:" [ D.indent 4 $ D.vcat $ map (D.dullyellow . D.fromChars . Pkg.toChars) pkgs, D.reflow $ "I could not find compatible versions though, but that may be because I could not\ - \ connect to https://package.elm-lang.org to get the latest list of packages. Are\ + \ connect to https://package.gren-lang.org to get the latest list of packages. Are\ \ you able to connect to the internet? Please ask around one of the community\ - \ forums at https://elm-lang.org/community for help!" + \ forums at https://gren-lang.org/community for help!" ] InitSolverProblem solver -> toSolverReport solver @@ -120,7 +120,7 @@ initToReport exit = Help.report "EXISTING PROJECT" Nothing - "You already have an elm.json file, so there is nothing for me to initialize!" + "You already have an gren.json file, so there is nothing for me to initialize!" [ D.fillSep [ "Maybe", D.green (D.fromChars (D.makeLink "init")), @@ -157,28 +157,28 @@ diffToReport diff = Help.report "DIFF WHAT?" Nothing - "I cannot find an elm.json so I am not sure what you want me to diff.\ - \ Normally you run `elm diff` from within a project!" + "I cannot find an gren.json so I am not sure what you want me to diff.\ + \ Normally you run `gren diff` from within a project!" [ D.reflow $ "If you are just curious to see a diff, try running this command:", - D.indent 4 $ D.green $ "elm diff elm/http 1.0.0 2.0.0" + D.indent 4 $ D.green $ "gren diff gren/http 1.0.0 2.0.0" ] DiffBadOutline outline -> toOutlineReport outline DiffApplication -> Help.report "CANNOT DIFF APPLICATIONS" - (Just "elm.json") - "Your elm.json says this project is an application, but `elm diff` only works\ + (Just "gren.json") + "Your gren.json says this project is an application, but `gren diff` only works\ \ with packages. That way there are previously published versions of the API to\ \ diff against!" [ D.reflow $ "If you are just curious to see a diff, try running this command:", - D.indent 4 $ D.dullyellow $ "elm diff elm/json 1.0.0 1.1.2" + D.indent 4 $ D.dullyellow $ "gren diff gren/json 1.0.0 1.1.2" ] DiffNoExposed -> Help.report "NO EXPOSED MODULES" - (Just "elm.json") - "Your elm.json has no \"exposed-modules\" which means there is no public API at\ + (Just "gren.json") + "Your gren.json has no \"exposed-modules\" which means there is no public API at\ \ all right now! What am I supposed to diff?" [ D.reflow $ "Try adding some modules back to the \"exposed-modules\" field." @@ -198,7 +198,7 @@ diffToReport diff = [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg, "Maybe you want one of these instead?", D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromChars . Pkg.toChars) suggestions, - "But check to see all possibilities!" + "But check to see all possibilities!" ] DiffUnknownVersion _pkg vsn realVersions -> Help.docReport @@ -255,10 +255,10 @@ bumpToReport bump = Help.report "BUMP WHAT?" Nothing - "I cannot find an elm.json so I am not sure what you want me to bump." + "I cannot find an gren.json so I am not sure what you want me to bump." [ D.reflow $ - "Elm packages always have an elm.json that says current the version number. If\ - \ you run this command from a directory with an elm.json file, I will try to bump\ + "gren packages always have an gren.json that says current the version number. If\ + \ you run this command from a directory with an gren.json file, I will try to bump\ \ the version in there based on the API changes." ] BumpBadOutline outline -> @@ -266,17 +266,17 @@ bumpToReport bump = BumpApplication -> Help.report "CANNOT BUMP APPLICATIONS" - (Just "elm.json") - "Your elm.json says this is an application. That means it cannot be published\ - \ on and therefore has no version to bump!" + (Just "gren.json") + "Your gren.json says this is an application. That means it cannot be published\ + \ on and therefore has no version to bump!" [] BumpUnexpectedVersion vsn versions -> Help.docReport "CANNOT BUMP" - (Just "elm.json") + (Just "gren.json") ( D.fillSep [ "Your", - "elm.json", + "gren.json", "says", "I", "should", @@ -292,7 +292,7 @@ bumpToReport bump = "that", "version", "on", - ".", + ".", "That", "means", "there", @@ -318,7 +318,7 @@ bumpToReport bump = ] ) [ D.fillSep $ - ["Try", "bumping", "again", "after", "changing", "the", D.dullyellow "\"version\"", "in", "elm.json"] + ["Try", "bumping", "again", "after", "changing", "the", D.dullyellow "\"version\"", "in", "gren.json"] ++ if length versions == 1 then ["to:"] else ["to", "one", "of", "these:"], D.vcat $ map (D.green . D.fromVersion) versions ] @@ -327,7 +327,7 @@ bumpToReport bump = BumpNoExposed -> Help.docReport "NO EXPOSED MODULES" - (Just "elm.json") + (Just "gren.json") ( D.fillSep [ "To", "bump", @@ -338,7 +338,7 @@ bumpToReport bump = "field", "of", "your", - "elm.json", + "gren.json", "must", "list", "at", @@ -406,9 +406,9 @@ publishToReport publish = Help.report "PUBLISH WHAT?" Nothing - "I cannot find an elm.json so I am not sure what you want me to publish." + "I cannot find an gren.json so I am not sure what you want me to publish." [ D.reflow $ - "Elm packages always have an elm.json that states the version number,\ + "Gren packages always have an gren.json that states the version number,\ \ dependencies, exposed modules, etc." ] PublishBadOutline outline -> @@ -444,7 +444,7 @@ publishToReport publish = "version", "for", "all", - "Elm", + "Gren", "packages." ] ] @@ -469,7 +469,7 @@ publishToReport publish = "Try using the `bump` command:" ] ) - [ D.dullyellow $ D.indent 4 "elm bump", + [ D.dullyellow $ D.indent 4 "gren bump", D.reflow $ "It computes the version number based on API changes, ensuring\ \ that no breaking changes end up in PATCH releases!" @@ -477,10 +477,10 @@ publishToReport publish = PublishInvalidBump statedVersion latestVersion -> Help.docReport "INVALID VERSION" - (Just "elm.json") + (Just "gren.json") ( D.fillSep $ [ "Your", - "elm.json", + "gren.json", "says", "the", "next", @@ -518,25 +518,25 @@ publishToReport publish = "From", "there,", "have", - "Elm", + "Gren", "bump", "the", "version", "by", "running:" ], - D.indent 4 $ D.green "elm bump", + D.indent 4 $ D.green "gren bump", D.reflow $ - "If you want more insight on the API changes Elm detects, you\ - \ can run `elm diff` at this point as well." + "If you want more insight on the API changes Gren detects, you\ + \ can run `gren diff` at this point as well." ] PublishBadBump old new magnitude realNew realMagnitude -> Help.docReport "INVALID VERSION" - (Just "elm.json") + (Just "gren.json") ( D.fillSep $ [ "Your", - "elm.json", + "gren.json", "says", "the", "next", @@ -565,7 +565,7 @@ publishToReport publish = ) [ D.indent 4 $ D.fromChars $ - "elm diff " ++ V.toChars old, + "gren diff " ++ V.toChars old, D.fillSep $ [ "This", "command", @@ -596,19 +596,19 @@ publishToReport publish = "want!" ], D.reflow $ - "Also, next time use `elm bump` and I'll figure all this out for you!" + "Also, next time use `gren bump` and I'll figure all this out for you!" ] PublishNoSummary -> Help.docReport "NO SUMMARY" - (Just "elm.json") + (Just "gren.json") ( D.fillSep $ [ "To", "publish", "a", "package,", "your", - "elm.json", + "gren.json", "must", "have", "a", @@ -631,7 +631,7 @@ publishToReport publish = PublishNoExposed -> Help.docReport "NO EXPOSED MODULES" - (Just "elm.json") + (Just "gren.json") ( D.fillSep $ [ "To", "publish", @@ -642,7 +642,7 @@ publishToReport publish = "field", "of", "your", - "elm.json", + "gren.json", "must", "list", "at", @@ -667,13 +667,13 @@ publishToReport publish = Help.report "NO LICENSE FILE" (Just "LICENSE") - "By publishing a package you are inviting the Elm community to build\ + "By publishing a package you are inviting the Gren community to build\ \ upon your work. But without knowing your license, we have no idea if\ \ that is legal!" [ D.reflow $ "Once you pick an OSI approved license from ,\ \ you must share that choice in two places. First, the license\ - \ identifier must appear in your elm.json file. Second, the full\ + \ identifier must appear in your gren.json file. Second, the full\ \ license text must appear in the root of your project in a file\ \ named LICENSE. Add that file and you will be all set!" ] @@ -871,12 +871,12 @@ installToReport exit = "NEW PROJECT?" Nothing "Are you trying to start a new project? Try this command instead:" - [ D.indent 4 $ D.green "elm init", + [ D.indent 4 $ D.green "gren init", D.reflow "It will help you get started!" ] InstallBadOutline outline -> toOutlineReport outline - InstallNoArgs elmHome -> + InstallNoArgs grenHome -> Help.report "INSTALL WHAT?" Nothing @@ -884,9 +884,9 @@ installToReport exit = [ D.green $ D.indent 4 $ D.vcat $ - [ "elm install elm/http", - "elm install elm/json", - "elm install elm/random" + [ "gren install gren/http", + "gren install gren/json", + "gren install gren/random" ], D.toFancyHint [ "In", @@ -908,11 +908,11 @@ installToReport exit = "and", "again?", "Instead,", - "Elm", + "Gren", "caches", "packages", "in", - D.dullyellow (D.fromChars elmHome), + D.dullyellow (D.fromChars grenHome), "so", "each", "one", @@ -924,7 +924,7 @@ installToReport exit = "on", "your", "machine.", - "Elm", + "Gren", "projects", "check", "that", @@ -950,16 +950,16 @@ installToReport exit = "As", "a", "result", - D.dullcyan "elm install", + D.dullcyan "gren install", "is", "only", "for", "adding", "dependencies", "to", - "elm.json,", + "gren.json,", "whereas", - D.dullcyan "elm make", + D.dullcyan "gren make", "is", "in", "charge", @@ -972,14 +972,14 @@ installToReport exit = "So", "maybe", "try", - D.green "elm make", + D.green "gren make", "instead?" ] ] InstallNoOnlineAppSolution pkg -> Help.report "CANNOT FIND COMPATIBLE VERSION" - (Just "elm.json") + (Just "gren.json") ( "I cannot find a version of " ++ Pkg.toChars pkg ++ " that is compatible\ \ with your existing dependencies." @@ -990,9 +990,9 @@ installToReport exit = \ existing dependencies! That did not work either!", D.reflow $ "This is most likely to happen when a package is not upgraded yet. Maybe a new\ - \ version of Elm came out recently? Maybe a common package was changed recently?\ + \ version of Gren came out recently? Maybe a common package was changed recently?\ \ Maybe a better package came along, so there was no need to upgrade this one?\ - \ Try asking around https://elm-lang.org/community to learn what might be going on\ + \ Try asking around https://gren-lang.org/community to learn what might be going on\ \ with this package.", D.toSimpleNote $ "Whatever the case, please be kind to the relevant package authors! Having\ @@ -1005,13 +1005,13 @@ installToReport exit = InstallNoOfflineAppSolution pkg -> Help.report "CANNOT FIND COMPATIBLE VERSION LOCALLY" - (Just "elm.json") + (Just "gren.json") ( "I cannot find a version of " ++ Pkg.toChars pkg ++ " that is compatible\ \ with your existing dependencies." ) [ D.reflow $ - "I was not able to connect to https://package.elm-lang.org/ though, so I was only\ + "I was not able to connect to https://package.gren-lang.org/ though, so I was only\ \ able to look through packages that you have downloaded in the past.", D.reflow $ "Try again later when you have internet!" @@ -1019,7 +1019,7 @@ installToReport exit = InstallNoOnlinePkgSolution pkg -> Help.report "CANNOT FIND COMPATIBLE VERSION" - (Just "elm.json") + (Just "gren.json") ( "I cannot find a version of " ++ Pkg.toChars pkg ++ " that is compatible\ \ with your existing constraints." @@ -1039,13 +1039,13 @@ installToReport exit = InstallNoOfflinePkgSolution pkg -> Help.report "CANNOT FIND COMPATIBLE VERSION LOCALLY" - (Just "elm.json") + (Just "gren.json") ( "I cannot find a version of " ++ Pkg.toChars pkg ++ " that is compatible\ \ with your existing constraints." ) [ D.reflow $ - "I was not able to connect to https://package.elm-lang.org/ though, so I was only\ + "I was not able to connect to https://package.gren-lang.org/ though, so I was only\ \ able to look through packages that you have downloaded in the past.", D.reflow $ "Try again later when you have internet!" @@ -1060,7 +1060,7 @@ installToReport exit = ["I", "cannot", "find", "a", "package", "named", D.red (D.fromPackage pkg) <> "."] ) [ D.reflow $ - "I looked through https://package.elm-lang.org for packages with similar names\ + "I looked through https://package.gren-lang.org for packages with similar names\ \ and found these:", D.indent 4 $ D.dullyellow $ D.vcat $ map D.fromPackage suggestions, D.reflow $ "Maybe you want one of these instead?" @@ -1073,7 +1073,7 @@ installToReport exit = ["I", "cannot", "find", "a", "package", "named", D.red (D.fromPackage pkg) <> "."] ) [ D.reflow $ - "I could not connect to https://package.elm-lang.org though, so new packages may\ + "I could not connect to https://package.gren-lang.org though, so new packages may\ \ have been published since I last updated my local cache of package names.", D.reflow $ "Looking through the locally cached names, the closest ones are:", @@ -1097,7 +1097,7 @@ toSolverReport problem = Help.report "PROBLEM SOLVING PACKAGE CONSTRAINTS" Nothing - ( "I need the elm.json of " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn + ( "I need the gren.json of " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn ++ " to\ \ help me search for a set of compatible packages. I had it cached locally, but\ \ it looks like the file was corrupted!" @@ -1109,11 +1109,11 @@ toSolverReport problem = ] SolverBadGitOperationUnversionedPkg pkg gitError -> toGitErrorReport "PROBLEM SOLVING PACKAGE CONSTRAINTS" gitError $ - "I need the elm.json of " ++ Pkg.toChars pkg + "I need the gren.json of " ++ Pkg.toChars pkg ++ " to help me search for a set of compatible packages" SolverBadGitOperationVersionedPkg pkg vsn gitError -> toGitErrorReport "PROBLEM SOLVING PACKAGE CONSTRAINTS" gitError $ - "I need the elm.json of " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn + "I need the gren.json of " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn ++ " to help me search for a set of compatible packages" -- OUTLINE @@ -1142,15 +1142,15 @@ toOutlineReport :: Outline -> Help.Report toOutlineReport problem = case problem of OutlineHasBadStructure decodeError -> - Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $ - Json.ExplicitReason "I ran into a problem with your elm.json file." + Json.toReport "gren.json" (Json.FailureToReport toOutlineProblemReport) decodeError $ + Json.ExplicitReason "I ran into a problem with your gren.json file." OutlineHasMissingSrcDirs dir dirs -> case dirs of [] -> Help.report "MISSING SOURCE DIRECTORY" - (Just "elm.json") - "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:" + (Just "gren.json") + "I need a valid gren.json file, but the \"source-directories\" field lists the following directory:" [ D.indent 4 $ D.red $ D.fromChars dir, D.reflow $ "I cannot find it though. Is it missing? Is there a typo?" @@ -1158,8 +1158,8 @@ toOutlineReport problem = _ : _ -> Help.report "MISSING SOURCE DIRECTORIES" - (Just "elm.json") - "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:" + (Just "gren.json") + "I need a valid gren.json file, but the \"source-directories\" field lists the following directories:" [ D.indent 4 $ D.vcat $ map (D.red . D.fromChars) (dir : dirs), @@ -1171,8 +1171,8 @@ toOutlineReport problem = then Help.report "REDUNDANT SOURCE DIRECTORIES" - (Just "elm.json") - "I need a valid elm.json file, but the \"source-directories\" field lists the same directory twice:" + (Just "gren.json") + "I need a valid gren.json file, but the \"source-directories\" field lists the same directory twice:" [ D.indent 4 $ D.vcat $ map (D.red . D.fromChars) [dir1, dir2], @@ -1182,8 +1182,8 @@ toOutlineReport problem = else Help.report "REDUNDANT SOURCE DIRECTORIES" - (Just "elm.json") - "I need a valid elm.json file, but the \"source-directories\" field has some redundant directories:" + (Just "gren.json") + "I need a valid gren.json file, but the \"source-directories\" field has some redundant directories:" [ D.indent 4 $ D.vcat $ map (D.red . D.fromChars) [dir1, dir2], @@ -1196,35 +1196,35 @@ toOutlineReport problem = OutlineNoPkgCore -> Help.report "MISSING DEPENDENCY" - (Just "elm.json") - "I need to see an \"elm/core\" dependency your elm.json file. The default imports\ + (Just "gren.json") + "I need to see an \"gren/core\" dependency your gren.json file. The default imports\ \ of `List` and `Maybe` do not work without it." [ D.reflow $ - "If you modified your elm.json by hand, try to change it back! And if you are\ - \ having trouble getting back to a working elm.json, it may be easier to find a\ - \ working package and start fresh with their elm.json file." + "If you modified your gren.json by hand, try to change it back! And if you are\ + \ having trouble getting back to a working gren.json, it may be easier to find a\ + \ working package and start fresh with their gren.json file." ] OutlineNoAppCore -> Help.report "MISSING DEPENDENCY" - (Just "elm.json") - "I need to see an \"elm/core\" dependency your elm.json file. The default imports\ + (Just "gren.json") + "I need to see an \"gren/core\" dependency your gren.json file. The default imports\ \ of `List` and `Maybe` do not work without it." [ D.reflow $ - "If you modified your elm.json by hand, try to change it back! And if you are\ - \ having trouble getting back to a working elm.json, it may be easier to delete it\ - \ and use `elm init` to start fresh." + "If you modified your gren.json by hand, try to change it back! And if you are\ + \ having trouble getting back to a working gren.json, it may be easier to delete it\ + \ and use `gren init` to start fresh." ] OutlineNoAppJson -> Help.report "MISSING DEPENDENCY" - (Just "elm.json") - "I need to see an \"elm/json\" dependency your elm.json file. It helps me handle\ + (Just "gren.json") + "I need to see an \"gren/json\" dependency your gren.json file. It helps me handle\ \ flags and ports." [ D.reflow $ - "If you modified your elm.json by hand, try to change it back! And if you are\ - \ having trouble getting back to a working elm.json, it may be easier to delete it\ - \ and use `elm init` to start fresh." + "If you modified your gren.json by hand, try to change it back! And if you are\ + \ having trouble getting back to a working gren.json, it may be easier to delete it\ + \ and use `gren init` to start fresh." ] toOutlineProblemReport :: FilePath -> Code.Source -> Json.Context -> A.Region -> OutlineProblem -> Help.Report @@ -1241,7 +1241,7 @@ toOutlineProblemReport path source _ region problem = "UNEXPECTED TYPE" Nothing ( D.reflow $ - "I got stuck while reading your elm.json file. I cannot handle a \"type\" like this:", + "I got stuck while reading your gren.json file. I cannot handle a \"type\" like this:", D.fillSep [ "Try", "changing", @@ -1259,7 +1259,7 @@ toOutlineProblemReport path source _ region problem = "INVALID PACKAGE NAME" (toHighlight row col) ( D.reflow $ - "I got stuck while reading your elm.json file. I ran into trouble with the package name:", + "I got stuck while reading your gren.json file. I ran into trouble with the package name:", D.stack [ D.fillSep [ "Package", @@ -1281,10 +1281,10 @@ toOutlineProblemReport path source _ region problem = D.dullyellow $ D.indent 4 $ D.vcat $ - [ "\"mdgriffith/elm-ui\"", - "\"w0rm/elm-physics\"", - "\"Microsoft/elm-json-tree-view\"", - "\"FordLabs/elm-star-rating\"", + [ "\"mdgriffith/gren-ui\"", + "\"w0rm/gren-physics\"", + "\"Microsoft/gren-json-tree-view\"", + "\"FordLabs/gren-star-rating\"", "\"1602/json-schema\"" ], D.reflow @@ -1292,16 +1292,16 @@ toOutlineProblemReport path source _ region problem = \ needs to follow these rules:", D.indent 4 $ D.vcat $ - [ "+--------------------------------------+-----------+-----------+", - "| RULE | BAD | GOOD |", - "+--------------------------------------+-----------+-----------+", - "| only lower case, digits, and hyphens | elm-HTTP | elm-http |", - "| no leading digits | 3D | elm-3d |", - "| no non-ASCII characters | elm-bjørn | elm-bear |", - "| no underscores | elm_ui | elm-ui |", - "| no double hyphens | elm--hash | elm-hash |", - "| no starting or ending hyphen | -elm-tar- | elm-tar |", - "+--------------------------------------+-----------+-----------+" + [ "+--------------------------------------+-----------+------------+", + "| RULE | BAD | GOOD |", + "+--------------------------------------+-----------+------------+", + "| only lower case, digits, and hyphens | gren-HTTP | gren-http |", + "| no leading digits | 3D | gren-3d |", + "| no non-ASCII characters | gren-bjørn | gren-bear |", + "| no underscores | gren_ui | gren-ui |", + "| no double hyphens | gren--hash | gren-hash |", + "| no starting or ending hyphen | -gren-tar- | gren-tar |", + "+--------------------------------------+-----------+------------+" ], D.toSimpleNote $ "These rules only apply to the project name, so you should never need\ @@ -1313,7 +1313,7 @@ toOutlineProblemReport path source _ region problem = "PROBLEM WITH VERSION" (toHighlight row col) ( D.reflow $ - "I got stuck while reading your elm.json file. I was expecting a version number here:", + "I got stuck while reading your gren.json file. I was expecting a version number here:", D.fillSep [ "I", "need", @@ -1337,7 +1337,7 @@ toOutlineProblemReport path source _ region problem = "PROBLEM WITH CONSTRAINT" (toHighlight row col) ( D.reflow $ - "I got stuck while reading your elm.json file. I do not understand this version constraint:", + "I got stuck while reading your gren.json file. I do not understand this version constraint:", D.stack [ D.fillSep [ "I", @@ -1367,9 +1367,9 @@ toOutlineProblemReport path source _ region problem = "PROBLEM WITH CONSTRAINT" Nothing ( D.reflow $ - "I got stuck while reading your elm.json file. I ran into an invalid version constraint:", + "I got stuck while reading your grenjson file. I ran into an invalid version constraint:", D.fillSep - [ "Elm", + [ "Gren", "checks", "that", "all", @@ -1414,7 +1414,7 @@ toOutlineProblemReport path source _ region problem = "PROBLEM WITH CONSTRAINT" Nothing ( D.reflow $ - "I got stuck while reading your elm.json file. I ran into an invalid version constraint:", + "I got stuck while reading your gren.json file. I ran into an invalid version constraint:", D.fillSep [ "Maybe", "you", @@ -1423,7 +1423,7 @@ toOutlineProblemReport path source _ region problem = "like", D.green $ "\"" <> D.fromVersion before <> " <= v < " <> D.fromVersion (V.bumpMajor before) <> "\"", "instead?", - "Elm", + "Gren", "checks", "that", "all", @@ -1457,7 +1457,7 @@ toOutlineProblemReport path source _ region problem = "PROBLEM WITH MODULE NAME" (toHighlight row col) ( D.reflow $ - "I got stuck while reading your elm.json file. I was expecting a module name here:", + "I got stuck while reading your gren.json file. I was expecting a module name here:", D.fillSep [ "I", "need", @@ -1488,7 +1488,7 @@ toOutlineProblemReport path source _ region problem = "HEADER TOO LONG" Nothing ( D.reflow $ - "I got stuck while reading your elm.json file. This section header is too long:", + "I got stuck while reading your gren.json file. This section header is too long:", D.stack [ D.fillSep [ "I", @@ -1510,7 +1510,7 @@ toOutlineProblemReport path source _ region problem = ], D.toSimpleNote "I count the length in bytes, so using non-ASCII characters costs extra.\ - \ Please report your case at https://github.com/elm/compiler/issues if this seems\ + \ Please report your case at https://github.com/gren/compiler/issues if this seems\ \ overly restrictive for your needs." ] ) @@ -1519,7 +1519,7 @@ toOutlineProblemReport path source _ region problem = "PROBLEM WITH DEPENDENCY NAME" (toHighlight row col) ( D.reflow $ - "I got stuck while reading your elm.json file. There is something wrong with this dependency name:", + "I got stuck while reading your gren.json file. There is something wrong with this dependency name:", D.stack [ D.fillSep [ "Package", @@ -1539,9 +1539,9 @@ toOutlineProblemReport path source _ region problem = "see", "dependencies", "like", - D.dullyellow "\"mdgriffith/elm-ui\"", + D.dullyellow "\"mdgriffith/gren-ui\"", "and", - D.dullyellow "\"Microsoft/elm-json-tree-view\"" <> "." + D.dullyellow "\"Microsoft/gren-json-tree-view\"" <> "." ], D.fillSep $ [ "I", @@ -1561,7 +1561,7 @@ toOutlineProblemReport path source _ region problem = "it", "with", "the", - D.green "elm install", + D.green "gren install", "command!" ] ] @@ -1571,10 +1571,10 @@ toOutlineProblemReport path source _ region problem = "UNKNOWN LICENSE" Nothing ( D.reflow $ - "I got stuck while reading your elm.json file. I do not know about this type of license:", + "I got stuck while reading your gren.json file. I do not know about this type of license:", D.stack [ D.fillSep - [ "Elm", + [ "Gren", "packages", "generally", "use", @@ -1609,7 +1609,7 @@ toOutlineProblemReport path source _ region problem = "SUMMARY TOO LONG" Nothing ( D.reflow $ - "I got stuck while reading your elm.json file. Your \"summary\" is too long:", + "I got stuck while reading your gren.json file. Your \"summary\" is too long:", D.stack [ D.fillSep [ "I", @@ -1631,7 +1631,7 @@ toOutlineProblemReport path source _ region problem = ], D.toSimpleNote "I count the length in bytes, so using non-ASCII characters costs extra.\ - \ Please report your case at https://github.com/elm/compiler/issues if this seems\ + \ Please report your case at https://github.com/gren/compiler/issues if this seems\ \ overly restrictive for your needs." ] ) @@ -1640,7 +1640,7 @@ toOutlineProblemReport path source _ region problem = "NO SOURCE DIRECTORIES" Nothing ( D.reflow $ - "I got stuck while reading your elm.json file. You do not have any \"source-directories\" listed here:", + "I got stuck while reading your gren.json file. You do not have any \"source-directories\" listed here:", D.fillSep [ "I", "need", @@ -1665,8 +1665,8 @@ data Details = DetailsNoSolution | DetailsNoOfflineSolution | DetailsSolverProblem Solver - | DetailsBadElmInPkg C.Constraint - | DetailsBadElmInAppOutline V.Version + | DetailsBadGrenInPkg C.Constraint + | DetailsBadGrenInAppOutline V.Version | DetailsHandEditedDependencies | DetailsBadOutline Outline | DetailsBadDeps FilePath [DetailsBadDep] @@ -1680,8 +1680,8 @@ toDetailsReport details = DetailsNoSolution -> Help.report "INCOMPATIBLE DEPENDENCIES" - (Just "elm.json") - "The dependencies in your elm.json are not compatible." + (Just "gren.json") + "The dependencies in your gren.json are not compatible." [ D.fillSep [ "Did", "you", @@ -1703,7 +1703,7 @@ toDetailsReport details = "add", "dependencies", "with", - D.green "elm install" <> "." + D.green "gren install" <> "." ], D.reflow $ "Please ask for help on the community forums if you try those paths and are still\ @@ -1712,8 +1712,8 @@ toDetailsReport details = DetailsNoOfflineSolution -> Help.report "TROUBLE VERIFYING DEPENDENCIES" - (Just "elm.json") - "I could not connect to https://package.elm-lang.org to get the latest list of\ + (Just "gren.json") + "I could not connect to https://package.gren-lang.org to get the latest list of\ \ packages, and I was unable to verify your dependencies with the information I\ \ have cached locally." [ D.reflow $ @@ -1741,33 +1741,33 @@ toDetailsReport details = "add", "dependencies", "with", - D.green "elm install" <> "." + D.green "gren install" <> "." ] ] DetailsSolverProblem solver -> toSolverReport solver - DetailsBadElmInPkg constraint -> + DetailsBadGrenInPkg constraint -> Help.report - "ELM VERSION MISMATCH" - (Just "elm.json") - "Your elm.json says this package needs a version of Elm in this range:" + "GREN VERSION MISMATCH" + (Just "gren.json") + "Your gren.json says this package needs a version of Gren in this range:" [ D.indent 4 $ D.dullyellow $ D.fromChars $ C.toChars constraint, D.fillSep [ "But", "you", "are", "using", - "Elm", + "Gren", D.red (D.fromVersion V.compiler), "right", "now." ] ] - DetailsBadElmInAppOutline version -> + DetailsBadGrenInAppOutline version -> Help.report - "ELM VERSION MISMATCH" - (Just "elm.json") - "Your elm.json says this application needs a different version of Elm." + "GREN VERSION MISMATCH" + (Just "gren.json") + "Your gren.json says this application needs a different version of Gren." [ D.fillSep [ "It", "requires", @@ -1784,8 +1784,8 @@ toDetailsReport details = DetailsHandEditedDependencies -> Help.report "ERROR IN DEPENDENCIES" - (Just "elm.json") - "It looks like the dependencies elm.json in were edited by hand (or by a 3rd\ + (Just "gren.json") + "It looks like the dependencies gren.json in were edited by hand (or by a 3rd\ \ party tool) leaving them in an invalid state." [ D.fillSep [ "Try", @@ -1807,7 +1807,7 @@ toDetailsReport details = "add", "dependencies", "with", - D.green "elm install" <> "." + D.green "gren install" <> "." ], D.reflow $ "Please ask for help on the community forums if you try those paths and are still\ @@ -1824,11 +1824,11 @@ toDetailsReport details = "I am not sure what is going wrong though." [ D.reflow $ "I would try deleting the " ++ cacheDir - ++ " and elm-stuff/ directories, then\ + ++ " and .gren/ directories, then\ \ trying to build again. That will work if some cached files got corrupted\ \ somehow.", D.reflow $ - "If that does not work, go to https://elm-lang.org/community and ask for\ + "If that does not work, go to https://gren-lang.org/community and ask for\ \ help. This is a weird case!" ] d : _ -> @@ -1841,8 +1841,8 @@ toDetailsReport details = [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg ++ " " ++ V.toChars vsn, D.reflow $ "This probably means it has package constraints that are too wide. It may be\ - \ possible to tweak your elm.json to avoid the root problem as a stopgap. Head\ - \ over to https://elm-lang.org/community to get help figuring out how to take\ + \ possible to tweak your gren.json to avoid the root problem as a stopgap. Head\ + \ over to https://gren-lang.org/community to get help figuring out how to take\ \ this path!", D.toSimpleNote $ "To help with the root problem, please report this to the package author along\ @@ -1912,10 +1912,10 @@ makeToReport make = case make of MakeNoOutline -> Help.report - "NO elm.json FILE" + "NO gren.json FILE" Nothing - "It looks like you are starting a new Elm project. Very exciting! Try running:" - [ D.indent 4 $ D.green $ "elm init", + "It looks like you are starting a new Gren project. Very exciting! Try running:" + [ D.indent 4 $ D.green $ "gren init", D.reflow $ "It will help you get set up. It is really simple!" ] @@ -1950,11 +1950,11 @@ makeToReport make = Nothing "What should I make though? I need specific files like:" [ D.vcat - [ D.indent 4 $ D.green "elm make src/Main.elm", - D.indent 4 $ D.green "elm make src/This.elm src/That.elm" + [ D.indent 4 $ D.green "gren make src/Main.gren", + D.indent 4 $ D.green "gren make src/This.gren src/That.gren" ], D.reflow $ - "I recommend reading through https://guide.elm-lang.org for guidance on what to\ + "I recommend reading through https://guide.gren-lang.org for guidance on what to\ \ actually put in those files!" ] MakePkgNeedsExposing -> @@ -1963,11 +1963,11 @@ makeToReport make = Nothing "What should I make though? I need specific files like:" [ D.vcat - [ D.indent 4 $ D.green "elm make src/Main.elm", - D.indent 4 $ D.green "elm make src/This.elm src/That.elm" + [ D.indent 4 $ D.green "gren make src/Main.gren", + D.indent 4 $ D.green "gren make src/This.gren src/That.gren" ], D.reflow $ - "You can also entries to the \"exposed-modules\" list in your elm.json file, and\ + "You can also entries to the \"exposed-modules\" list in your gren.json file, and\ \ I will try to compile the relevant files." ] MakeMultipleFilesIntoHtml -> @@ -2009,7 +2009,7 @@ makeToReport make = D.fillSep [ "Switch", "to", - D.dullyellow "--output=elm.js", + D.dullyellow "--output=gren.js", "if", "you", "want", @@ -2034,7 +2034,7 @@ makeToReport make = "that", "embeds", "multiple", - "Elm", + "Gren", "nodes.", "The", "generated", @@ -2077,7 +2077,7 @@ makeToReport make = ], D.reflow $ "From there I can create an HTML file that says \"Hello!\" on screen. I recommend\ - \ looking through https://guide.elm-lang.org for more guidance on how to fill in\ + \ looking through https://guide.gren-lang.org for more guidance on how to fill in\ \ the `main` value." ] MakeNonMainFilesIntoJavaScript m ms -> @@ -2087,7 +2087,7 @@ makeToReport make = "NO MAIN" Nothing ( "When producing a JS file, I require that the given file has a `main` value. That\ - \ way Elm." + \ way Gren." ++ ModuleName.toChars m ++ ".init() is definitely defined in the\ \ resulting file!" @@ -2105,7 +2105,7 @@ makeToReport make = D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text", D.dullyellow "\"Hello!\""] ], D.reflow $ - "Or use https://package.elm-lang.org/packages/elm/core/latest/Platform#worker to\ + "Or use https://package.gren-lang.org/packages/gren/core/latest/Platform#worker to\ \ make a `main` with no user interface." ] _ : _ -> @@ -2113,7 +2113,7 @@ makeToReport make = "NO MAIN" Nothing ( "When producing a JS file, I require that given files all have `main` values.\ - \ That way functions like Elm." + \ That way functions like Gren." ++ ModuleName.toChars m ++ ".init() are\ \ definitely defined in the resulting file. I am missing `main` values in:" @@ -2132,7 +2132,7 @@ makeToReport make = D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text", D.dullyellow "\"Hello!\""] ], D.reflow $ - "Or use https://package.elm-lang.org/packages/elm/core/latest/Platform#worker to\ + "Or use https://package.gren-lang.org/packages/gren/core/latest/Platform#worker to\ \ make a `main` with no user interface." ] MakeCannotBuild buildProblem -> @@ -2177,14 +2177,14 @@ toProjectProblemReport projectProblem = D.reflow $ "Is there a typo?", D.toSimpleNote $ "If you are just getting started, try working through the examples in the\ - \ official guide https://guide.elm-lang.org to get an idea of the kinds of things\ - \ that typically go in a src/Main.elm file." + \ official guide https://guide.gren-lang.org to get an idea of the kinds of things\ + \ that typically go in a src/Main.gren file." ] BP_WithBadExtension path -> Help.report "UNEXPECTED FILE EXTENSION" Nothing - "I can only compile Elm files (with a .elm extension) but you want me to compile:" + "I can only compile Gren files (with a .gren extension) but you want me to compile:" [ D.indent 4 $ D.red $ D.fromChars path, D.reflow $ "Is there a typo? Can the file extension be changed?" ] @@ -2196,7 +2196,7 @@ toProjectProblemReport projectProblem = [ D.indent 4 $ D.red $ D.fromChars path, D.reflow $ "I always check if files appear in any of the \"source-directories\" listed in\ - \ your elm.json to see if there might be some cached information about them. That\ + \ your gren.json to see if there might be some cached information about them. That\ \ can help me compile faster! But in this case, it looks like this file may be in\ \ either of these directories:", D.indent 4 $ D.red $ D.vcat $ map D.fromChars [srcDir1, srcDir2], @@ -2271,8 +2271,8 @@ toProjectProblemReport projectProblem = Import.NotFound -> Help.report "MISSING MODULE" - (Just "elm.json") - "The \"exposed-modules\" of your elm.json lists the following module:" + (Just "gren.json") + "The \"exposed-modules\" of your gren.json lists the following module:" [ D.indent 4 $ D.red $ D.fromName name, D.reflow $ "But I cannot find it in your src/ directory. Is there a typo? Was it renamed?" @@ -2280,8 +2280,8 @@ toProjectProblemReport projectProblem = Import.Ambiguous _ _ pkg _ -> Help.report "AMBIGUOUS MODULE NAME" - (Just "elm.json") - "The \"exposed-modules\" of your elm.json lists the following module:" + (Just "gren.json") + "The \"exposed-modules\" of your gren.json lists the following module:" [ D.indent 4 $ D.red $ D.fromName name, D.reflow $ "But a module from " ++ Pkg.toChars pkg @@ -2291,8 +2291,8 @@ toProjectProblemReport projectProblem = Import.AmbiguousLocal path1 path2 paths -> Help.report "AMBIGUOUS MODULE NAME" - (Just "elm.json") - "The \"exposed-modules\" of your elm.json lists the following module:" + (Just "gren.json") + "The \"exposed-modules\" of your gren.json lists the following module:" [ D.indent 4 $ D.red $ D.fromName name, D.reflow $ "But I found multiple files with that name:", @@ -2306,8 +2306,8 @@ toProjectProblemReport projectProblem = Import.AmbiguousForeign _ _ _ -> Help.report "MISSING MODULE" - (Just "elm.json") - "The \"exposed-modules\" of your elm.json lists the following module:" + (Just "gren.json") + "The \"exposed-modules\" of your gren.json lists the following module:" [ D.indent 4 $ D.red $ D.fromName name, D.reflow $ "But I cannot find it in your src/ directory. Is there a typo? Was it renamed?", @@ -2320,7 +2320,7 @@ toModuleNameConventionTable :: FilePath -> [String] -> D.Doc toModuleNameConventionTable srcDir names = let toPair name = ( name, - srcDir map (\c -> if c == '.' then FP.pathSeparator else c) name <.> "elm" + srcDir map (\c -> if c == '.' then FP.pathSeparator else c) name <.> "gren" ) namePairs = map toPair names @@ -2385,12 +2385,12 @@ corruptCacheReport = Help.report "CORRUPT CACHE" Nothing - "It looks like some of the information cached in elm-stuff/ has been corrupted." + "It looks like some of the information cached in .gren/ has been corrupted." [ D.reflow $ - "Try deleting your elm-stuff/ directory to get unstuck.", + "Try deleting your .gren/ directory to get unstuck.", D.toSimpleNote $ "This almost certainly means that a 3rd party tool (or editor plugin) is\ - \ causing problems your the elm-stuff/ directory. Try disabling 3rd party tools\ + \ causing problems your the .gren/ directory. Try disabling 3rd party tools\ \ one by one until you figure out which it is!" ] @@ -2410,7 +2410,7 @@ reactorToReport problem = "NEW PROJECT?" Nothing "Are you trying to start a new project? Try this command in the terminal:" - [ D.indent 4 $ D.green "elm init", + [ D.indent 4 $ D.green "gren init", D.reflow "It will help you get started!" ] ReactorBadDetails details -> diff --git a/compiler/src/AST/Canonical.hs b/compiler/src/AST/Canonical.hs index 12ddc1ed..e08913fe 100644 --- a/compiler/src/AST/Canonical.hs +++ b/compiler/src/AST/Canonical.hs @@ -35,7 +35,7 @@ module AST.Canonical where {- Creating a canonical AST means finding the home module for all variables. -So if you have L.map, you need to figure out that it is from the elm/core +So if you have L.map, you need to figure out that it is from the core/core package in the List module. In later phases (e.g. type inference, exhaustiveness checking, optimization) @@ -55,16 +55,15 @@ So it is clear why the data is kept around. import qualified AST.Source as Src import qualified AST.Utils.Binop as Binop -import qualified AST.Utils.Shader as Shader import Control.Monad (liftM, liftM2, liftM3, liftM4, replicateM) import Data.Binary import qualified Data.Index as Index import qualified Data.List as List import qualified Data.Map as Map import Data.Name (Name) -import qualified Elm.Float as EF -import qualified Elm.ModuleName as ModuleName -import qualified Elm.String as ES +import qualified Gren.Float as EF +import qualified Gren.ModuleName as ModuleName +import qualified Gren.String as ES import qualified Reporting.Annotation as A -- EXPRESSIONS @@ -101,7 +100,6 @@ data Expr_ | Record (Map.Map Name Expr) | Unit | Tuple Expr Expr (Maybe Expr) - | Shader Shader.Source Shader.Types data CaseBranch = CaseBranch Pattern Expr diff --git a/compiler/src/AST/Optimized.hs b/compiler/src/AST/Optimized.hs index 38bd338b..38846179 100644 --- a/compiler/src/AST/Optimized.hs +++ b/compiler/src/AST/Optimized.hs @@ -30,11 +30,11 @@ import qualified Data.Map as Map import Data.Name (Name) import qualified Data.Name as Name import qualified Data.Set as Set -import qualified Elm.Float as EF -import qualified Elm.Kernel as K -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg -import qualified Elm.String as ES +import qualified Gren.Float as EF +import qualified Gren.Kernel as K +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg +import qualified Gren.String as ES import qualified Optimize.DecisionTree as DT import qualified Reporting.Annotation as A @@ -175,9 +175,9 @@ addKernelDep :: K.Chunk -> Set.Set Global -> Set.Set Global addKernelDep chunk deps = case chunk of K.JS _ -> deps - K.ElmVar home name -> Set.insert (Global home name) deps + K.GrenVar home name -> Set.insert (Global home name) deps K.JsVar shortName _ -> Set.insert (toKernelGlobal shortName) deps - K.ElmField _ -> deps + K.GrenField _ -> deps K.JsField _ -> deps K.JsEnum _ -> deps K.Debug -> deps diff --git a/compiler/src/AST/Source.hs b/compiler/src/AST/Source.hs index a664c347..2e7730a5 100644 --- a/compiler/src/AST/Source.hs +++ b/compiler/src/AST/Source.hs @@ -32,8 +32,8 @@ import qualified AST.Utils.Binop as Binop import qualified AST.Utils.Shader as Shader import Data.Name (Name) import qualified Data.Name as Name -import qualified Elm.Float as EF -import qualified Elm.String as ES +import qualified Gren.Float as EF +import qualified Gren.String as ES import qualified Parse.Primitives as P import qualified Reporting.Annotation as A diff --git a/compiler/src/Canonicalize/Effects.hs b/compiler/src/Canonicalize/Effects.hs index ebdfea2c..8c279cb6 100644 --- a/compiler/src/Canonicalize/Effects.hs +++ b/compiler/src/Canonicalize/Effects.hs @@ -15,7 +15,7 @@ import qualified Canonicalize.Type as Type import qualified Data.Foldable as F import qualified Data.Map as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import qualified Reporting.Error.Canonicalize as Error import qualified Reporting.Result as Result diff --git a/compiler/src/Canonicalize/Environment.hs b/compiler/src/Canonicalize/Environment.hs index b8ab2a01..5167b65e 100644 --- a/compiler/src/Canonicalize/Environment.hs +++ b/compiler/src/Canonicalize/Environment.hs @@ -27,7 +27,7 @@ import qualified Data.Map.Merge.Strict as Map import qualified Data.Map.Strict as Map import qualified Data.Name as Name import qualified Data.OneOrMore as OneOrMore -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import qualified Reporting.Error.Canonicalize as Error import qualified Reporting.Result as Result diff --git a/compiler/src/Canonicalize/Environment/Foreign.hs b/compiler/src/Canonicalize/Environment/Foreign.hs index cfb200db..b4af1336 100644 --- a/compiler/src/Canonicalize/Environment/Foreign.hs +++ b/compiler/src/Canonicalize/Environment/Foreign.hs @@ -15,9 +15,9 @@ import qualified Data.List as List import Data.Map.Strict ((!)) import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.Interface as I -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg +import qualified Gren.Interface as I +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg import qualified Reporting.Annotation as A import qualified Reporting.Error.Canonicalize as Error import qualified Reporting.Result as Result diff --git a/compiler/src/Canonicalize/Environment/Local.hs b/compiler/src/Canonicalize/Environment/Local.hs index 1e049cd1..287db70a 100644 --- a/compiler/src/Canonicalize/Environment/Local.hs +++ b/compiler/src/Canonicalize/Environment/Local.hs @@ -17,7 +17,7 @@ import qualified Data.Index as Index import qualified Data.List as List import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import qualified Reporting.Error.Canonicalize as Error import qualified Reporting.Result as Result diff --git a/compiler/src/Canonicalize/Expression.hs b/compiler/src/Canonicalize/Expression.hs index a175e362..4bedf400 100644 --- a/compiler/src/Canonicalize/Expression.hs +++ b/compiler/src/Canonicalize/Expression.hs @@ -24,8 +24,8 @@ import qualified Data.Index as Index import qualified Data.List as List import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg import qualified Reporting.Annotation as A import qualified Reporting.Error.Canonicalize as Error import qualified Reporting.Result as Result @@ -127,8 +127,9 @@ canonicalize env (A.At region expression) = <$> canonicalize env a <*> canonicalize env b <*> canonicalizeTupleExtras region env cs - Src.Shader src tipe -> - Result.ok (Can.Shader src tipe) + Src.Shader _ _ -> + -- TODO: Remove shaders from language + Result.throw (Error.TupleLargerThanThree region) -- CANONICALIZE TUPLE EXTRAS diff --git a/compiler/src/Canonicalize/Module.hs b/compiler/src/Canonicalize/Module.hs index 9d05f4d3..5c6bb5d3 100644 --- a/compiler/src/Canonicalize/Module.hs +++ b/compiler/src/Canonicalize/Module.hs @@ -19,9 +19,9 @@ import qualified Data.Graph as Graph import qualified Data.Index as Index import qualified Data.Map as Map import qualified Data.Name as Name -import qualified Elm.Interface as I -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg +import qualified Gren.Interface as I +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg import qualified Reporting.Annotation as A import qualified Reporting.Error.Canonicalize as Error import qualified Reporting.Result as Result diff --git a/compiler/src/Canonicalize/Pattern.hs b/compiler/src/Canonicalize/Pattern.hs index a04106d0..cb815c89 100644 --- a/compiler/src/Canonicalize/Pattern.hs +++ b/compiler/src/Canonicalize/Pattern.hs @@ -16,7 +16,7 @@ import qualified Data.Index as Index import qualified Data.List as List import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import qualified Reporting.Error.Canonicalize as Error import qualified Reporting.Result as Result diff --git a/compiler/src/Compile.hs b/compiler/src/Compile.hs index 6f372553..e6e80e2f 100644 --- a/compiler/src/Compile.hs +++ b/compiler/src/Compile.hs @@ -12,9 +12,9 @@ import qualified AST.Source as Src import qualified Canonicalize.Module as Canonicalize import qualified Data.Map as Map import qualified Data.Name as Name -import qualified Elm.Interface as I -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg +import qualified Gren.Interface as I +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg import qualified Nitpick.PatternMatches as PatternMatches import qualified Optimize.Module as Optimize import qualified Reporting.Error as E diff --git a/compiler/src/Data/Name.hs b/compiler/src/Data/Name.hs index 5f65bdb8..4c3fe791 100644 --- a/compiler/src/Data/Name.hs +++ b/compiler/src/Data/Name.hs @@ -9,7 +9,7 @@ module Data.Name ( Name, -- toChars, - toElmString, + toGrenString, toBuilder, -- fromPtr, @@ -76,7 +76,6 @@ import qualified Data.Coerce as Coerce import qualified Data.List as List import qualified Data.String as Chars import qualified Data.Utf8 as Utf8 -import qualified Elm.String as ES import GHC.Exts ( Int (I#), Ptr, @@ -85,21 +84,22 @@ import GHC.Exts import GHC.Prim import GHC.ST (ST (ST), runST) import GHC.Word (Word8 (W8#)) +import qualified Gren.String as ES import Prelude hiding (length, maybe, negate) -- NAME type Name = - Utf8.Utf8 ELM_NAME + Utf8.Utf8 GREN_NAME -data ELM_NAME +data GREN_NAME -- INSTANCES -instance Chars.IsString (Utf8.Utf8 ELM_NAME) where +instance Chars.IsString (Utf8.Utf8 GREN_NAME) where fromString = Utf8.fromChars -instance Binary.Binary (Utf8.Utf8 ELM_NAME) where +instance Binary.Binary (Utf8.Utf8 GREN_NAME) where get = Utf8.getUnder256 put = Utf8.putUnder256 @@ -109,8 +109,8 @@ toChars :: Name -> [Char] toChars = Utf8.toChars -toElmString :: Name -> ES.String -toElmString = +toGrenString :: Name -> ES.String +toGrenString = Coerce.coerce {-# INLINE toBuilder #-} @@ -175,7 +175,7 @@ isCompappendType = Utf8.startsWith prefix_compappend {-# NOINLINE prefix_kernel #-} prefix_kernel :: Name -prefix_kernel = fromChars "Elm.Kernel." +prefix_kernel = fromChars "Gren.Kernel." {-# NOINLINE prefix_number #-} prefix_number :: Name @@ -277,7 +277,7 @@ fromTypeVariableScheme scheme = -- -- Creating a unique name by combining all the subnames can create names -- longer than 256 bytes relatively easily. So instead, the first given name --- (e.g. foo) is prefixed chars that are valid in JS but not Elm (e.g. _M$foo) +-- (e.g. foo) is prefixed chars that are valid in JS but not Gren (e.g. _M$foo) -- -- This should be a unique name since 0.19 disallows shadowing. It would not -- be possible for multiple top-level cycles to include values with the same @@ -529,7 +529,7 @@ identity = fromChars "identity" {-# NOINLINE replModule #-} replModule :: Name -replModule = fromChars "Elm_Repl" +replModule = fromChars "Gren_Repl" {-# NOINLINE replValueToPrint #-} replValueToPrint :: Name diff --git a/compiler/src/Generate/JavaScript.hs b/compiler/src/Generate/JavaScript.hs index 0944f080..e6f51364 100644 --- a/compiler/src/Generate/JavaScript.hs +++ b/compiler/src/Generate/JavaScript.hs @@ -17,13 +17,13 @@ import qualified Data.Map as Map import qualified Data.Name as Name import qualified Data.Set as Set import qualified Data.Utf8 as Utf8 -import qualified Elm.Kernel as K -import qualified Elm.ModuleName as ModuleName import qualified Generate.JavaScript.Builder as JS import qualified Generate.JavaScript.Expression as Expr import qualified Generate.JavaScript.Functions as Functions import qualified Generate.JavaScript.Name as JsName import qualified Generate.Mode as Mode +import qualified Gren.Kernel as K +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Doc as D import qualified Reporting.Render.Type as RT import qualified Reporting.Render.Type.Localizer as L @@ -301,11 +301,11 @@ addChunk mode chunk builder = case chunk of K.JS javascript -> B.byteString javascript <> builder - K.ElmVar home name -> + K.GrenVar home name -> JsName.toBuilder (JsName.fromGlobal home name) <> builder K.JsVar home name -> JsName.toBuilder (JsName.fromKernel home name) <> builder - K.ElmField name -> + K.GrenField name -> JsName.toBuilder (Expr.generateField mode name) <> builder K.JsField int -> JsName.toBuilder (JsName.fromInt int) <> builder diff --git a/compiler/src/Generate/JavaScript/Expression.hs b/compiler/src/Generate/JavaScript/Expression.hs index aff4a895..872f1fee 100644 --- a/compiler/src/Generate/JavaScript/Expression.hs +++ b/compiler/src/Generate/JavaScript/Expression.hs @@ -23,14 +23,14 @@ import qualified Data.Map as Map import qualified Data.Name as Name import qualified Data.Set as Set import qualified Data.Utf8 as Utf8 -import qualified Elm.Compiler.Type as Type -import qualified Elm.Compiler.Type.Extract as Extract -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified Generate.JavaScript.Builder as JS import qualified Generate.JavaScript.Name as JsName import qualified Generate.Mode as Mode +import qualified Gren.Compiler.Type as Type +import qualified Gren.Compiler.Type.Extract as Extract +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import Json.Encode ((==>)) import qualified Json.Encode as Encode import qualified Optimize.DecisionTree as DT @@ -227,7 +227,7 @@ generateCtor mode (Opt.Global home name) index arity = ctorToInt :: ModuleName.Canonical -> Name.Name -> Index.ZeroBased -> Int ctorToInt home name index = - if home == ModuleName.dict && name == "RBNode_elm_builtin" || name == "RBEmpty_elm_builtin" + if home == ModuleName.dict && name == "RBNode_gren_builtin" || name == "RBEmpty_gren_builtin" then 0 - Index.toHuman index else Index.toMachine index @@ -407,24 +407,24 @@ generateBitwiseCall home name args = generateBasicsCall :: Mode.Mode -> ModuleName.Canonical -> Name.Name -> [Opt.Expr] -> JS.Expr generateBasicsCall mode home name args = case args of - [elmArg] -> - let arg = generateJsExpr mode elmArg + [grenArg] -> + let arg = generateJsExpr mode grenArg in case name of "not" -> JS.Prefix JS.PrefixNot arg "negate" -> JS.Prefix JS.PrefixNegate arg "toFloat" -> arg "truncate" -> JS.Infix JS.OpBitwiseOr arg (JS.Int 0) _ -> generateGlobalCall home name [arg] - [elmLeft, elmRight] -> + [grenLeft, grenRight] -> case name of -- NOTE: removed "composeL" and "composeR" because of this issue: - -- https://github.com/elm/compiler/issues/1722 - "append" -> append mode elmLeft elmRight - "apL" -> generateJsExpr mode $ apply elmLeft elmRight - "apR" -> generateJsExpr mode $ apply elmRight elmLeft + -- https://github.com/gren/compiler/issues/1722 + "append" -> append mode grenLeft grenRight + "apL" -> generateJsExpr mode $ apply grenLeft grenRight + "apR" -> generateJsExpr mode $ apply grenRight grenLeft _ -> - let left = generateJsExpr mode elmLeft - right = generateJsExpr mode elmRight + let left = generateJsExpr mode grenLeft + right = generateJsExpr mode grenRight in case name of "add" -> JS.Infix JS.OpAdd left right "sub" -> JS.Infix JS.OpSub left right @@ -845,6 +845,6 @@ toDebugMetadata mode msgType = Mode.Dev (Just interfaces) -> JS.Json $ Encode.object $ - [ "versions" ==> Encode.object ["elm" ==> V.encode V.compiler], + [ "versions" ==> Encode.object ["gren" ==> V.encode V.compiler], "types" ==> Type.encodeMetadata (Extract.fromMsg interfaces msgType) ] diff --git a/compiler/src/Generate/JavaScript/Name.hs b/compiler/src/Generate/JavaScript/Name.hs index b9c0a01c..40e44592 100644 --- a/compiler/src/Generate/JavaScript/Name.hs +++ b/compiler/src/Generate/JavaScript/Name.hs @@ -25,8 +25,8 @@ import qualified Data.Name as Name import qualified Data.Set as Set import qualified Data.Utf8 as Utf8 import Data.Word (Word8) -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg -- NAME @@ -101,7 +101,7 @@ usd = {-# NOINLINE reservedNames #-} reservedNames :: Set.Set Name.Name reservedNames = - Set.union jsReservedWords elmReservedWords + Set.union jsReservedWords grenReservedWords jsReservedWords :: Set.Set Name.Name jsReservedWords = @@ -175,8 +175,8 @@ jsReservedWords = "synchronized" ] -elmReservedWords :: Set.Set Name.Name -elmReservedWords = +grenReservedWords :: Set.Set Name.Name +grenReservedWords = Set.fromList [ "F2", "F3", diff --git a/compiler/src/Generate/Mode.hs b/compiler/src/Generate/Mode.hs index f661c96c..7fc594f1 100644 --- a/compiler/src/Generate/Mode.hs +++ b/compiler/src/Generate/Mode.hs @@ -11,8 +11,8 @@ import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Name as Name -import qualified Elm.Compiler.Type.Extract as Extract import qualified Generate.JavaScript.Name as JsName +import qualified Gren.Compiler.Type.Extract as Extract -- MODE diff --git a/compiler/src/Elm/Compiler/Imports.hs b/compiler/src/Gren/Compiler/Imports.hs similarity index 95% rename from compiler/src/Elm/Compiler/Imports.hs rename to compiler/src/Gren/Compiler/Imports.hs index a3b0dc8e..24aff492 100644 --- a/compiler/src/Elm/Compiler/Imports.hs +++ b/compiler/src/Gren/Compiler/Imports.hs @@ -1,14 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Compiler.Imports +module Gren.Compiler.Imports ( defaults, ) where import qualified AST.Source as Src import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A -- DEFAULTS diff --git a/compiler/src/Elm/Compiler/Type.hs b/compiler/src/Gren/Compiler/Type.hs similarity index 99% rename from compiler/src/Elm/Compiler/Type.hs rename to compiler/src/Gren/Compiler/Type.hs index 9dfbab19..f32a94fe 100644 --- a/compiler/src/Elm/Compiler/Type.hs +++ b/compiler/src/Gren/Compiler/Type.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall -Wno-incomplete-uni-patterns #-} -module Elm.Compiler.Type +module Gren.Compiler.Type ( Type (..), RT.Context (..), toDoc, diff --git a/compiler/src/Elm/Compiler/Type/Extract.hs b/compiler/src/Gren/Compiler/Type/Extract.hs similarity index 97% rename from compiler/src/Elm/Compiler/Type/Extract.hs rename to compiler/src/Gren/Compiler/Type/Extract.hs index 3d6cc9d4..0435f7c5 100644 --- a/compiler/src/Elm/Compiler/Type/Extract.hs +++ b/compiler/src/Gren/Compiler/Type/Extract.hs @@ -3,7 +3,7 @@ {-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Compiler.Type.Extract +module Gren.Compiler.Type.Extract ( fromAnnotation, fromType, Types (..), @@ -23,9 +23,9 @@ import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Name as Name import qualified Data.Set as Set -import qualified Elm.Compiler.Type as T -import qualified Elm.Interface as I -import qualified Elm.ModuleName as ModuleName +import qualified Gren.Compiler.Type as T +import qualified Gren.Interface as I +import qualified Gren.ModuleName as ModuleName -- EXTRACTION diff --git a/compiler/src/Elm/Constraint.hs b/compiler/src/Gren/Constraint.hs similarity index 95% rename from compiler/src/Elm/Constraint.hs rename to compiler/src/Gren/Constraint.hs index 74711fcb..16e62a96 100644 --- a/compiler/src/Elm/Constraint.hs +++ b/compiler/src/Gren/Constraint.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Constraint +module Gren.Constraint ( Constraint, exactly, anything, @@ -9,8 +9,8 @@ module Elm.Constraint satisfies, check, intersect, - goodElm, - defaultElm, + goodGren, + defaultGren, untilNextMajor, untilNextMinor, expand, @@ -23,7 +23,7 @@ where import Control.Monad (liftM4) import Data.Binary (Binary, get, getWord8, put, putWord8) -import qualified Elm.Version as V +import qualified Gren.Version as V import qualified Json.Decode as D import qualified Json.Encode as E import Parse.Primitives (Col, Row) @@ -111,14 +111,14 @@ intersect (Range lo lop hop hi) (Range lo_ lop_ hop_ hi_) = then Just (Range newLo newLop newHop newHi) else Nothing --- ELM CONSTRAINT +-- GREN CONSTRAINT -goodElm :: Constraint -> Bool -goodElm constraint = +goodGren :: Constraint -> Bool +goodGren constraint = satisfies constraint V.compiler -defaultElm :: Constraint -defaultElm = +defaultGren :: Constraint +defaultGren = if V._major V.compiler > 0 then untilNextMajor V.compiler else untilNextMinor V.compiler diff --git a/compiler/src/Elm/Docs.hs b/compiler/src/Gren/Docs.hs similarity index 98% rename from compiler/src/Elm/Docs.hs rename to compiler/src/Gren/Docs.hs index 6606a409..9dbf10f8 100644 --- a/compiler/src/Elm/Docs.hs +++ b/compiler/src/Gren/Docs.hs @@ -4,7 +4,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Docs +module Gren.Docs ( Documentation, Module (..), fromModule, @@ -32,10 +32,10 @@ import qualified Data.Name as Name import qualified Data.NonEmptyList as NE import qualified Data.OneOrMore as OneOrMore import Data.Word (Word8) -import qualified Elm.Compiler.Type as Type -import qualified Elm.Compiler.Type.Extract as Extract -import qualified Elm.ModuleName as ModuleName import Foreign.Ptr (Ptr, plusPtr) +import qualified Gren.Compiler.Type as Type +import qualified Gren.Compiler.Type.Extract as Extract +import qualified Gren.ModuleName as ModuleName import qualified Json.Decode as D import Json.Encode ((==>)) import qualified Json.Encode as E diff --git a/compiler/src/Elm/Float.hs b/compiler/src/Gren/Float.hs similarity index 85% rename from compiler/src/Elm/Float.hs rename to compiler/src/Gren/Float.hs index 7e8c7d29..8267f743 100644 --- a/compiler/src/Elm/Float.hs +++ b/compiler/src/Gren/Float.hs @@ -2,7 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Float +module Gren.Float ( Float, fromPtr, toBuilder, @@ -19,9 +19,9 @@ import Prelude hiding (Float) -- FLOATS type Float = - Utf8.Utf8 ELM_FLOAT + Utf8.Utf8 GREN_FLOAT -data ELM_FLOAT +data GREN_FLOAT -- HELPERS @@ -36,6 +36,6 @@ toBuilder = -- BINARY -instance Binary (Utf8.Utf8 ELM_FLOAT) where +instance Binary (Utf8.Utf8 GREN_FLOAT) where get = Utf8.getUnder256 put = Utf8.putUnder256 diff --git a/compiler/src/Elm/Interface.hs b/compiler/src/Gren/Interface.hs similarity index 99% rename from compiler/src/Elm/Interface.hs rename to compiler/src/Gren/Interface.hs index 15dd3e5d..7e11c3da 100644 --- a/compiler/src/Elm/Interface.hs +++ b/compiler/src/Gren/Interface.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wall #-} -module Elm.Interface +module Gren.Interface ( Interface (..), Union (..), Alias (..), @@ -25,7 +25,7 @@ import qualified Data.Map.Merge.Strict as Map import Data.Map.Strict ((!)) import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.Package as Pkg +import qualified Gren.Package as Pkg import qualified Reporting.Annotation as A -- INTERFACE diff --git a/compiler/src/Elm/Kernel.hs b/compiler/src/Gren/Kernel.hs similarity index 93% rename from compiler/src/Elm/Kernel.hs rename to compiler/src/Gren/Kernel.hs index 78bff632..bc44163f 100644 --- a/compiler/src/Elm/Kernel.hs +++ b/compiler/src/Gren/Kernel.hs @@ -4,7 +4,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Kernel +module Gren.Kernel ( Content (..), Chunk (..), fromByteString, @@ -20,11 +20,11 @@ import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Name as Name import Data.Word (Word8) -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg import Foreign.ForeignPtr (ForeignPtr) import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Ptr (Ptr, minusPtr, plusPtr) +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg import qualified Parse.Module as Module import Parse.Primitives hiding (fromByteString) import qualified Parse.Primitives as P @@ -36,9 +36,9 @@ import qualified Reporting.Annotation as A data Chunk = JS B.ByteString - | ElmVar ModuleName.Canonical Name.Name + | GrenVar ModuleName.Canonical Name.Name | JsVar Name.Name Name.Name - | ElmField Name.Name + | GrenField Name.Name | JsField Int | JsEnum Int | Debug @@ -54,9 +54,9 @@ addField :: Chunk -> Map.Map Name.Name Int -> Map.Map Name.Name Int addField chunk fields = case chunk of JS _ -> fields - ElmVar _ _ -> fields + GrenVar _ _ -> fields JsVar _ _ -> fields - ElmField f -> Map.insertWith (+) f 1 fields + GrenField f -> Map.insertWith (+) f 1 fields JsField _ -> fields JsEnum _ -> fields Debug -> fields @@ -148,7 +148,7 @@ chompTag vs es fs src pos end row col revChunks = then let !name = Name.fromPtr pos newPos in chompChunks vs es fs src newPos end row newCol newPos $ - ElmField name : revChunks + GrenField name : revChunks else let !name = Name.fromPtr tagPos newPos in if 0x30 {-0-} <= word && word <= 0x39 {-9-} @@ -230,7 +230,7 @@ addImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposin let home = ModuleName.Canonical (Map.findWithDefault pkg importName foreigns) importName prefix = toPrefix importName maybeAlias add table name = - Map.insert (Name.sepBy 0x5F {-_-} prefix name) (ElmVar home name) table + Map.insert (Name.sepBy 0x5F {-_-} prefix name) (GrenVar home name) table in List.foldl' add vtable (toNames exposing) toPrefix :: Name.Name -> Maybe Name.Name -> Name.Name @@ -269,9 +269,9 @@ instance Binary Chunk where put chunk = case chunk of JS a -> putWord8 0 >> put a - ElmVar a b -> putWord8 1 >> put a >> put b + GrenVar a b -> putWord8 1 >> put a >> put b JsVar a b -> putWord8 2 >> put a >> put b - ElmField a -> putWord8 3 >> put a + GrenField a -> putWord8 3 >> put a JsField a -> putWord8 4 >> put a JsEnum a -> putWord8 5 >> put a Debug -> putWord8 6 @@ -282,11 +282,11 @@ instance Binary Chunk where word <- getWord8 case word of 0 -> liftM JS get - 1 -> liftM2 ElmVar get get + 1 -> liftM2 GrenVar get get 2 -> liftM2 JsVar get get - 3 -> liftM ElmField get + 3 -> liftM GrenField get 4 -> liftM JsField get 5 -> liftM JsEnum get 6 -> return Debug 7 -> return Prod - _ -> error "problem deserializing Elm.Kernel.Chunk" + _ -> error "problem deserializing Gren.Kernel.Chunk" diff --git a/compiler/src/Elm/Licenses.hs b/compiler/src/Gren/Licenses.hs similarity index 99% rename from compiler/src/Elm/Licenses.hs rename to compiler/src/Gren/Licenses.hs index bd10507a..9da2450f 100644 --- a/compiler/src/Elm/Licenses.hs +++ b/compiler/src/Gren/Licenses.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Licenses +module Gren.Licenses ( License, bsd3, encode, diff --git a/compiler/src/Elm/Magnitude.hs b/compiler/src/Gren/Magnitude.hs similarity index 92% rename from compiler/src/Elm/Magnitude.hs rename to compiler/src/Gren/Magnitude.hs index 18639504..cc3f9ab6 100644 --- a/compiler/src/Elm/Magnitude.hs +++ b/compiler/src/Gren/Magnitude.hs @@ -1,4 +1,4 @@ -module Elm.Magnitude +module Gren.Magnitude ( Magnitude (..), toChars, ) diff --git a/compiler/src/Elm/ModuleName.hs b/compiler/src/Gren/ModuleName.hs similarity index 86% rename from compiler/src/Elm/ModuleName.hs rename to compiler/src/Gren/ModuleName.hs index 0f94b698..f01641c0 100644 --- a/compiler/src/Elm/ModuleName.hs +++ b/compiler/src/Gren/ModuleName.hs @@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UnboxedTuples #-} -module Elm.ModuleName +module Gren.ModuleName ( Raw, toChars, toFilePath, @@ -29,12 +29,6 @@ module Elm.ModuleName virtualDom, jsonDecode, jsonEncode, - webgl, - texture, - vector2, - vector3, - vector4, - matrix4, ) where @@ -43,8 +37,8 @@ import Data.Binary (Binary (..)) import qualified Data.Name as Name import qualified Data.Utf8 as Utf8 import Data.Word (Word8) -import qualified Elm.Package as Pkg import Foreign.Ptr (Ptr, minusPtr, plusPtr) +import qualified Gren.Package as Pkg import qualified Json.Decode as D import qualified Json.Encode as E import Parse.Primitives (Col, Row) @@ -208,29 +202,3 @@ jsonDecode = Canonical Pkg.json "Json.Decode" {-# NOINLINE jsonEncode #-} jsonEncode :: Canonical jsonEncode = Canonical Pkg.json "Json.Encode" - --- WEBGL - -{-# NOINLINE webgl #-} -webgl :: Canonical -webgl = Canonical Pkg.webgl "WebGL" - -{-# NOINLINE texture #-} -texture :: Canonical -texture = Canonical Pkg.webgl "WebGL.Texture" - -{-# NOINLINE vector2 #-} -vector2 :: Canonical -vector2 = Canonical Pkg.linearAlgebra "Math.Vector2" - -{-# NOINLINE vector3 #-} -vector3 :: Canonical -vector3 = Canonical Pkg.linearAlgebra "Math.Vector3" - -{-# NOINLINE vector4 #-} -vector4 :: Canonical -vector4 = Canonical Pkg.linearAlgebra "Math.Vector4" - -{-# NOINLINE matrix4 #-} -matrix4 :: Canonical -matrix4 = Canonical Pkg.linearAlgebra "Math.Matrix4" diff --git a/compiler/src/Elm/Package.hs b/compiler/src/Gren/Package.hs similarity index 89% rename from compiler/src/Elm/Package.hs rename to compiler/src/Gren/Package.hs index 60504cce..1f081fe8 100644 --- a/compiler/src/Elm/Package.hs +++ b/compiler/src/Gren/Package.hs @@ -4,7 +4,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Package +module Gren.Package ( Name (..), Author, Project, @@ -24,8 +24,6 @@ module Elm.Package json, http, url, - webgl, - linearAlgebra, -- suggestions, nearbyNames, @@ -46,8 +44,8 @@ import qualified Data.Map as Map import qualified Data.Name as Name import qualified Data.Utf8 as Utf8 import Data.Word (Word8) -import qualified Elm.Version as V import Foreign.Ptr (Ptr, minusPtr, plusPtr) +import qualified Gren.Version as V import qualified Json.Decode as D import qualified Json.Encode as E import qualified Json.String as Json @@ -82,7 +80,7 @@ data Canonical = Canonical isKernel :: Name -> Bool isKernel (Name author _) = - author == elm || author == elm_explorations + author == gren toChars :: Name -> String toChars (Name author project) = @@ -114,70 +112,55 @@ dummyName = {-# NOINLINE kernel #-} kernel :: Name kernel = - toName elm "kernel" + toName gren "kernel" {-# NOINLINE core #-} core :: Name core = - toName elm "core" + toName gren "core" {-# NOINLINE browser #-} browser :: Name browser = - toName elm "browser" + toName gren "browser" {-# NOINLINE virtualDom #-} virtualDom :: Name virtualDom = - toName elm "virtual-dom" + toName gren "virtual-dom" {-# NOINLINE html #-} html :: Name html = - toName elm "html" + toName gren "html" {-# NOINLINE json #-} json :: Name json = - toName elm "json" + toName gren "json" {-# NOINLINE http #-} http :: Name http = - toName elm "http" + toName gren "http" {-# NOINLINE url #-} url :: Name url = - toName elm "url" + toName gren "url" -{-# NOINLINE webgl #-} -webgl :: Name -webgl = - toName elm_explorations "webgl" - -{-# NOINLINE linearAlgebra #-} -linearAlgebra :: Name -linearAlgebra = - toName elm_explorations "linear-algebra" - -{-# NOINLINE elm #-} -elm :: Author -elm = - Utf8.fromChars "elm" - -{-# NOINLINE elm_explorations #-} -elm_explorations :: Author -elm_explorations = - Utf8.fromChars "elm-explorations" +{-# NOINLINE gren #-} +gren :: Author +gren = + Utf8.fromChars "gren" -- PACKAGE SUGGESTIONS suggestions :: Map.Map Name.Name Name suggestions = - let random = toName elm "random" - time = toName elm "time" - file = toName elm "file" + let random = toName gren "random" + time = toName gren "time" + file = toName gren "file" in Map.fromList [ "Browser" ==> browser, "File" ==> file, @@ -212,7 +195,7 @@ nearbyNames (Name author1 project1) possibleNames = authorDistance :: [Char] -> Author -> Int authorDistance given possibility = - if possibility == elm || possibility == elm_explorations + if possibility == gren then 0 else abs (Suggest.distance given (Utf8.toChars possibility)) diff --git a/compiler/src/Elm/String.hs b/compiler/src/Gren/String.hs similarity index 96% rename from compiler/src/Elm/String.hs rename to compiler/src/Gren/String.hs index 24bd7dd2..f515598a 100644 --- a/compiler/src/Elm/String.hs +++ b/compiler/src/Gren/String.hs @@ -3,7 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-} -module Elm.String +module Gren.String ( String, toChars, toBuilder, @@ -26,9 +26,9 @@ import Prelude hiding (String) -- STRINGS type String = - Utf8.Utf8 ELM_STRING + Utf8.Utf8 GREN_STRING -data ELM_STRING +data GREN_STRING -- HELPERS @@ -116,6 +116,6 @@ writeHex mba !offset !bits = -- BINARY -instance Binary (Utf8.Utf8 ELM_STRING) where +instance Binary (Utf8.Utf8 GREN_STRING) where get = Utf8.getVeryLong put = Utf8.putVeryLong diff --git a/compiler/src/Elm/Version.hs b/compiler/src/Gren/Version.hs similarity index 97% rename from compiler/src/Elm/Version.hs rename to compiler/src/Gren/Version.hs index 07c4029c..b3fb0df5 100644 --- a/compiler/src/Elm/Version.hs +++ b/compiler/src/Gren/Version.hs @@ -2,7 +2,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -Wall #-} -module Elm.Version +module Gren.Version ( Version (..), one, max, @@ -58,7 +58,7 @@ compiler = [major] -> Version major 0 0 [] -> - error "could not detect version of elm-compiler you are using" + error "could not detect version of the compiler you are using" -- BUMP diff --git a/compiler/src/Nitpick/PatternMatches.hs b/compiler/src/Nitpick/PatternMatches.hs index 8a55dbb0..e758fecf 100644 --- a/compiler/src/Nitpick/PatternMatches.hs +++ b/compiler/src/Nitpick/PatternMatches.hs @@ -24,8 +24,8 @@ import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Name as Name import qualified Data.NonEmptyList as NE -import qualified Elm.ModuleName as ModuleName -import qualified Elm.String as ES +import qualified Gren.ModuleName as ModuleName +import qualified Gren.String as ES import qualified Reporting.Annotation as A -- PATTERN @@ -262,8 +262,6 @@ checkExpr (A.At region expression) errors = errors Just c -> checkExpr c errors - Can.Shader _ _ -> - errors -- CHECK FIELD diff --git a/compiler/src/Optimize/DecisionTree.hs b/compiler/src/Optimize/DecisionTree.hs index 9be0f9cc..58416226 100644 --- a/compiler/src/Optimize/DecisionTree.hs +++ b/compiler/src/Optimize/DecisionTree.hs @@ -29,8 +29,8 @@ import qualified Data.List as List import qualified Data.Maybe as Maybe import qualified Data.Name as Name import qualified Data.Set as Set -import qualified Elm.ModuleName as ModuleName -import qualified Elm.String as ES +import qualified Gren.ModuleName as ModuleName +import qualified Gren.String as ES import qualified Reporting.Annotation as A -- COMPILE CASES diff --git a/compiler/src/Optimize/Expression.hs b/compiler/src/Optimize/Expression.hs index c8410264..2a6d7091 100644 --- a/compiler/src/Optimize/Expression.hs +++ b/compiler/src/Optimize/Expression.hs @@ -10,13 +10,11 @@ where import qualified AST.Canonical as Can import qualified AST.Optimized as Opt -import qualified AST.Utils.Shader as Shader import Control.Monad (foldM) import qualified Data.Index as Index -import qualified Data.Map as Map import qualified Data.Name as Name import qualified Data.Set as Set -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Optimize.Case as Case import qualified Optimize.Names as Names import qualified Reporting.Annotation as A @@ -140,8 +138,6 @@ optimize cycle (A.At region expression) = <*> optimize cycle a <*> optimize cycle b <*> traverse (optimize cycle) maybeC - Can.Shader src (Shader.Types attributes uniforms _varyings) -> - pure (Opt.Shader src (Map.keysSet attributes) (Map.keysSet uniforms)) -- UPDATE diff --git a/compiler/src/Optimize/Module.hs b/compiler/src/Optimize/Module.hs index d94fd51c..b73c4dbe 100644 --- a/compiler/src/Optimize/Module.hs +++ b/compiler/src/Optimize/Module.hs @@ -16,7 +16,7 @@ import Data.Map ((!)) import qualified Data.Map as Map import qualified Data.Name as Name import qualified Data.Set as Set -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Optimize.Expression as Expr import qualified Optimize.Names as Names import qualified Optimize.Port as Port diff --git a/compiler/src/Optimize/Names.hs b/compiler/src/Optimize/Names.hs index b539e2f0..a1e11f3e 100644 --- a/compiler/src/Optimize/Names.hs +++ b/compiler/src/Optimize/Names.hs @@ -22,7 +22,7 @@ import qualified Data.Index as Index import qualified Data.Map as Map import qualified Data.Name as Name import qualified Data.Set as Set -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A -- GENERATOR diff --git a/compiler/src/Optimize/Port.hs b/compiler/src/Optimize/Port.hs index ae9a121d..3e0d52aa 100644 --- a/compiler/src/Optimize/Port.hs +++ b/compiler/src/Optimize/Port.hs @@ -15,7 +15,7 @@ import Control.Monad (foldM) import qualified Data.Index as Index import qualified Data.Map as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Optimize.Names as Names import Prelude hiding (maybe, null) @@ -55,7 +55,7 @@ toEncoder tipe = do encoder <- toEncoder fieldType let value = Opt.Call encoder [Opt.Access (Opt.VarLocal Name.dollar) name] - return $ Opt.Tuple (Opt.Str (Name.toElmString name)) value Nothing + return $ Opt.Tuple (Opt.Str (Name.toGrenString name)) value Nothing in do object <- encode "object" keyValuePairs <- traverse encodeField (Map.toList fields) @@ -271,7 +271,7 @@ fieldAndThen decoder (key, Can.FieldType _ tipe) = Opt.Call andThen [ Opt.Function [key] decoder, - Opt.Call field [Opt.Str (Name.toElmString key), typeDecoder] + Opt.Call field [Opt.Str (Name.toGrenString key), typeDecoder] ] -- GLOBALS HELPERS diff --git a/compiler/src/Parse/Module.hs b/compiler/src/Parse/Module.hs index 810ec504..976aef28 100644 --- a/compiler/src/Parse/Module.hs +++ b/compiler/src/Parse/Module.hs @@ -13,8 +13,8 @@ where import qualified AST.Source as Src import qualified Data.ByteString as BS import qualified Data.Name as Name -import qualified Elm.Compiler.Imports as Imports -import qualified Elm.Package as Pkg +import qualified Gren.Compiler.Imports as Imports +import qualified Gren.Package as Pkg import qualified Parse.Declaration as Decl import qualified Parse.Keyword as Keyword import Parse.Primitives hiding (State, fromByteString) diff --git a/compiler/src/Parse/Number.hs b/compiler/src/Parse/Number.hs index 626f52e1..db2cf3ac 100644 --- a/compiler/src/Parse/Number.hs +++ b/compiler/src/Parse/Number.hs @@ -14,8 +14,8 @@ where import qualified AST.Utils.Binop as Binop import Data.Word (Word8) -import qualified Elm.Float as EF import Foreign.Ptr (Ptr, minusPtr, plusPtr) +import qualified Gren.Float as EF import Parse.Primitives (Col, Parser, Row) import qualified Parse.Primitives as P import qualified Parse.Variable as Var diff --git a/compiler/src/Parse/String.hs b/compiler/src/Parse/String.hs index 30c76924..2245563c 100644 --- a/compiler/src/Parse/String.hs +++ b/compiler/src/Parse/String.hs @@ -12,8 +12,8 @@ where import qualified Data.Utf8 as Utf8 import Data.Word (Word16, Word8) -import qualified Elm.String as ES import Foreign.Ptr (Ptr, minusPtr, plusPtr) +import qualified Gren.String as ES import qualified Parse.Number as Number import Parse.Primitives (Col, Parser, Row) import qualified Parse.Primitives as P diff --git a/compiler/src/Reporting/Doc.hs b/compiler/src/Reporting/Doc.hs index 0ac3de6e..43af53c6 100644 --- a/compiler/src/Reporting/Doc.hs +++ b/compiler/src/Reporting/Doc.hs @@ -65,8 +65,8 @@ where import qualified Data.Index as Index import qualified Data.List as List import qualified Data.Name as Name -import qualified Elm.Package as Pkg -import qualified Elm.Version as V +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import Json.Encode ((==>)) import qualified Json.Encode as E import qualified Json.String as Json @@ -172,11 +172,11 @@ fancyLink word before fileName after = makeLink :: [Char] -> [Char] makeLink fileName = - " V.toChars V.compiler <> "/" <> fileName <> ">" + " V.toChars V.compiler <> "/" <> fileName <> ">" makeNakedLink :: [Char] -> [Char] makeNakedLink fileName = - "https://elm-lang.org/" <> V.toChars V.compiler <> "/" <> fileName + "https://gren-lang.org/" <> V.toChars V.compiler <> "/" <> fileName reflowLink :: [Char] -> [Char] -> [Char] -> P.Doc reflowLink before fileName after = diff --git a/compiler/src/Reporting/Error.hs b/compiler/src/Reporting/Error.hs index a4bf6f5b..673bdf7d 100644 --- a/compiler/src/Reporting/Error.hs +++ b/compiler/src/Reporting/Error.hs @@ -12,8 +12,8 @@ where import qualified Data.ByteString as B import qualified Data.NonEmptyList as NE import qualified Data.OneOrMore as OneOrMore -import qualified Elm.ModuleName as ModuleName import qualified File +import qualified Gren.ModuleName as ModuleName import Json.Encode ((==>)) import qualified Json.Encode as E import qualified Reporting.Annotation as A diff --git a/compiler/src/Reporting/Error/Canonicalize.hs b/compiler/src/Reporting/Error/Canonicalize.hs index ffe67a2d..f1751cfe 100644 --- a/compiler/src/Reporting/Error/Canonicalize.hs +++ b/compiler/src/Reporting/Error/Canonicalize.hs @@ -22,7 +22,7 @@ import qualified Data.Map as Map import qualified Data.Name as Name import qualified Data.OneOrMore as OneOrMore import qualified Data.Set as Set -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import Reporting.Doc (Doc, (<+>)) import qualified Reporting.Doc as D @@ -422,7 +422,7 @@ toReport source err = source region Nothing - ( "Elm does not have a (===) operator like JavaScript.", + ( "Gren does not have a (===) operator like JavaScript.", "Switch to (==) instead." ) else @@ -434,7 +434,7 @@ toReport source err = region Nothing ( D.reflow $ - "Elm uses a different name for the “not equal” operator:", + "Gren uses a different name for the “not equal” operator:", D.stack [ D.reflow "Switch to (/=) instead.", D.toSimpleNote $ @@ -465,14 +465,14 @@ toReport source err = region Nothing ( D.reflow $ - "Elm does not use (%) as the remainder operator:", + "Gren does not use (%) as the remainder operator:", D.stack [ D.reflow $ "If you want the behavior of (%) like in JavaScript, switch to:\ - \ ", + \ ", D.reflow $ "If you want modular arithmetic like in math, switch to:\ - \ ", + \ ", D.reflow $ "The difference is how things work when negative numbers are involved." ] @@ -542,7 +542,7 @@ toReport source err = D.reflow $ "But functions cannot be sent in and out ports. If we allowed functions in from JS\ \ they may perform some side-effects. If we let functions out, they could produce\ - \ incorrect results because Elm optimizations assume there are no side-effects." + \ incorrect results because Gren optimizations assume there are no side-effects." ) TypeVariable name -> ( "an unspecified type", @@ -550,12 +550,12 @@ toReport source err = "But type variables like `" <> Name.toChars name <> "` cannot flow through ports.\ \ I need to know exactly what type of data I am getting, so I can guarantee that\ - \ unexpected data cannot sneak in and crash the Elm program." + \ unexpected data cannot sneak in and crash the Gren program." ) UnsupportedType name -> ( "a `" <> Name.toChars name <> "` value", D.stack - [ D.reflow $ "I cannot handle that. The types that CAN flow in and out of Elm include:", + [ D.reflow $ "I cannot handle that. The types that CAN flow in and out of Gren include:", D.indent 4 $ D.reflow $ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\ @@ -602,7 +602,7 @@ toReport source err = D.reflow $ "It must produce a (Cmd msg) type. Notice the lower case `msg` type\ \ variable. The command will trigger some JS code, but it will not send\ - \ anything particular back to Elm." + \ anything particular back to Gren." ) SubBad -> ( "There is something off about this `" <> Name.toChars name <> "` port declaration.", @@ -638,7 +638,7 @@ toReport source err = "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop.", D.stack [ makeTheory "Are you trying to mutate a variable?" $ - "Elm does not have mutation, so when I see " ++ Name.toChars name + "Gren does not have mutation, so when I see " ++ Name.toChars name ++ " defined in terms of " ++ Name.toChars name ++ ", I treat it as a recursive definition. Try giving the new value a new name!", @@ -680,7 +680,7 @@ toReport source err = "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop.", D.stack [ makeTheory "Are you trying to mutate a variable?" $ - "Elm does not have mutation, so when I see " ++ Name.toChars name + "Gren does not have mutation, so when I see " ++ Name.toChars name ++ " defined in terms of " ++ Name.toChars name ++ ", I treat it as a recursive definition. Try giving the new value a new name!", @@ -731,7 +731,7 @@ toReport source err = "Think of a more helpful name for one of them and you should be all set!", D.link "Note" - "Linters advise against shadowing, so Elm makes “best practices” the default. Read" + "Linters advise against shadowing, so Gren makes “best practices” the default. Read" "shadowing" "for more details on this choice." ] @@ -750,7 +750,7 @@ toReport source err = "Note" "Read" "tuples" - "for more comprehensive advice on working with large chunks of data in Elm." + "for more comprehensive advice on working with large chunks of data in Gren." ] ) TypeVarsUnboundInUnion unionRegion typeName allVars unbound unbounds -> @@ -1005,13 +1005,13 @@ notFound source region maybePrefix name thing (PossibleNames locals quals) = [] -> D.stack [ D.reflow noSuggestionDetails, - D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." + D.link "Hint" "Read" "imports" "to see how `import` declarations work in Gren." ] suggestions -> D.stack [ D.reflow yesSuggestionDetails, D.indent 4 $ D.vcat $ map D.dullyellow $ map D.fromChars suggestions, - D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." + D.link "Hint" "Read" "imports" "to see how `import` declarations work in Gren." ] in Report.Report "NAMING ERROR" region nearbyNames $ Code.toSnippet @@ -1100,22 +1100,22 @@ notEqualsHint :: Text -> [Doc] notEqualsHint op = [ "Looking", "for", "the", "“not", "equal”", "operator?", "The", "traditional" , D.dullyellow $ text $ "(" <> op <> ")" - , "is", "replaced", "by", D.green "(/=)", "in", "Elm.", "It", "is", "meant" + , "is", "replaced", "by", D.green "(/=)", "in", "Gren.", "It", "is", "meant" , "to", "look", "like", "the", "“not", "equal”", "sign", "from", "math!", "(≠)" ] equalsHint :: [Doc] equalsHint = [ "A", "special", D.dullyellow "(===)", "operator", "is", "not", "needed" - , "in", "Elm.", "We", "use", D.green "(==)", "for", "everything!" + , "in", "Gren.", "We", "use", D.green "(==)", "for", "everything!" ] modHint :: [Doc] modHint = [ "Rather", "than", "a", D.dullyellow "(%)", "operator," - , "Elm", "has", "a", D.green "modBy", "function." + , "Gren", "has", "a", D.green "modBy", "function." , "Learn", "more", "here:" - , "" + , "" ] -} diff --git a/compiler/src/Reporting/Error/Import.hs b/compiler/src/Reporting/Error/Import.hs index 5ca0b5dc..ed7908f0 100644 --- a/compiler/src/Reporting/Error/Import.hs +++ b/compiler/src/Reporting/Error/Import.hs @@ -9,8 +9,8 @@ where import qualified Data.Map as Map import qualified Data.Set as Set -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Package as Pkg +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Package as Pkg import qualified Reporting.Annotation as A import qualified Reporting.Doc as D import qualified Reporting.Render.Code as Code @@ -47,7 +47,7 @@ toReport source (Error region name unimportedModules problem) = "You are trying to import a `" ++ ModuleName.toChars name ++ "` module:", D.stack [ D.reflow $ - "I checked the \"dependencies\" and \"source-directories\" listed in your elm.json,\ + "I checked the \"dependencies\" and \"source-directories\" listed in your gren.json,\ \ but I cannot find it! Maybe it is a typo for one of these names?", D.dullyellow $ D.indent 4 $ @@ -57,7 +57,7 @@ toReport source (Error region name unimportedModules problem) = Nothing -> D.toSimpleHint $ "If it is not a typo, check the \"dependencies\" and \"source-directories\"\ - \ of your elm.json to make sure all the packages you need are listed there!" + \ of your gren.json to make sure all the packages you need are listed there!" Just dependency -> D.toFancyHint [ "Maybe", @@ -72,7 +72,7 @@ toReport source (Error region name unimportedModules problem) = D.fromChars (Pkg.toChars dependency), "package?", "Running", - D.green (D.fromChars ("elm install " ++ Pkg.toChars dependency)), + D.green (D.fromChars ("gren install " ++ Pkg.toChars dependency)), "should", "make", "it", diff --git a/compiler/src/Reporting/Error/Pattern.hs b/compiler/src/Reporting/Error/Pattern.hs index d743ec4f..8936967a 100644 --- a/compiler/src/Reporting/Error/Pattern.hs +++ b/compiler/src/Reporting/Error/Pattern.hs @@ -8,7 +8,7 @@ module Reporting.Error.Pattern where import qualified Data.List as List -import qualified Elm.String as ES +import qualified Gren.String as ES import qualified Nitpick.PatternMatches as P import qualified Reporting.Doc as D import qualified Reporting.Render.Code as Code diff --git a/compiler/src/Reporting/Error/Syntax.hs b/compiler/src/Reporting/Error/Syntax.hs index 95b648e6..dfc5057b 100644 --- a/compiler/src/Reporting/Error/Syntax.hs +++ b/compiler/src/Reporting/Error/Syntax.hs @@ -48,7 +48,7 @@ where import qualified Data.Char as Char import qualified Data.Name as Name import Data.Word (Word16) -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import Numeric (showHex) import Parse.Primitives (Col, Row) import Parse.Symbol (BadOperator (..)) @@ -575,18 +575,18 @@ toReport source err = region Nothing ( D.reflow $ - "It is not possible to declare an `effect module` outside the @elm organization,\ + "It is not possible to declare an `effect module` outside the @gren organization,\ \ so I am getting stuck here:", D.stack [ D.reflow $ "Switch to a normal module declaration.", D.toSimpleNote $ "Effect modules are designed to allow certain core functionality to be\ - \ defined separately from the compiler. So the @elm organization has access to\ + \ defined separately from the compiler. So the @gren organization has access to\ \ this so that certain changes, extensions, and fixes can be introduced without\ - \ needing to release new Elm binaries. For example, we want to make it possible\ + \ needing to release new Gren binaries. For example, we want to make it possible\ \ to test effects, but this may require changes to the design of effect modules.\ - \ By only having them defined in the @elm organization, that kind of design work\ + \ By only having them defined in the @gren organization, that kind of design work\ \ can proceed much more smoothly." ] ) @@ -598,7 +598,7 @@ noteForPortsInPackage = D.stack [ D.toSimpleNote $ "One of the major goals of the package ecosystem is to be completely written\ - \ in Elm. This means when you install an Elm package, you can be sure you are safe\ + \ in Gren. This means when you install an Gren package, you can be sure you are safe\ \ from security issues on install and that you are not going to get any runtime\ \ exceptions coming from your new dependency. This design also sets the ecosystem\ \ up to target other platforms more easily (like mobile phones, WebAssembly, etc.)\ @@ -724,7 +724,7 @@ toParseErrorReport source modul = ( D.reflow $ "I cannot parse this module declaration:", D.reflow $ - "This type of module is reserved for the @elm organization. It is used to\ + "This type of module is reserved for the @gren organization. It is used to\ \ define certain effects, avoiding building them into the compiler." ) FreshLine row col -> @@ -756,7 +756,7 @@ toParseErrorReport source modul = "I got stuck here:", D.stack [ D.reflow $ - "I am not sure what is going on, but I recommend starting an Elm\ + "I am not sure what is going on, but I recommend starting an Gren\ \ file with the following lines:", D.indent 4 $ D.vcat $ @@ -767,7 +767,7 @@ toParseErrorReport source modul = ], D.reflow $ "You should be able to copy those lines directly into your file. Check out the\ - \ examples at for more help getting started!", + \ examples at for more help getting started!", D.toSimpleNote $ "This can also happen when something is indented too much!" ] @@ -866,7 +866,7 @@ toParseErrorReport source modul = ( D.reflow $ "Something went wrong in this infix operator declaration:", D.reflow $ - "This feature is used by the @elm organization to define the\ + "This feature is used by the @gren organization to define the\ \ languages built-in operators." ) Declarations decl _ _ -> @@ -957,10 +957,10 @@ toWeirdEndReport source row col = D.toSimpleNote $ "Some languages require semicolons at the end of each statement. These are\ \ often called C-like languages, and they usually share a lot of language design\ - \ choices. (E.g. side-effects, for loops, etc.) Elm manages effects with commands\ + \ choices. (E.g. side-effects, for loops, etc.) Gren manages effects with commands\ \ and subscriptions instead, so there is no special syntax for \"statements\" and\ \ therefore no need to use semicolons to separate them. I think this will make\ - \ more sense as you work through though!" + \ more sense as you work through though!" ] ) Just ',' -> @@ -991,9 +991,9 @@ toWeirdEndReport source row col = "I got stuck on this character:", D.stack [ D.reflow $ - "It is not used for anything in Elm syntax. It is used for multi-line strings in\ + "It is not used for anything in Gren syntax. It is used for multi-line strings in\ \ some languages though, so if you want a string that spans multiple lines, you\ - \ can use Elm's multi-line string syntax like this:", + \ can use Gren's multi-line string syntax like this:", D.dullyellow $ D.indent 4 $ D.vcat $ @@ -1019,7 +1019,7 @@ toWeirdEndReport source row col = ( D.reflow $ "I got stuck on this dollar sign:", D.reflow $ - "It is not used for anything in Elm syntax. Are you coming from a language where\ + "It is not used for anything in Gren syntax. Are you coming from a language where\ \ dollar signs can be used in variable names? If so, try a name that (1) starts\ \ with a letter and (2) only contains letters, numbers, and underscores." ) @@ -1033,7 +1033,7 @@ toWeirdEndReport source row col = ( D.reflow $ "I got stuck on this symbol:", D.reflow $ - "It is not used for anything in Elm syntax. Try removing it?" + "It is not used for anything in Gren syntax. Try removing it?" ) _ -> Report.Report "SYNTAX PROBLEM" region [] $ @@ -1376,7 +1376,7 @@ toSpaceReport source space row col = region Nothing ( D.reflow $ - "I ran into a tab, but tabs are not allowed in Elm files.", + "I ran into a tab, but tabs are not allowed in Gren files.", D.reflow $ "Replace the tab with spaces." ) @@ -1392,7 +1392,7 @@ toSpaceReport source space row col = D.stack -- "{-" [ D.reflow "Add a -} somewhere after this to end the comment.", D.toSimpleHint - "Multi-line comments can be nested in Elm, so {- {- -} -} is a comment\ + "Multi-line comments can be nested in Gren, so {- {- -} -} is a comment\ \ that happens to contain another comment. Like parentheses and curly braces,\ \ the start and end markers must always be balanced. Maybe that is the problem?" ] @@ -2267,7 +2267,7 @@ toDeclDefReport source name declDef startRow startCol = "is", "reserved", "in", - "Elm,", + "Gren,", "so", "it", "cannot", @@ -2310,7 +2310,7 @@ toDeclDefReport source name declDef startRow startCol = ] _ -> D.toSimpleNote $ - "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations." + "The `" ++ keyword ++ "` keyword has a special meaning in Gren, so it can only be used in certain situations." ] ) Code.Operator "->" -> @@ -2516,7 +2516,7 @@ declDefNote = ], D.reflow $ "The top line (called a \"type annotation\") is optional. You can leave it off\ - \ if you want. As you get more comfortable with Elm and as your project grows,\ + \ if you want. As you get more comfortable with Gren and as your project grows,\ \ it becomes more and more valuable to add them though! They work great as\ \ compiler-verified documentation, and they often improve error messages!" ] @@ -2873,7 +2873,7 @@ toCharReport source char row col = D.indent 4 $ D.dullyellow "'this'" <> " => " <> D.green "\"this\"", D.toSimpleNote $ - "Elm uses double quotes for strings like \"hello\", whereas it uses single\ + "Gren uses double quotes for strings like \"hello\", whereas it uses single\ \ quotes for individual characters like 'a' and 'ø'. This distinction helps with\ \ code like (String.any (\\c -> c == 'X') \"90210\") where you are inspecting\ \ individual characters." @@ -3148,7 +3148,7 @@ toNumberReport source number row col = "Some languages let you to specify octal numbers by adding a leading zero.\ \ So in C, writing 0111 is the same as writing 73. Some people are used to\ \ that, but others probably want it to equal 111. Either path is going to\ - \ surprise people from certain backgrounds, so Elm tries to avoid this whole\ + \ surprise people from certain backgrounds, so Gren tries to avoid this whole\ \ situation." ] ) @@ -3534,7 +3534,7 @@ toLetDefReport source name def startRow startCol = "is", "reserved", "in", - "Elm,", + "Gren,", "so", "it", "cannot", @@ -3577,7 +3577,7 @@ toLetDefReport source name def startRow startCol = ] _ -> D.toSimpleNote $ - "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations." + "The `" ++ keyword ++ "` keyword has a special meaning in Gren, so it can only be used in certain situations." ] ) Code.Operator "->" -> @@ -3764,7 +3764,7 @@ defNote = ], D.reflow $ "The top line (called a \"type annotation\") is optional. You can leave it off\ - \ if you want. As you get more comfortable with Elm and as your project grows,\ + \ if you want. As you get more comfortable with Gren and as your project grows,\ \ it becomes more and more valuable to add them though! They work great as\ \ compiler-verified documentation, and they often improve error messages!" ] @@ -4664,7 +4664,7 @@ noteForRecordError = ], D.reflow $ "Notice that each line starts with some indentation. Usually two or four spaces.\ - \ This is the stylistic convention in the Elm ecosystem." + \ This is the stylistic convention in the Gren ecosystem." ] noteForRecordIndentError :: D.Doc @@ -4682,7 +4682,7 @@ noteForRecordIndentError = ], D.reflow $ "Notice that each line starts with some indentation. Usually two or four spaces.\ - \ This is the stylistic convention in the Elm ecosystem!" + \ This is the stylistic convention in the Gren ecosystem!" ] -- TUPLE @@ -4901,7 +4901,7 @@ toListReport source context list startRow startCol = ], D.reflow $ "Notice that each line starts with some indentation. Usually two or four spaces.\ - \ This is the stylistic convention in the Elm ecosystem." + \ This is the stylistic convention in the Gren ecosystem." ] ) _ -> @@ -5003,7 +5003,7 @@ toListReport source context list startRow startCol = ], D.reflow $ "Notice that each line starts with some indentation. Usually two or four spaces.\ - \ This is the stylistic convention in the Elm ecosystem." + \ This is the stylistic convention in the Gren ecosystem." ] ) ListIndentEnd row col -> @@ -5046,7 +5046,7 @@ toListReport source context list startRow startCol = ], D.reflow $ "Notice that each line starts with some indentation. Usually two or four spaces.\ - \ This is the stylistic convention in the Elm ecosystem." + \ This is the stylistic convention in the Gren ecosystem." ] ) ListIndentExpr row col -> @@ -5073,7 +5073,7 @@ toListReport source context list startRow startCol = ], D.reflow $ "Notice that each line starts with some indentation. Usually two or four spaces.\ - \ This is the stylistic convention in the Elm ecosystem." + \ This is the stylistic convention in the Gren ecosystem." ] ) @@ -6441,7 +6441,7 @@ noteForRecordTypeError = ], D.reflow $ "Notice that each line starts with some indentation. Usually two or four spaces.\ - \ This is the stylistic convention in the Elm ecosystem." + \ This is the stylistic convention in the Gren ecosystem." ] noteForRecordTypeIndentError :: D.Doc @@ -6459,7 +6459,7 @@ noteForRecordTypeIndentError = ], D.reflow $ "Notice that each line starts with some indentation. Usually two or four spaces.\ - \ This is the stylistic convention in the Elm ecosystem." + \ This is the stylistic convention in the Gren ecosystem." ] toTTupleReport :: Code.Source -> TContext -> TTuple -> Row -> Col -> Report.Report diff --git a/compiler/src/Reporting/Render/Type/Localizer.hs b/compiler/src/Reporting/Render/Type/Localizer.hs index c22a942c..39571277 100644 --- a/compiler/src/Reporting/Render/Type/Localizer.hs +++ b/compiler/src/Reporting/Render/Type/Localizer.hs @@ -15,7 +15,7 @@ import qualified AST.Source as Src import qualified Data.Map as Map import qualified Data.Name as Name import qualified Data.Set as Set -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import qualified Reporting.Doc as D diff --git a/compiler/src/Type/Constrain/Expression.hs b/compiler/src/Type/Constrain/Expression.hs index fe1a4fab..b92847ff 100644 --- a/compiler/src/Type/Constrain/Expression.hs +++ b/compiler/src/Type/Constrain/Expression.hs @@ -8,11 +8,10 @@ module Type.Constrain.Expression where import qualified AST.Canonical as Can -import qualified AST.Utils.Shader as Shader import qualified Data.Index as Index import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import Reporting.Error.Type (Category (..), Context (..), Expected (..), MaybeName (..), PContext (..), PExpected (..), SubContext (..)) import qualified Reporting.Error.Type as E @@ -122,8 +121,6 @@ constrain rtv (A.At region expression) expected = return $ CEqual region Unit UnitN expected Can.Tuple a b maybeC -> constrainTuple rtv region a b maybeC expected - Can.Shader _src types -> - constrainShader region types expected -- CONSTRAIN LAMBDA @@ -427,46 +424,6 @@ constrainTuple rtv region a b maybeC expected = return $ exists [aVar, bVar, cVar] $ CAnd [aCon, bCon, cCon, tupleCon] --- CONSTRAIN SHADER - -constrainShader :: A.Region -> Shader.Types -> Expected Type -> IO Constraint -constrainShader region (Shader.Types attributes uniforms varyings) expected = - do - attrVar <- mkFlexVar - unifVar <- mkFlexVar - let attrType = VarN attrVar - let unifType = VarN unifVar - - let shaderType = - AppN - ModuleName.webgl - Name.shader - [ toShaderRecord attributes attrType, - toShaderRecord uniforms unifType, - toShaderRecord varyings EmptyRecordN - ] - - return $ - exists [attrVar, unifVar] $ - CEqual region Shader shaderType expected - -toShaderRecord :: Map.Map Name.Name Shader.Type -> Type -> Type -toShaderRecord types baseRecType = - if Map.null types - then baseRecType - else RecordN (Map.map glToType types) baseRecType - -glToType :: Shader.Type -> Type -glToType glType = - case glType of - Shader.V2 -> Type.vec2 - Shader.V3 -> Type.vec3 - Shader.V4 -> Type.vec4 - Shader.M4 -> Type.mat4 - Shader.Int -> Type.int - Shader.Float -> Type.float - Shader.Texture -> Type.texture - -- CONSTRAIN DESTRUCTURES constrainDestruct :: RTV -> A.Region -> Can.Pattern -> Can.Expr -> Constraint -> IO Constraint diff --git a/compiler/src/Type/Constrain/Module.hs b/compiler/src/Type/Constrain/Module.hs index 0b6dad79..942f324b 100644 --- a/compiler/src/Type/Constrain/Module.hs +++ b/compiler/src/Type/Constrain/Module.hs @@ -9,7 +9,7 @@ where import qualified AST.Canonical as Can import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import qualified Reporting.Error.Type as E import qualified Type.Constrain.Expression as Expr diff --git a/compiler/src/Type/Constrain/Pattern.hs b/compiler/src/Type/Constrain/Pattern.hs index 93178816..47a08534 100644 --- a/compiler/src/Type/Constrain/Pattern.hs +++ b/compiler/src/Type/Constrain/Pattern.hs @@ -13,7 +13,7 @@ import Control.Monad (foldM) import qualified Data.Index as Index import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import qualified Reporting.Error.Type as E import qualified Type.Instantiate as Instantiate diff --git a/compiler/src/Type/Error.hs b/compiler/src/Type/Error.hs index ddcaadaa..b703cda5 100644 --- a/compiler/src/Type/Error.hs +++ b/compiler/src/Type/Error.hs @@ -22,7 +22,7 @@ import qualified Data.Bag as Bag import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Doc as D import qualified Reporting.Render.Type as RT import qualified Reporting.Render.Type.Localizer as L diff --git a/compiler/src/Type/Type.hs b/compiler/src/Type/Type.hs index d15c1aaf..dff547e6 100644 --- a/compiler/src/Type/Type.hs +++ b/compiler/src/Type/Type.hs @@ -22,11 +22,6 @@ module Type.Type string, bool, never, - vec2, - vec3, - vec4, - mat4, - texture, mkFlexVar, mkFlexNumber, unnamedFlexVar, @@ -46,7 +41,7 @@ import Data.Foldable (foldrM) import qualified Data.Map.Strict as Map import qualified Data.Name as Name import Data.Word (Word32) -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Reporting.Annotation as A import qualified Reporting.Error.Type as E import qualified Type.Error as ET @@ -194,28 +189,6 @@ bool = AppN ModuleName.basics "Bool" [] never :: Type never = AppN ModuleName.basics "Never" [] --- WEBGL TYPES - -{-# NOINLINE vec2 #-} -vec2 :: Type -vec2 = AppN ModuleName.vector2 "Vec2" [] - -{-# NOINLINE vec3 #-} -vec3 :: Type -vec3 = AppN ModuleName.vector3 "Vec3" [] - -{-# NOINLINE vec4 #-} -vec4 :: Type -vec4 = AppN ModuleName.vector4 "Vec4" [] - -{-# NOINLINE mat4 #-} -mat4 :: Type -mat4 = AppN ModuleName.matrix4 "Mat4" [] - -{-# NOINLINE texture #-} -texture :: Type -texture = AppN ModuleName.texture "Texture" [] - -- MAKE FLEX VARIABLES mkFlexVar :: IO Variable diff --git a/compiler/src/Type/Unify.hs b/compiler/src/Type/Unify.hs index 95d8c934..27054bf6 100644 --- a/compiler/src/Type/Unify.hs +++ b/compiler/src/Type/Unify.hs @@ -10,7 +10,7 @@ where import qualified Data.Map.Strict as Map import qualified Data.Name as Name -import qualified Elm.ModuleName as ModuleName +import qualified Gren.ModuleName as ModuleName import qualified Type.Error as Error import qualified Type.Occurs as Occurs import Type.Type as Type diff --git a/gren.cabal b/gren.cabal index 1fa970fd..6f6e8312 100644 --- a/gren.cabal +++ b/gren.cabal @@ -82,24 +82,24 @@ Executable gren Reporting.Task Directories - -- Elm things - Elm.Outline - Elm.Details + -- Gren things + Gren.Outline + Gren.Details -- - Elm.Compiler.Imports - Elm.Compiler.Type - Elm.Compiler.Type.Extract - Elm.Constraint - Elm.Docs - Elm.Float - Elm.Interface - Elm.Kernel - Elm.Licenses - Elm.Magnitude - Elm.ModuleName - Elm.Package - Elm.String - Elm.Version + Gren.Compiler.Imports + Gren.Compiler.Type + Gren.Compiler.Type.Extract + Gren.Constraint + Gren.Docs + Gren.Float + Gren.Interface + Gren.Kernel + Gren.Licenses + Gren.Magnitude + Gren.ModuleName + Gren.Package + Gren.String + Gren.Version -- data structures Data.Bag diff --git a/terminal/impl/Terminal.hs b/terminal/impl/Terminal.hs index c8cfbfdd..8eab37df 100644 --- a/terminal/impl/Terminal.hs +++ b/terminal/impl/Terminal.hs @@ -34,8 +34,8 @@ where import qualified Data.List as List import qualified Data.Maybe as Maybe -import qualified Elm.Version as V import GHC.IO.Encoding (setLocaleEncoding, utf8) +import qualified Gren.Version as V import qualified System.Directory as Dir import qualified System.Environment as Env import qualified System.Exit as Exit @@ -273,7 +273,7 @@ require5 func a b c d e = -- file names: -- -- suggestFiles [] -- suggests any file --- suggestFiles ["elm"] -- suggests only .elm files +-- suggestFiles ["gren"] -- suggests only .gren files -- suggestFiles ["js","html"] -- suggests only .js and .html files -- -- Notice that you can limit the suggestion by the file extension! If you need diff --git a/terminal/impl/Terminal/Helpers.hs b/terminal/impl/Terminal/Helpers.hs index 16e3848d..f440b3f1 100644 --- a/terminal/impl/Terminal/Helpers.hs +++ b/terminal/impl/Terminal/Helpers.hs @@ -2,7 +2,7 @@ module Terminal.Helpers ( version, - elmFile, + grenFile, package, ) where @@ -10,8 +10,8 @@ where import qualified Data.ByteString.UTF8 as BS_UTF8 import qualified Data.Char as Char import qualified Data.Utf8 as Utf8 -import qualified Elm.Package as Pkg -import qualified Elm.Version as V +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Parse.Primitives as P import qualified System.FilePath as FP import Terminal (Parser (..)) @@ -50,27 +50,27 @@ exampleVersions chars = _ -> ["1.0.0", "2.0.3"] else ["1.0.0", "2.0.3"] --- ELM FILE +-- GREN FILE -elmFile :: Parser FilePath -elmFile = +grenFile :: Parser FilePath +grenFile = Parser - { _singular = "elm file", - _plural = "elm files", - _parser = parseElmFile, + { _singular = "gren file", + _plural = "gren files", + _parser = parseGrenFile, _suggest = \_ -> return [], - _examples = exampleElmFiles + _examples = exampleGrenFiles } -parseElmFile :: String -> Maybe FilePath -parseElmFile chars = - if FP.takeExtension chars == ".elm" +parseGrenFile :: String -> Maybe FilePath +parseGrenFile chars = + if FP.takeExtension chars == ".gren" then Just chars else Nothing -exampleElmFiles :: String -> IO [String] -exampleElmFiles _ = - return ["Main.elm", "src/Main.elm"] +exampleGrenFiles :: String -> IO [String] +exampleGrenFiles _ = + return ["Main.gren", "src/Main.gren"] -- PACKAGE diff --git a/terminal/src/Bump.hs b/terminal/src/Bump.hs index 03db34da..0a1461ff 100644 --- a/terminal/src/Bump.hs +++ b/terminal/src/Bump.hs @@ -12,11 +12,11 @@ import qualified Data.NonEmptyList as NE import qualified Deps.Diff as Diff import qualified Deps.Package as Package import qualified Directories as Dirs -import qualified Elm.Details as Details -import qualified Elm.Docs as Docs -import qualified Elm.Magnitude as M -import qualified Elm.Outline as Outline -import qualified Elm.Version as V +import qualified Gren.Details as Details +import qualified Gren.Docs as Docs +import qualified Gren.Magnitude as M +import qualified Gren.Outline as Outline +import qualified Gren.Version as V import qualified Reporting import Reporting.Doc ((<+>)) import qualified Reporting.Doc as D @@ -86,10 +86,10 @@ checkNewPackage root outline@(Outline.PkgOutline _ _ _ version _ _ _ _) = do putStrLn Exit.newPackageOverview if version == V.one - then putStrLn "The version number in elm.json is correct so you are all set!" + then putStrLn "The version number in gren.json is correct so you are all set!" else changeVersion root outline V.one $ - "It looks like the version in elm.json has been changed though!\n\ + "It looks like the version in gren.json has been changed though!\n\ \Would you like me to change it back to " <> D.fromVersion V.one <> "? [Y/n] " @@ -113,13 +113,13 @@ suggestVersion (Env root cache outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) new = D.fromVersion newVersion mag = D.fromChars $ M.toChars (Diff.toMagnitude changes) in "Based on your new API, this should be a" <+> D.green mag <+> "change (" <> old <> " => " <> new <> ")\n" - <> "Bail out of this command and run 'elm diff' for a full explanation.\n" + <> "Bail out of this command and run 'gren diff' for a full explanation.\n" <> "\n" <> "Should I perform the update (" <> old <> " => " <> new - <> ") in elm.json? [Y/n] " + <> ") in gren.json? [Y/n] " generateDocs :: FilePath -> Outline.PkgOutline -> Task.Task Exit.Bump Docs.Documentation generateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) = diff --git a/terminal/src/Diff.hs b/terminal/src/Diff.hs index 09e5b3cd..6747f578 100644 --- a/terminal/src/Diff.hs +++ b/terminal/src/Diff.hs @@ -18,13 +18,13 @@ import Deps.Diff (Changes (..), ModuleChanges (..), PackageChanges (..)) import qualified Deps.Diff as DD import qualified Deps.Package as Package import qualified Directories as Dirs -import qualified Elm.Compiler.Type as Type -import qualified Elm.Details as Details -import qualified Elm.Docs as Docs -import qualified Elm.Magnitude as M -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg -import qualified Elm.Version as V +import qualified Gren.Compiler.Type as Type +import qualified Gren.Details as Details +import qualified Gren.Docs as Docs +import qualified Gren.Magnitude as M +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Reporting import Reporting.Doc ((<+>)) import qualified Reporting.Doc as D diff --git a/terminal/src/Init.hs b/terminal/src/Init.hs index 2fe0d727..6cfb0533 100644 --- a/terminal/src/Init.hs +++ b/terminal/src/Init.hs @@ -8,10 +8,10 @@ where import qualified Data.Map as Map import qualified Data.NonEmptyList as NE import qualified Deps.Solver as Solver -import qualified Elm.Constraint as Con -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg -import qualified Elm.Version as V +import qualified Gren.Constraint as Con +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Reporting import qualified Reporting.Doc as D import qualified Reporting.Exit as Exit @@ -24,7 +24,7 @@ run :: () -> () -> IO () run () () = Reporting.attempt Exit.initToReport $ do - exists <- Dir.doesFileExist "elm.json" + exists <- Dir.doesFileExist "gren.json" if exists then return (Left Exit.InitAlreadyExists) else do @@ -40,13 +40,13 @@ question = D.stack [ D.fillSep [ "Hello!", - "Elm", + "Gren", "projects", "always", "start", "with", "an", - D.green "elm.json", + D.green "gren.json", "file.", "I", "can", @@ -54,7 +54,7 @@ question = "them!" ], D.reflow - "Now you may be wondering, what will be in this file? How do I add Elm files to\ + "Now you may be wondering, what will be in this file? How do I add Gren files to\ \ my project? How do I see it in the browser? How will my code grow? Do I need\ \ more directories? What about tests? Etc.", D.fillSep @@ -66,7 +66,7 @@ question = "the", "answers!" ], - "Knowing all that, would you like me to create an elm.json file now? [Y/n]: " + "Knowing all that, would you like me to create an gren.json file now? [Y/n]: " ] -- INIT diff --git a/terminal/src/Install.hs b/terminal/src/Install.hs index 372ed1dd..57df20f9 100644 --- a/terminal/src/Install.hs +++ b/terminal/src/Install.hs @@ -12,11 +12,11 @@ import qualified Data.Map as Map import qualified Data.Map.Merge.Strict as Map import qualified Deps.Solver as Solver import qualified Directories as Dirs -import qualified Elm.Constraint as C -import qualified Elm.Details as Details -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg -import qualified Elm.Version as V +import qualified Gren.Constraint as C +import qualified Gren.Details as Details +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Reporting import Reporting.Doc ((<+>)) import qualified Reporting.Doc as D @@ -41,8 +41,8 @@ run args () = case args of NoArgs -> do - elmHome <- Dirs.getGrenHome - return (Left (Exit.InstallNoArgs elmHome)) + grenHome <- Dirs.getGrenHome + return (Left (Exit.InstallNoArgs grenHome)) Install pkg -> Task.run $ do @@ -82,7 +82,7 @@ attemptChanges root env oldOutline toChars changes = "it", "in", "your", - "elm.json", + "gren.json", "file,", "but", "in", @@ -114,7 +114,7 @@ attemptChanges root env oldOutline toChars changes = "it", "in", "your", - "elm.json", + "gren.json", "file,", "but", "in", @@ -144,7 +144,7 @@ attemptChanges root env oldOutline toChars changes = [ "Here is my plan:", viewChangeDocs changeDocs, "", - "Would you like me to update your elm.json accordingly? [Y/n]: " + "Would you like me to update your gren.json accordingly? [Y/n]: " ] attemptChangesHelp :: FilePath -> Solver.Env -> Outline.Outline -> Outline.Outline -> D.Doc -> Task () diff --git a/terminal/src/Main.hs b/terminal/src/Main.hs index 94067a33..d23d2311 100644 --- a/terminal/src/Main.hs +++ b/terminal/src/Main.hs @@ -8,7 +8,7 @@ where import qualified Bump import qualified Data.List as List import qualified Diff -import qualified Elm.Version as V +import qualified Gren.Version as V import qualified Init import qualified Install import qualified Make @@ -45,14 +45,14 @@ intro = "for", "trying", "out", - P.green "Elm", + P.green "Gren", P.green (P.text (V.toChars V.compiler)) <> ".", "I hope you like it!" ], "", P.black "-------------------------------------------------------------------------------", - P.black "I highly recommend working through to get started.", - P.black "It teaches many important concepts, including how to use `elm` in the terminal.", + P.black "I highly recommend working through to get started.", + P.black "It teaches many important concepts, including how to use `gren` in the terminal.", P.black "-------------------------------------------------------------------------------" ] @@ -61,7 +61,7 @@ outro = P.fillSep $ map P.text $ words - "Be sure to ask on the Elm slack if you run into trouble! Folks are friendly and\ + "Be sure to ask on the Gren slack if you run into trouble! Folks are friendly and\ \ happy to help out. They hang out there because it is fun, so be kind to get the\ \ best results!" @@ -70,16 +70,16 @@ outro = init :: Terminal.Command init = let summary = - "Start an Elm project. It creates a starter elm.json file and\ + "Start an Gren project. It creates a starter gren.json file and\ \ provides a link explaining what to do from there." details = - "The `init` command helps start Elm projects:" + "The `init` command helps start Gren projects:" example = reflow - "It will ask permission to create an elm.json file, the one thing common\ - \ to all Elm projects. It also provides a link explaining what to do from there." + "It will ask permission to create an gren.json file, the one thing common\ + \ to all Gren projects. It also provides a link explaining what to do from there." in Terminal.Command "init" (Common summary) details example noArgs noFlags Init.run -- REPL @@ -87,7 +87,7 @@ init = repl :: Terminal.Command repl = let summary = - "Open up an interactive programming session. Type in Elm expressions\ + "Open up an interactive programming session. Type in Gren expressions\ \ like (2 + 2) or (String.length \"test\") and see if they equal four!" details = @@ -95,7 +95,7 @@ repl = example = reflow - "Start working through to learn how to use this!\ + "Start working through to learn how to use this!\ \ It has a whole chapter that uses the REPL for everything, so that is probably\ \ the quickest way to get started." @@ -120,15 +120,15 @@ interpreter = make :: Terminal.Command make = let details = - "The `make` command compiles Elm code into JS or HTML:" + "The `make` command compiles Gren code into JS or HTML:" example = stack [ reflow "For example:", - P.indent 4 $ P.green "elm make src/Main.elm", + P.indent 4 $ P.green "gren make src/Main.gren", reflow - "This tries to compile an Elm file named src/Main.elm, generating an index.html\ + "This tries to compile an Gren file named src/Main.gren, generating an index.html\ \ file if possible." ] @@ -136,17 +136,17 @@ make = flags Make.Flags |-- onOff "debug" "Turn on the time-travelling debugger. It allows you to rewind and replay events. The events can be imported/exported into a file, which makes for very precise bug reports!" |-- onOff "optimize" "Turn on optimizations to make code smaller and faster. For example, the compiler renames record fields to be as short as possible and unboxes values to reduce allocation." - |-- flag "output" Make.output "Specify the name of the resulting JS file. For example --output=assets/elm.js to generate the JS at assets/elm.js or --output=/dev/null to generate no output at all!" + |-- flag "output" Make.output "Specify the name of the resulting JS file. For example --output=assets/gren.js to generate the JS at assets/gren.js or --output=/dev/null to generate no output at all!" |-- flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!" |-- flag "docs" Make.docsFile "Generate a JSON file of documentation for a package. Eventually it will be possible to preview docs with `reactor` because it is quite hard to deal with these JSON files directly." - in Terminal.Command "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run + in Terminal.Command "make" Uncommon details example (zeroOrMore grenFile) makeFlags Make.run -- INSTALL install :: Terminal.Command install = let details = - "The `install` command fetches packages from for\ + "The `install` command fetches packages from for\ \ use in your project:" example = @@ -156,8 +156,8 @@ install = P.indent 4 $ P.green $ P.vcat $ - [ "elm install elm/http", - "elm install elm/json" + [ "gren install gren/http", + "gren install gren/json" ], reflow "Notice that you must say the AUTHOR name and PROJECT name! After running those\ @@ -179,18 +179,18 @@ install = publish :: Terminal.Command publish = let details = - "The `publish` command publishes your package on \ - \ so that anyone in the Elm community can use it." + "The `publish` command publishes your package on \ + \ so that anyone in the Gren community can use it." example = stack [ reflow "Think hard if you are ready to publish NEW packages though!", reflow - "Part of what makes Elm great is the packages ecosystem. The fact that\ + "Part of what makes Gren great is the packages ecosystem. The fact that\ \ there is usually one option (usually very well done) makes it way\ \ easier to pick packages and become productive. So having a million\ - \ packages would be a failure in Elm. We do not need twenty of\ + \ packages would be a failure in Gren. We do not need twenty of\ \ everything, all coded in a single weekend.", reflow "So as community members gain wisdom through experience, we want\ @@ -202,7 +202,7 @@ publish = \ it ends up as an experiment on GitHub only. Point is, try to be\ \ respectful of the community and package ecosystem!", reflow - "Check out for guidance on how to create great packages!" + "Check out for guidance on how to create great packages!" ] in Terminal.Command "publish" Uncommon details example noArgs noFlags Publish.run @@ -218,7 +218,7 @@ bump = "Say you just published version 1.0.0, but then decided to remove a function.\ \ I will compare the published API to what you have locally, figure out that\ \ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\ - \ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Elm!" + \ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Gren!" in Terminal.Command "bump" Uncommon details example noArgs noFlags Bump.run -- DIFF @@ -233,7 +233,7 @@ diff = [ reflow "For example, to see what changed in the HTML package between\ \ versions 1.0.0 and 2.0.0, you can say:", - P.indent 4 $ P.green $ "elm diff elm/html 1.0.0 2.0.0", + P.indent 4 $ P.green $ "gren diff gren/html 1.0.0 2.0.0", reflow "Sometimes a MAJOR change is not actually very big, so\ \ this can help you plan your upgrade timelines." diff --git a/terminal/src/Make.hs b/terminal/src/Make.hs index 44619b7c..ab20fd00 100644 --- a/terminal/src/Make.hs +++ b/terminal/src/Make.hs @@ -18,11 +18,11 @@ import qualified Data.ByteString.Builder as B import qualified Data.Maybe as Maybe import qualified Data.NonEmptyList as NE import qualified Directories as Dirs -import qualified Elm.Details as Details -import qualified Elm.ModuleName as ModuleName import qualified File import qualified Generate import qualified Generate.Html as Html +import qualified Gren.Details as Details +import qualified Gren.ModuleName as ModuleName import qualified Reporting import qualified Reporting.Exit as Exit import qualified Reporting.Task as Task @@ -90,7 +90,7 @@ runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) = name : names -> do builder <- toBuilder root details desiredMode artifacts - generate style "elm.js" builder (NE.List name names) + generate style "gren.js" builder (NE.List name names) Just DevNull -> return () Just (JS target) -> @@ -239,7 +239,7 @@ output = _plural = "output files", _parser = parseOutput, _suggest = \_ -> return [], - _examples = \_ -> return ["elm.js", "index.html", "/dev/null"] + _examples = \_ -> return ["gren.js", "index.html", "/dev/null"] } parseOutput :: String -> Maybe Output diff --git a/terminal/src/Publish.hs b/terminal/src/Publish.hs index f24970d4..7cc9b58f 100644 --- a/terminal/src/Publish.hs +++ b/terminal/src/Publish.hs @@ -14,14 +14,14 @@ import qualified Data.NonEmptyList as NE import qualified Deps.Diff as Diff import qualified Deps.Package as Package import qualified Directories as Dirs -import qualified Elm.Details as Details -import qualified Elm.Docs as Docs -import qualified Elm.Magnitude as M -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified File import qualified Git +import qualified Gren.Details as Details +import qualified Gren.Docs as Docs +import qualified Gren.Magnitude as M +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Json.String as Json import qualified Reporting import Reporting.Doc ((<+>)) diff --git a/terminal/src/Repl.hs b/terminal/src/Repl.hs index 1b325521..a987d2d0 100644 --- a/terminal/src/Repl.hs +++ b/terminal/src/Repl.hs @@ -34,14 +34,14 @@ import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Name as N import qualified Directories as Dirs -import qualified Elm.Constraint as C -import qualified Elm.Details as Details -import qualified Elm.Licenses as Licenses -import qualified Elm.ModuleName as ModuleName -import qualified Elm.Outline as Outline -import qualified Elm.Package as Pkg -import qualified Elm.Version as V import qualified Generate +import qualified Gren.Constraint as C +import qualified Gren.Details as Details +import qualified Gren.Licenses as Licenses +import qualified Gren.ModuleName as ModuleName +import qualified Gren.Outline as Outline +import qualified Gren.Package as Pkg +import qualified Gren.Version as V import qualified Parse.Declaration as PD import qualified Parse.Expression as PE import qualified Parse.Module as PM @@ -89,7 +89,7 @@ run () flags = printWelcomeMessage :: IO () printWelcomeMessage = let vsn = V.toChars V.compiler - title = "Elm" <+> D.fromChars vsn + title = "Gren" <+> D.fromChars vsn dashes = replicate (70 - length vsn) '-' in D.toAnsi IO.stdout $ D.vcat @@ -513,7 +513,7 @@ getRoot = (Outline.ExposedList []) defaultDeps Map.empty - C.defaultElm + C.defaultGren return root