From 0b9fa76052bc68e9e7e7749402528249fb0ca129 Mon Sep 17 00:00:00 2001 From: Changlin Li Date: Tue, 5 Dec 2023 11:41:40 -0800 Subject: [PATCH] Change all instances in code of Zelm to Zokka This finishes https://github.com/changlinli/zokka-compiler/issues/6 --- builder/src/Deps/CustomRepositoryDataIO.hs | 16 ++--- builder/src/Deps/Diff.hs | 8 +-- builder/src/Deps/Registry.hs | 60 ++++++++--------- builder/src/Deps/Solver.hs | 42 ++++++------ builder/src/Elm/CustomRepositoryData.hs | 10 +-- builder/src/Elm/Details.hs | 36 +++++----- builder/src/Elm/Outline.hs | 6 +- builder/src/Reporting/Exit.hs | 26 ++++---- builder/src/Stuff.hs | 78 +++++++++++----------- compiler/src/Elm/Package.hs | 30 ++++----- terminal/impl/Terminal/Helpers.hs | 6 +- terminal/src/Bump.hs | 8 +-- terminal/src/Diff.hs | 8 +-- terminal/src/Main.hs | 4 +- terminal/src/Publish.hs | 12 ++-- tests/TestMain.hs | 16 ++--- 16 files changed, 183 insertions(+), 183 deletions(-) diff --git a/builder/src/Deps/CustomRepositoryDataIO.hs b/builder/src/Deps/CustomRepositoryDataIO.hs index 5690f7f4f..bb8339cd8 100644 --- a/builder/src/Deps/CustomRepositoryDataIO.hs +++ b/builder/src/Deps/CustomRepositoryDataIO.hs @@ -10,23 +10,23 @@ import qualified File import qualified Json.Decode as D import qualified Json.Encode as E import Data.Bifunctor (first) -import Stuff (ZelmCustomRepositoryConfigFilePath (..)) +import Stuff (ZokkaCustomRepositoryConfigFilePath (..)) data CustomRepositoriesError = CREJsonDecodeError (D.Error CustomRepositoryDataParseError) deriving Show -- FIXME: Boolean argument a hack for now -createCustomRepositoriesData :: ZelmCustomRepositoryConfigFilePath -> Bool -> IO (Either e CustomRepositoriesData) -createCustomRepositoriesData (ZelmCustomRepositoryConfigFilePath filePath) shouldIncludeZelmRepo = +createCustomRepositoriesData :: ZokkaCustomRepositoryConfigFilePath -> Bool -> IO (Either e CustomRepositoriesData) +createCustomRepositoriesData (ZokkaCustomRepositoryConfigFilePath filePath) shouldIncludeZokkaRepo = let - defaultData = if shouldIncludeZelmRepo then defaultCustomRepositoriesData else defaultCustomRepositoriesDataElmPackageRepoOnly + defaultData = if shouldIncludeZokkaRepo then defaultCustomRepositoriesData else defaultCustomRepositoriesDataElmPackageRepoOnly in do E.write filePath (customRepostoriesDataEncoder defaultData) pure (Right defaultData) -loadCustomRepositoriesData :: ZelmCustomRepositoryConfigFilePath -> IO (Either CustomRepositoriesError CustomRepositoriesData) -loadCustomRepositoriesData z@(ZelmCustomRepositoryConfigFilePath filePath) = do +loadCustomRepositoriesData :: ZokkaCustomRepositoryConfigFilePath -> IO (Either CustomRepositoriesError CustomRepositoriesData) +loadCustomRepositoriesData z@(ZokkaCustomRepositoryConfigFilePath filePath) = do customReposDataDoesExist <- File.exists filePath if customReposDataDoesExist then do @@ -35,8 +35,8 @@ loadCustomRepositoriesData z@(ZelmCustomRepositoryConfigFilePath filePath) = do else createCustomRepositoriesData z True -loadCustomRepositoriesDataForReactorTH :: ZelmCustomRepositoryConfigFilePath -> IO (Either CustomRepositoriesError CustomRepositoriesData) -loadCustomRepositoriesDataForReactorTH z@(ZelmCustomRepositoryConfigFilePath filePath) = do +loadCustomRepositoriesDataForReactorTH :: ZokkaCustomRepositoryConfigFilePath -> IO (Either CustomRepositoriesError CustomRepositoriesData) +loadCustomRepositoriesDataForReactorTH z@(ZokkaCustomRepositoryConfigFilePath filePath) = do customReposDataDoesExist <- File.exists filePath if customReposDataDoesExist then do diff --git a/builder/src/Deps/Diff.hs b/builder/src/Deps/Diff.hs index 60c41d18f..52f95cc6a 100644 --- a/builder/src/Deps/Diff.hs +++ b/builder/src/Deps/Diff.hs @@ -33,7 +33,7 @@ import qualified Http import qualified Json.Decode as D import qualified Reporting.Exit as Exit import qualified Stuff -import Deps.Registry (ZelmRegistries) +import Deps.Registry (ZokkaRegistries) import qualified Deps.Registry as Registry import qualified Data.Utf8 as Utf8 import Logging.Logger (printLog) @@ -359,8 +359,8 @@ changeMagnitude (Changes added changed removed) = -- GET DOCS -getDocs :: Stuff.PackageCache -> ZelmRegistries -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.DocsProblem Docs.Documentation) -getDocs cache zelmRegistry manager name version = +getDocs :: Stuff.PackageCache -> ZokkaRegistries -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.DocsProblem Docs.Documentation) +getDocs cache zokkaRegistry manager name version = do let home = Stuff.package cache name version let path = home "docs.json" exists <- File.exists path @@ -375,7 +375,7 @@ getDocs cache zelmRegistry manager name version = do File.remove path return $ Left Exit.DP_Cache else - do let registryKeyMaybe = Registry.lookupPackageRegistryKey zelmRegistry name version + do let registryKeyMaybe = Registry.lookupPackageRegistryKey zokkaRegistry name version -- FIXME: Handle the non-repository URL case better repositoryUrl <- case registryKeyMaybe of Just (Registry.RepositoryUrlKey repositoryUrl) -> pure repositoryUrl diff --git a/builder/src/Deps/Registry.hs b/builder/src/Deps/Registry.hs index f429841f4..fa2774ee8 100644 --- a/builder/src/Deps/Registry.hs +++ b/builder/src/Deps/Registry.hs @@ -3,7 +3,7 @@ module Deps.Registry ( Registry(..) , KnownVersions(..) - , ZelmRegistries(..) + , ZokkaRegistries(..) , RegistryKey(..) , read , fetch @@ -48,7 +48,7 @@ import Data.Map.Utils (exchangeKeys, invertMap) -- because of how we perform updates of the registry. We need to know how many -- packages came from a given repository to pass to the /all-packages/since -- endpoint. So we can't start from the outset with all the registries merged. -data ZelmRegistries = ZelmRegistries +data ZokkaRegistries = ZokkaRegistries { _registries :: !(Map.Map RegistryKey Registry) , _packagesToLocations :: !(Map.Map Pkg.Name (Map.Map V.Version RegistryKey)) } @@ -60,8 +60,8 @@ knownVersionsToNEListOfVersions :: KnownVersions -> NE.List V.Version knownVersionsToNEListOfVersions (KnownVersions newest rest) = NE.List newest rest -zelmRegistriesFromRegistriesMap :: Map.Map RegistryKey Registry -> ZelmRegistries -zelmRegistriesFromRegistriesMap registriesMap = +zokkaRegistriesFromRegistriesMap :: Map.Map RegistryKey Registry -> ZokkaRegistries +zokkaRegistriesFromRegistriesMap registriesMap = let --FIXME: Deal with what happens when we have multiple registries with the same -- version of a package. Right now we just essentially randomly choose one @@ -72,11 +72,11 @@ zelmRegistriesFromRegistriesMap registriesMap = pkgNamesToAllVersionsAndRegistry = fmap invertMap pkgNamesToRegistryAndAllVersions pkgNamesToSingleVersionAndRegistry = (fmap . fmap) NE.head pkgNamesToAllVersionsAndRegistry in - ZelmRegistries{_registries=registriesMap, _packagesToLocations=pkgNamesToSingleVersionAndRegistry} + ZokkaRegistries{_registries=registriesMap, _packagesToLocations=pkgNamesToSingleVersionAndRegistry} -lookupPackageRegistryKey :: ZelmRegistries -> Pkg.Name -> V.Version -> Maybe RegistryKey -lookupPackageRegistryKey ZelmRegistries{_packagesToLocations=packagesToLocations} pkgName pkgVersion = +lookupPackageRegistryKey :: ZokkaRegistries -> Pkg.Name -> V.Version -> Maybe RegistryKey +lookupPackageRegistryKey ZokkaRegistries{_packagesToLocations=packagesToLocations} pkgName pkgVersion = do versions <- Map.lookup pkgName packagesToLocations Map.lookup pkgVersion versions @@ -102,8 +102,8 @@ emptyRegistry :: Registry emptyRegistry = Registry 0 Map.empty -mergeRegistries :: ZelmRegistries -> Registry -mergeRegistries ZelmRegistries{_registries=registries} = Map.foldl combineRegistry emptyRegistry registries +mergeRegistries :: ZokkaRegistries -> Registry +mergeRegistries ZokkaRegistries{_registries=registries} = Map.foldl combineRegistry emptyRegistry registries data Registry = @@ -126,7 +126,7 @@ data KnownVersions = -- READ -read :: HasCallStack => Stuff.ZelmSpecificCache -> IO (Maybe ZelmRegistries) +read :: HasCallStack => Stuff.ZokkaSpecificCache -> IO (Maybe ZokkaRegistries) read cache = File.readBinary (Stuff.registry cache) @@ -136,7 +136,7 @@ read cache = -fetch :: Http.Manager -> Stuff.ZelmSpecificCache -> CustomRepositoriesData -> IO (Either Exit.RegistryProblem ZelmRegistries) +fetch :: Http.Manager -> Stuff.ZokkaSpecificCache -> CustomRepositoriesData -> IO (Either Exit.RegistryProblem ZokkaRegistries) fetch manager cache (CustomRepositoriesData customFullRepositories singlePackageLocations) = do -- FIXME: this is pretty awful @@ -149,8 +149,8 @@ fetch manager cache (CustomRepositoriesData customFullRepositories singlePackage Right registries -> do let path = Stuff.registry cache let registry = Map.fromList registries - File.writeBinary path (zelmRegistriesFromRegistriesMap registry) - pure $ Right (zelmRegistriesFromRegistriesMap registry) + File.writeBinary path (zokkaRegistriesFromRegistriesMap registry) + pure $ Right (zokkaRegistriesFromRegistriesMap registry) createRegistryFromSinglePackageLocation :: SinglePackageLocationData -> Registry @@ -199,10 +199,10 @@ allPkgsDecoder = -- UPDATE -update :: Http.Manager -> Stuff.ZelmSpecificCache -> ZelmRegistries -> IO (Either Exit.RegistryProblem ZelmRegistries) -update manager cache zelmRegistries = +update :: Http.Manager -> Stuff.ZokkaSpecificCache -> ZokkaRegistries -> IO (Either Exit.RegistryProblem ZokkaRegistries) +update manager cache zokkaRegistries = do - let registriesMap = _registries zelmRegistries + let registriesMap = _registries zokkaRegistries let listOfProblemsOrKeyRegistryPairs = traverse (\(k, v) -> fmap (fmap ((,) k)) (updateSingleRegistry manager k v)) (Map.toList registriesMap) newRegistryOrError <- sequence <$> listOfProblemsOrKeyRegistryPairs let newRegistryOrError' = fmap Map.fromList newRegistryOrError @@ -211,9 +211,9 @@ update manager cache zelmRegistries = Right newRegistry -> do -- FIXME: There's gotta be a faster way of doing this - let newZelmRegistries = zelmRegistriesFromRegistriesMap newRegistry - _ <- File.writeBinary (Stuff.registry cache) newZelmRegistries - pure $ Right newZelmRegistries + let newZokkaRegistries = zokkaRegistriesFromRegistriesMap newRegistry + _ <- File.writeBinary (Stuff.registry cache) newZokkaRegistries + pure $ Right newZokkaRegistries -- = RepositoryUrlKey RepositoryUrl @@ -292,13 +292,13 @@ customSingleRepositoryDataToRegistryKey CustomSingleRepositoryData{_repositoryUr singlePackageLocationDataToRegistryKey :: SinglePackageLocationData -> RegistryKey singlePackageLocationDataToRegistryKey SinglePackageLocationData{_url=url}= PackageUrlKey url -doesRegistryAgreeWithCustomRepositoriesData :: CustomRepositoriesData -> ZelmRegistries -> Bool +doesRegistryAgreeWithCustomRepositoriesData :: CustomRepositoriesData -> ZokkaRegistries -> Bool doesRegistryAgreeWithCustomRepositoriesData (CustomRepositoriesData fullRepositories singlePackages) registry = Set.fromList allRegistryKeys == Map.keysSet (_registries registry) where allRegistryKeys = (customSingleRepositoryDataToRegistryKey <$> fullRepositories) ++ (singlePackageLocationDataToRegistryKey <$> singlePackages) -latest :: Http.Manager -> CustomRepositoriesData -> Stuff.ZelmSpecificCache -> IO (Either Exit.RegistryProblem ZelmRegistries) +latest :: Http.Manager -> CustomRepositoriesData -> Stuff.ZokkaSpecificCache -> IO (Either Exit.RegistryProblem ZokkaRegistries) latest manager customRepositoriesData cache = do maybeOldRegistry <- read cache @@ -324,19 +324,19 @@ versionsToKnownVersions :: [V.Version] -> Maybe KnownVersions versionsToKnownVersions = foldr (\v acc -> Just $ compareVersionToKnownVersions v acc) Nothing -getVersions :: Pkg.Name -> ZelmRegistries -> Maybe KnownVersions -getVersions name ZelmRegistries{_packagesToLocations=packagesToLocations} = +getVersions :: Pkg.Name -> ZokkaRegistries -> Maybe KnownVersions +getVersions name ZokkaRegistries{_packagesToLocations=packagesToLocations} = do versionsMap <- Map.lookup name packagesToLocations let versions = Map.keys versionsMap versionsToKnownVersions versions -getVersions' :: Pkg.Name -> ZelmRegistries -> Either [Pkg.Name] KnownVersions -getVersions' name zelmRegistry = - case getVersions name zelmRegistry of +getVersions' :: Pkg.Name -> ZokkaRegistries -> Either [Pkg.Name] KnownVersions +getVersions' name zokkaRegistry = + case getVersions name zokkaRegistry of Just kvs -> Right kvs -- FIXME: Maybe a faster way than just brute-force merging? - Nothing -> Left $ Pkg.nearbyNames name (Map.keys (_versions $ mergeRegistries zelmRegistry)) + Nothing -> Left $ Pkg.nearbyNames name (Map.keys (_versions $ mergeRegistries zokkaRegistry)) @@ -391,12 +391,12 @@ instance Binary KnownVersions where put (KnownVersions a b) = put a >> put b -instance Binary ZelmRegistries where +instance Binary ZokkaRegistries where get = do registries <- get :: Get (Map.Map RegistryKey Registry) packagesToLocations <- get :: Get (Map.Map Pkg.Name (Map.Map V.Version RegistryKey)) - pure $ ZelmRegistries{_registries=registries, _packagesToLocations=packagesToLocations} + pure $ ZokkaRegistries{_registries=registries, _packagesToLocations=packagesToLocations} - put (ZelmRegistries registries packagesToLocations) = do + put (ZokkaRegistries registries packagesToLocations) = do put registries put packagesToLocations \ No newline at end of file diff --git a/builder/src/Deps/Solver.hs b/builder/src/Deps/Solver.hs index 4a6d598d8..1ddc9f124 100644 --- a/builder/src/Deps/Solver.hs +++ b/builder/src/Deps/Solver.hs @@ -39,7 +39,7 @@ import Elm.CustomRepositoryData (CustomRepositoriesData, customRepostoriesDataDe import Data.Maybe (fromJust) import Deps.CustomRepositoryDataIO (loadCustomRepositoriesData, loadCustomRepositoriesDataForReactorTH) import Reporting.Exit (RegistryProblem(..)) -import Stuff (ZelmCustomRepositoryConfigFilePath(unZelmCustomRepositoryConfigFilePath), zelmCacheToFilePath) +import Stuff (ZokkaCustomRepositoryConfigFilePath(unZokkaCustomRepositoryConfigFilePath), zokkaCacheToFilePath) import qualified Data.Utf8 as Utf8 import Logging.Logger (printLog) import File (getTime) @@ -65,7 +65,7 @@ data State = State { _cache :: Stuff.PackageCache , _connection :: Connection - , _registry :: Registry.ZelmRegistries + , _registry :: Registry.ZokkaRegistries , _constraints :: Map.Map (Pkg.Name, V.Version) Constraints } @@ -102,7 +102,7 @@ data Details = deriving Show -verify :: Stuff.PackageCache -> Connection -> Registry.ZelmRegistries -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details)) +verify :: Stuff.PackageCache -> Connection -> Registry.ZokkaRegistries -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details)) verify cache connection registry constraints = Stuff.withRegistryLock cache $ case try constraints of @@ -139,7 +139,7 @@ data AppSolution = } -addToApp :: Stuff.PackageCache -> Connection -> Registry.ZelmRegistries -> Pkg.Name -> Outline.AppOutline -> IO (Result AppSolution) +addToApp :: Stuff.PackageCache -> Connection -> Registry.ZokkaRegistries -> Pkg.Name -> Outline.AppOutline -> IO (Result AppSolution) addToApp cache connection registry pkg outline@(Outline.AppOutline _ _ direct indirect testDirect testIndirect _) = Stuff.withRegistryLock cache $ let @@ -393,7 +393,7 @@ constraintsDecoder = data Env = - Env Stuff.PackageCache Http.Manager Connection Registry.ZelmRegistries Stuff.PackageOverridesCache + Env Stuff.PackageCache Http.Manager Connection Registry.ZokkaRegistries Stuff.PackageOverridesCache initEnv :: IO (Either Exit.RegistryProblem Env) @@ -402,19 +402,19 @@ initEnv = _ <- forkIO $ putMVar mvar =<< Http.getManager cache <- Stuff.getPackageCache packageOverridesCache <- Stuff.getPackageOverridesCache - zelmCache <- Stuff.getZelmCache - customRepositoriesConfigLocation <- Stuff.getOrCreateZelmCustomRepositoryConfig + zokkaCache <- Stuff.getZokkaCache + customRepositoriesConfigLocation <- Stuff.getOrCreateZokkaCustomRepositoryConfig customRepositoriesDataOrErr <- loadCustomRepositoriesData customRepositoriesConfigLocation case customRepositoriesDataOrErr of - Left err -> pure $ Left (RP_BadCustomReposData err (unZelmCustomRepositoryConfigFilePath customRepositoriesConfigLocation)) + Left err -> pure $ Left (RP_BadCustomReposData err (unZokkaCustomRepositoryConfigFilePath customRepositoriesConfigLocation)) Right customRepositoriesData -> Stuff.withRegistryLock cache $ - do maybeRegistry <- Registry.read zelmCache + do maybeRegistry <- Registry.read zokkaCache manager <- readMVar mvar case maybeRegistry of Nothing -> - do eitherRegistry <- Registry.fetch manager zelmCache customRepositoriesData + do eitherRegistry <- Registry.fetch manager zokkaCache customRepositoriesData case eitherRegistry of Right latestRegistry -> return $ Right $ Env cache manager (Online manager) latestRegistry packageOverridesCache @@ -423,12 +423,12 @@ initEnv = return $ Left $ problem Just cachedRegistry -> - do modifiedTimeOfZelmCache <- getTime (zelmCacheToFilePath zelmCache) + do modifiedTimeOfZokkaCache <- getTime (zokkaCacheToFilePath zokkaCache) -- FIXME: Think about whether I need a lock on the custom repository JSON file as well - modifiedTimeOfCustomRepositoriesData <- getTime (unZelmCustomRepositoryConfigFilePath customRepositoriesConfigLocation) - eitherRegistry <- if modifiedTimeOfZelmCache == modifiedTimeOfCustomRepositoriesData - then Registry.update manager zelmCache cachedRegistry - else Registry.fetch manager zelmCache customRepositoriesData + modifiedTimeOfCustomRepositoriesData <- getTime (unZokkaCustomRepositoryConfigFilePath customRepositoriesConfigLocation) + eitherRegistry <- if modifiedTimeOfZokkaCache == modifiedTimeOfCustomRepositoriesData + then Registry.update manager zokkaCache cachedRegistry + else Registry.fetch manager zokkaCache customRepositoriesData case eitherRegistry of Right latestRegistry -> return $ Right $ Env cache manager (Online manager) latestRegistry packageOverridesCache @@ -442,19 +442,19 @@ initEnvForReactorTH = _ <- forkIO $ putMVar mvar =<< Http.getManager cache <- Stuff.getPackageCache packageOverridesCache <- Stuff.getPackageOverridesCache - zelmCache <- Stuff.getZelmCache - customRepositoriesConfigLocation <- Stuff.getOrCreateZelmCustomRepositoryConfig + zokkaCache <- Stuff.getZokkaCache + customRepositoriesConfigLocation <- Stuff.getOrCreateZokkaCustomRepositoryConfig customRepositoriesDataOrErr <- loadCustomRepositoriesDataForReactorTH customRepositoriesConfigLocation case customRepositoriesDataOrErr of - Left err -> pure $ Left (RP_BadCustomReposData err (unZelmCustomRepositoryConfigFilePath customRepositoriesConfigLocation)) + Left err -> pure $ Left (RP_BadCustomReposData err (unZokkaCustomRepositoryConfigFilePath customRepositoriesConfigLocation)) Right customRepositoriesData -> Stuff.withRegistryLock cache $ - do maybeRegistry <- Registry.read zelmCache + do maybeRegistry <- Registry.read zokkaCache manager <- readMVar mvar case maybeRegistry of Nothing -> - do eitherRegistry <- Registry.fetch manager zelmCache customRepositoriesData + do eitherRegistry <- Registry.fetch manager zokkaCache customRepositoriesData case eitherRegistry of Right latestRegistry -> return $ Right $ Env cache manager (Online manager) latestRegistry packageOverridesCache @@ -463,7 +463,7 @@ initEnvForReactorTH = return $ Left $ problem Just cachedRegistry -> - do eitherRegistry <- Registry.update manager zelmCache cachedRegistry + do eitherRegistry <- Registry.update manager zokkaCache cachedRegistry case eitherRegistry of Right latestRegistry -> return $ Right $ Env cache manager (Online manager) latestRegistry packageOverridesCache diff --git a/builder/src/Elm/CustomRepositoryData.hs b/builder/src/Elm/CustomRepositoryData.hs index 16cdda902..1f0255b13 100644 --- a/builder/src/Elm/CustomRepositoryData.hs +++ b/builder/src/Elm/CustomRepositoryData.hs @@ -64,7 +64,7 @@ lookupRepositoryType :: Json.String -> Either [Json.String] RepositoryType lookupRepositoryType rawTypeStr = case Map.lookup rawTypeStr allRepositoryTypesLookupMap of Just repositoryType -> Right repositoryType - -- FIXME: See https://github.com/changlinli/zelm-compiler/issues/1 + -- FIXME: See https://github.com/changlinli/zokka-compiler/issues/1 Nothing -> Left allRepositoryTypeStrings repositoryTypeDecoder :: (Json.String -> [Json.String] -> e) -> D.Decoder e RepositoryType @@ -120,10 +120,10 @@ standardElmRepository = CustomSingleRepositoryData , _repositoryUrl = Utf8.fromChars "https://package.elm-lang.org" } -standardZelmRepository :: CustomSingleRepositoryData -standardZelmRepository = CustomSingleRepositoryData +standardZokkaRepository :: CustomSingleRepositoryData +standardZokkaRepository = CustomSingleRepositoryData { _repositoryType = DefaultPackageServer - , _repositoryUrl = Utf8.fromChars "https://package-server.zelm-lang.com" + , _repositoryUrl = Utf8.fromChars "https://package-server.zokka-lang.com" } customSingleRepositoryDataDecoder :: D.Decoder CustomRepositoryDataParseError CustomSingleRepositoryData @@ -254,7 +254,7 @@ defaultCustomRepositoriesData :: CustomRepositoriesData defaultCustomRepositoriesData = CustomRepositoriesData { _customFullRepositories = [ standardElmRepository - , standardZelmRepository + , standardZokkaRepository ] , _customSinglePackageRepositories = [] } diff --git a/builder/src/Elm/Details.hs b/builder/src/Elm/Details.hs index 3e05be2e9..279ff6c3c 100644 --- a/builder/src/Elm/Details.hs +++ b/builder/src/Elm/Details.hs @@ -62,7 +62,7 @@ import qualified Stuff import Elm.PackageOverrideData (PackageOverrideData(..)) import Data.Function ((&)) import Data.Map ((!)) -import Deps.Registry (ZelmRegistries) +import Deps.Registry (ZokkaRegistries) import Elm.CustomRepositoryData (RepositoryUrl, PackageUrl) import Control.Exception (SomeException, catches, Handler (..), BlockedIndefinitelyOnMVar (BlockedIndefinitelyOnMVar), throwIO, Exception) import qualified Reporting.Annotation as Report.Annotation @@ -257,7 +257,7 @@ data Env = , _cache :: Stuff.PackageCache , _manager :: Http.Manager , _connection :: Solver.Connection - , _registry :: Registry.ZelmRegistries + , _registry :: Registry.ZokkaRegistries , _packageOverridesCache :: Stuff.PackageOverridesCache } @@ -415,7 +415,7 @@ genericErrorHandler msg action = -- VERIFY DEPENDENCIES verifyDependencies :: Env -> File.Time -> ValidOutline -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name a -> Map.Map Pkg.Name (Pkg.Name, V.Version) -> Task Details -verifyDependencies (Env key scope root cache manager _ zelmRegistries packageOverridesCache) time outline solution directDeps originalPkgToOverridingPkg = +verifyDependencies (Env key scope root cache manager _ zokkaRegistries packageOverridesCache) time outline solution directDeps originalPkgToOverridingPkg = let generateBuildData :: Pkg.Name -> V.Version -> BuildData generateBuildData pkgName pkgVersion = case Map.lookup pkgName originalPkgToOverridingPkg of @@ -444,7 +444,7 @@ verifyDependencies (Env key scope root cache manager _ zelmRegistries packageOve printLog "Made it to VERIFYDEPENDENCIES 1" printLog ("SOLUTION: " ++ show solution) mvars <- Stuff.withRegistryLock cache $ - Map.traverseWithKey (\k details -> fork (verifyDep key (generateBuildData k (extractVersionFromDetails details)) manager zelmRegistries mvar solution (extractConstraintsFromDetails details))) solution + Map.traverseWithKey (\k details -> fork (verifyDep key (generateBuildData k (extractVersionFromDetails details)) manager zokkaRegistries mvar solution (extractConstraintsFromDetails details))) solution printLog ("Made it to VERIFYDEPENDENCIES 2: " ++ show (Map.keys mvars)) putMVar mvar mvars printLog "Made it to VERIFYDEPENDENCIES 3" @@ -509,8 +509,8 @@ type Dep = Either (Maybe Exit.DetailsBadDep) Artifacts -verifyDep :: Reporting.DKey -> BuildData -> Http.Manager -> ZelmRegistries -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name C.Constraint -> IO Dep -verifyDep key buildData manager zelmRegistry depsMVar solution directDeps = +verifyDep :: Reporting.DKey -> BuildData -> Http.Manager -> ZokkaRegistries -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name C.Constraint -> IO Dep +verifyDep key buildData manager zokkaRegistry depsMVar solution directDeps = let fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps cacheFilePath = cacheFilePathFromBuildData buildData @@ -522,7 +522,7 @@ verifyDep key buildData manager zelmRegistry depsMVar solution directDeps = BuildWithOverridingPackage (OverridingPackageBuildData {_overridingPkg=overridingPkg, _overridingPkgVersion=overridingPkgVer}) -> (overridingPkg, overridingPkgVer) - downloadPackageAction = downloadPackageToFilePath cacheFilePath zelmRegistry manager primaryPkg primaryPkgVersion + downloadPackageAction = downloadPackageToFilePath cacheFilePath zokkaRegistry manager primaryPkg primaryPkgVersion in do exists <- Dir.doesDirectoryExist cacheFilePath printLog (show exists ++ "A0" ++ cacheFilePath) @@ -542,7 +542,7 @@ verifyDep key buildData manager zelmRegistry depsMVar solution directDeps = else do Reporting.report key Reporting.DRequested -- Normally we don't need to create the directory because it's created during the - -- constraint solving process (to put an elm.json there), but in Zelm's case we + -- constraint solving process (to put an elm.json there), but in Zokka's case we -- might be looking at a dependency that showed up after the constraint solving -- process was completed via an override, so the directory might not actually exist, -- so we better create it here just in case. @@ -553,9 +553,9 @@ verifyDep key buildData manager zelmRegistry depsMVar solution directDeps = -- Also the reason we don't shift overrides to happen during constraint solving is -- that we want to eventually in the future download both the original package -- and the package that is being used to override the original, both to help with - -- Elm IDE integrations (which may be unaware of Zelm and so we still want to + -- Elm IDE integrations (which may be unaware of Zokka and so we still want to -- support click-to-definition, which is usually based on the cache, even if the - -- integration is unaware of Zelm overrides) and to help with error messages, where + -- integration is unaware of Zokka overrides) and to help with error messages, where -- we can rigorously check that the APIs of the original package and the override -- match. So we want to make sure that we keep the information about what original -- package was used around and we want that to drive the constraint process in @@ -1010,9 +1010,9 @@ toDocs result = -- DOWNLOAD PACKAGE -downloadPackage :: Stuff.PackageCache -> ZelmRegistries -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.PackageProblem ()) -downloadPackage cache zelmRegistries manager pkg vsn = - case Registry.lookupPackageRegistryKey zelmRegistries pkg vsn of +downloadPackage :: Stuff.PackageCache -> ZokkaRegistries -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.PackageProblem ()) +downloadPackage cache zokkaRegistries manager pkg vsn = + case Registry.lookupPackageRegistryKey zokkaRegistries pkg vsn of Just (Registry.RepositoryUrlKey repositoryUrl) -> do exists <- Dir.doesDirectoryExist (Stuff.package cache pkg vsn) @@ -1026,15 +1026,15 @@ downloadPackage cache zelmRegistries manager pkg vsn = Nothing -> let --FIXME - blah = fmap show (Map.keys $ Registry._registries zelmRegistries) + blah = fmap show (Map.keys $ Registry._registries zokkaRegistries) in pure (Left $ Exit.PP_PackageNotInRegistry blah pkg vsn) -- FIXME: reduce duplication with downloadPackage -downloadPackageToFilePath :: FilePath -> ZelmRegistries -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.PackageProblem ()) -downloadPackageToFilePath filePath zelmRegistries manager pkg vsn = - case Registry.lookupPackageRegistryKey zelmRegistries pkg vsn of +downloadPackageToFilePath :: FilePath -> ZokkaRegistries -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.PackageProblem ()) +downloadPackageToFilePath filePath zokkaRegistries manager pkg vsn = + case Registry.lookupPackageRegistryKey zokkaRegistries pkg vsn of Just (Registry.RepositoryUrlKey repositoryUrl) -> do exists <- Dir.doesDirectoryExist filePath @@ -1048,7 +1048,7 @@ downloadPackageToFilePath filePath zelmRegistries manager pkg vsn = Nothing -> let --FIXME - blah = fmap show (Map.keys $ Registry._registries zelmRegistries) + blah = fmap show (Map.keys $ Registry._registries zokkaRegistries) in pure (Left $ Exit.PP_PackageNotInRegistry blah pkg vsn) diff --git a/builder/src/Elm/Outline.hs b/builder/src/Elm/Outline.hs index d47da5f83..e9e642a12 100644 --- a/builder/src/Elm/Outline.hs +++ b/builder/src/Elm/Outline.hs @@ -62,7 +62,7 @@ data AppOutline = , _app_deps_indirect :: Map.Map Pkg.Name V.Version , _app_test_direct :: Map.Map Pkg.Name V.Version , _app_test_indirect :: Map.Map Pkg.Name V.Version - , _app_zelm_package_overrides :: [PkgOverride.PackageOverrideData] + , _app_zokka_package_overrides :: [PkgOverride.PackageOverrideData] } deriving Show @@ -147,7 +147,7 @@ encode outline = [ "direct" ==> encodeDeps V.encode testDirect , "indirect" ==> encodeDeps V.encode testTrans ] - , "zelm-package-overrides" ==> E.list encodePkgOverride pkgOverrides + , "zokka-package-overrides" ==> E.list encodePkgOverride pkgOverrides ] Pkg (PkgOutline name summary license version exposed deps tests elm) -> @@ -317,7 +317,7 @@ appDecoder = <*> D.field "dependencies" (D.field "indirect" (depsDecoder versionDecoder)) <*> D.field "test-dependencies" (D.field "direct" (depsDecoder versionDecoder)) <*> D.field "test-dependencies" (D.field "indirect" (depsDecoder versionDecoder)) - <*> D.oneOf [ D.field "zelm-package-overrides" (D.list packageOverrideDataDecoder), pure [] ] + <*> D.oneOf [ D.field "zokka-package-overrides" (D.list packageOverrideDataDecoder), pure [] ] pkgDecoder :: Decoder PkgOutline diff --git a/builder/src/Reporting/Exit.hs b/builder/src/Reporting/Exit.hs index 1153069ae..6501874b0 100644 --- a/builder/src/Reporting/Exit.hs +++ b/builder/src/Reporting/Exit.hs @@ -392,9 +392,9 @@ data Publish | PublishZipApplication | PublishZipNoExposed | PublishZipBuildProblem BuildProblem - -- When publishing with Zelm we have to be careful not to publish to the standard + -- When publishing with Zokka we have to be careful not to publish to the standard -- Elm repository so that we don't end up publishing packages that the vanilla Elm compiler cannot handle - | PublishToStandardElmRepositoryUsingZelm + | PublishToStandardElmRepositoryUsingZokka | PublishWithNoRepositoryUrl | PublishCustomRepositoryConfigDataError CustomRepositoriesError @@ -677,15 +677,15 @@ publishToReport publish = PublishZipBuildProblem _ -> badZipReport - PublishToStandardElmRepositoryUsingZelm -> + PublishToStandardElmRepositoryUsingZokka -> Help.report "PUBLISH TO PROHIBITED REPOSITORY" Nothing - "You are trying to use the Zelm compiler to publish to the standard Elm\ + "You are trying to use the Zokka compiler to publish to the standard Elm\ \ repository (package.elm-lang.org). This is prohibited!" [ D.reflow $ "The standard Elm package repository is used by other Elm developers\ - \ who may not be using the Zelm compiler. Because the Zelm compiler\ + \ who may not be using the Zokka compiler. Because the Zokka compiler\ \ fixes some compiler crashes in the Elm compiler, if you publish a\ - \ package that compiled crash-free with Zelm to the standard Elm \ + \ package that compiled crash-free with Zokka to the standard Elm \ \ repository, another Elm developer could try to use that package and\ \ would be faced with a mysterious compiler crash." , D.reflow $ @@ -694,23 +694,23 @@ publishToReport publish = \ have access to that repository and so the package could also fail to\ \ build for that reason." , D.reflow $ - "Zelm therefore prohibits publishing to the standard Elm repository to\ + "Zokka therefore prohibits publishing to the standard Elm repository to\ \ preserve the integrity of the standard Elm package repository for other Elm developers." , D.toSimpleNote $ "As long as none of your dependencies come from a custom package\ - \ repository you can still develop with Zelm and then use the standard\ + \ repository you can still develop with Zokka and then use the standard\ \ Elm compiler at the last moment to publish!" ] PublishWithNoRepositoryUrl -> Help.report "PUBLISH WITH NO REPOSITORY URL" Nothing - "When publishing with Zelm you must provide a repository URL as an argument. For example:" + "When publishing with Zokka you must provide a repository URL as an argument. For example:" [ D.vcat - [ D.indent 4 $ D.green "zelm publish https://package.zelm-lang.org" - , D.indent 4 $ D.green "zelm publish https://example.com/my-custom-repository" + [ D.indent 4 $ D.green "zokka publish https://package.zokka-lang.org" + , D.indent 4 $ D.green "zokka publish https://example.com/my-custom-repository" ] , D.reflow $ - "This is different from the standard Elm publish command because Zelm allows for\ + "This is different from the standard Elm publish command because Zokka allows for\ \ custom repositories, which means when publishing you have to specify where to publish!" ] @@ -1133,7 +1133,7 @@ toOutlineReport problem = OutlinePkgOverridesDoNotMatchDeps packageName packageVersion -> Help.report "BAD PACKAGE OVERRIDE" (Just "elm.json") - "Package overrides in zelm-package-overrides need to override versions of packages \ + "Package overrides in zokka-package-overrides need to override versions of packages \ \ that actually are used in your direct or indirect dependencies! You are attempting \ \ to override " [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars packageName ++ " " ++ V.toChars packageVersion diff --git a/builder/src/Stuff.hs b/builder/src/Stuff.hs index 12f2cfcd3..c61ffdfba 100644 --- a/builder/src/Stuff.hs +++ b/builder/src/Stuff.hs @@ -11,20 +11,20 @@ module Stuff , withRootLock , withRegistryLock , PackageCache - , ZelmSpecificCache + , ZokkaSpecificCache , PackageOverridesCache , getPackageCache - , getZelmCache + , getZokkaCache , getPackageOverridesCache , registry , package , packageOverride , getReplCache , getElmHome - , getOrCreateZelmCustomRepositoryConfig - , getOrCreateZelmCacheDir - , ZelmCustomRepositoryConfigFilePath(..) - , zelmCacheToFilePath + , getOrCreateZokkaCustomRepositoryConfig + , getOrCreateZokkaCacheDir + , ZokkaCustomRepositoryConfigFilePath(..) + , zokkaCacheToFilePath ) where @@ -46,25 +46,25 @@ import qualified Elm.Version as V stuff :: FilePath -> FilePath stuff root = - -- We use zelm-stuff instead of elm-stuff because this gets around an edge + -- We use zokka-stuff instead of elm-stuff because this gets around an edge -- case where the compiler checks the timestamp of the stuff directory vs -- elm.json to decide whether any re-building is necessary and this can mean - -- that compiling with the Zelm compiler doesn't change any code that was + -- that compiling with the Zokka compiler doesn't change any code that was -- compiled by the Elm compiler, even though it probably should. - root "zelm-stuff" customCompilerVersion + root "zokka-stuff" customCompilerVersion where - -- The following comment explains why we originally had compilerVersion ++ -zelm + -- The following comment explains why we originally had compilerVersion ++ -zokka -- under the same elm-stuff. Some of the reasoning there is stil true but not as - -- relevant, because the -zelm suffix is superfluous now that we use - -- zelm-stuff instead of the directory name elm-stuff. + -- relevant, because the -zokka suffix is superfluous now that we use + -- zokka-stuff instead of the directory name elm-stuff. -- - -- We need a custom compiler version because of Zelm's support for dependency + -- We need a custom compiler version because of Zokka's support for dependency -- overrides. If we override dependencies, we could end up with what appears to -- be an invalid cache for the vanilla Elm compiler, because we will have -- resolved a different set of dependencies than what the vanilla Elm compiler -- would have, which can result in interface files that do not correspond to -- elm.json as the vanilla Elm compiler understands the dependencies from - -- elm.json. This means that an end user who uses Zelm and then tries to revert + -- elm.json. This means that an end user who uses Zokka and then tries to revert -- back to using Elm could observe non-obvious breakage (even though it's -- easily fixable by just deleting the elm-stuff directory), which we are trying -- to minimimze. @@ -73,7 +73,7 @@ stuff root = -- important analyses. If that's not true, then we may revert to using the usual -- compiler version and just letting the user delete elm-stuff manually (the -- error message at least will tell them to delete the directory). - customCompilerVersion = compilerVersion ++ "-zelm" + customCompilerVersion = compilerVersion ++ "-zokka" details :: FilePath -> FilePath @@ -175,7 +175,7 @@ withRegistryLock (PackageCache dir) work = newtype PackageCache = PackageCache FilePath -newtype ZelmSpecificCache = ZelmSpecificCache FilePath +newtype ZokkaSpecificCache = ZokkaSpecificCache FilePath newtype PackageOverridesCache = PackageOverridesCache FilePath @@ -188,22 +188,22 @@ getPackageCache = getPackageOverridesCache :: IO PackageOverridesCache getPackageOverridesCache = do - (ZelmSpecificCache zelmSpecificCache) <- getZelmCache - pure $ PackageOverridesCache zelmSpecificCache + (ZokkaSpecificCache zokkaSpecificCache) <- getZokkaCache + pure $ PackageOverridesCache zokkaSpecificCache -zelmCacheToFilePath :: ZelmSpecificCache -> FilePath -zelmCacheToFilePath (ZelmSpecificCache filePath) = filePath +zokkaCacheToFilePath :: ZokkaSpecificCache -> FilePath +zokkaCacheToFilePath (ZokkaSpecificCache filePath) = filePath -getZelmCache :: IO ZelmSpecificCache -getZelmCache = - ZelmSpecificCache <$> getOrCreateZelmCacheDir +getZokkaCache :: IO ZokkaSpecificCache +getZokkaCache = + ZokkaSpecificCache <$> getOrCreateZokkaCacheDir -registry :: ZelmSpecificCache -> FilePath -registry (ZelmSpecificCache dir) = - dir "zelm-registry.dat" +registry :: ZokkaSpecificCache -> FilePath +registry (ZokkaSpecificCache dir) = + dir "zokka-registry.dat" package :: PackageCache -> Pkg.Name -> V.Version -> FilePath @@ -241,26 +241,26 @@ getElmHome = Nothing -> Dir.getAppUserDataDirectory "elm" --- The Zelm cache directory contains the Zelm-specific registry file, while the --- Zelm directory proper contains the custom repository configuration (and hence +-- The Zokka cache directory contains the Zokka-specific registry file, while the +-- Zokka directory proper contains the custom repository configuration (and hence -- is a bit more valuable than just the cache). -getOrCreateZelmCacheDir :: IO FilePath -getOrCreateZelmCacheDir = do - cacheDir <- getCacheDir "zelm-cache" +getOrCreateZokkaCacheDir :: IO FilePath +getOrCreateZokkaCacheDir = do + cacheDir <- getCacheDir "zokka-cache" Dir.createDirectoryIfMissing True cacheDir pure cacheDir -getZelmDir :: IO FilePath -getZelmDir = getCacheDir "zelm" +getZokkaDir :: IO FilePath +getZokkaDir = getCacheDir "zokka" -newtype ZelmCustomRepositoryConfigFilePath = ZelmCustomRepositoryConfigFilePath { unZelmCustomRepositoryConfigFilePath :: FilePath } +newtype ZokkaCustomRepositoryConfigFilePath = ZokkaCustomRepositoryConfigFilePath { unZokkaCustomRepositoryConfigFilePath :: FilePath } -getOrCreateZelmCustomRepositoryConfig :: IO ZelmCustomRepositoryConfigFilePath -getOrCreateZelmCustomRepositoryConfig = +getOrCreateZokkaCustomRepositoryConfig :: IO ZokkaCustomRepositoryConfigFilePath +getOrCreateZokkaCustomRepositoryConfig = do - zelmDir <- getZelmDir - Dir.createDirectoryIfMissing True zelmDir - pure $ ZelmCustomRepositoryConfigFilePath (zelmDir "custom-package-repository-config.json") + zokkaDir <- getZokkaDir + Dir.createDirectoryIfMissing True zokkaDir + pure $ ZokkaCustomRepositoryConfigFilePath (zokkaDir "custom-package-repository-config.json") diff --git a/compiler/src/Elm/Package.hs b/compiler/src/Elm/Package.hs index f73bff4a4..ca0a8f8c6 100644 --- a/compiler/src/Elm/Package.hs +++ b/compiler/src/Elm/Package.hs @@ -12,7 +12,7 @@ module Elm.Package , toFilePath , toJsonString -- - , dummyName, kernel, core, zelmCore + , dummyName, kernel, core, zokkaCore , browser, virtualDom, html , json, http, url , webgl, linearAlgebra @@ -83,11 +83,11 @@ data Canonical = isKernel :: Name -> Bool isKernel (Name author _) = - author == elm || author == elm_explorations || author == zelm || author == zelm_explorations + author == elm || author == elm_explorations || author == zokka || author == zokka_explorations -- FIXME: Need to think about how to make this better isCore :: Name -> Bool -isCore name = name == core || name == zelmCore +isCore name = name == core || name == zokkaCore toChars :: Name -> String @@ -136,9 +136,9 @@ core :: Name core = toName elm "core" -zelmCore :: Name -zelmCore = - toName zelm "core-1-0" +zokkaCore :: Name +zokkaCore = + toName zokka "core-1-0" {-# NOINLINE browser #-} @@ -195,10 +195,10 @@ elm = Utf8.fromChars "elm" -{-# NOINLINE zelm #-} -zelm :: Author -zelm = - Utf8.fromChars "zelm" +{-# NOINLINE zokka #-} +zokka :: Author +zokka = + Utf8.fromChars "zokka" {-# NOINLINE elm_explorations #-} @@ -207,10 +207,10 @@ elm_explorations = Utf8.fromChars "elm-explorations" -{-# NOINLINE zelm_explorations #-} -zelm_explorations :: Author -zelm_explorations = - Utf8.fromChars "zelm-explorations" +{-# NOINLINE zokka_explorations #-} +zokka_explorations :: Author +zokka_explorations = + Utf8.fromChars "zokka-explorations" @@ -265,7 +265,7 @@ nearbyNames (Name author1 project1) possibleNames = authorDistance :: [Char] -> Author -> Int authorDistance given possibility = - if possibility == elm || possibility == elm_explorations || possibility == zelm || possibility == zelm_explorations + if possibility == elm || possibility == elm_explorations || possibility == zokka || possibility == zokka_explorations then 0 else abs (Suggest.distance given (Utf8.toChars possibility)) diff --git a/terminal/impl/Terminal/Helpers.hs b/terminal/impl/Terminal/Helpers.hs index b92afc929..b6d324441 100644 --- a/terminal/impl/Terminal/Helpers.hs +++ b/terminal/impl/Terminal/Helpers.hs @@ -87,7 +87,7 @@ parseRepositoryUrl :: String -> Maybe RepositoryUrl parseRepositoryUrl str = Just $ Utf8.fromChars str exampleRepositoryUrls :: String -> IO [String] -exampleRepositoryUrls _ = pure ["https://package-server.zelm-lang.com", "https://www.example.com/my-package"] +exampleRepositoryUrls _ = pure ["https://package-server.zokka-lang.com", "https://www.example.com/my-package"] -- ELM FILE @@ -141,7 +141,7 @@ parsePackage chars = suggestPackages :: String -> IO [String] suggestPackages given = - do cache <- Stuff.getZelmCache + do cache <- Stuff.getZokkaCache maybeRegistry <- Registry.read cache let mergedRegistries = fmap Registry.mergeRegistries maybeRegistry return $ @@ -156,7 +156,7 @@ suggestPackages given = examplePackages :: String -> IO [String] examplePackages given = - do cache <- Stuff.getZelmCache + do cache <- Stuff.getZokkaCache maybeRegistry <- Registry.read cache let mergedRegistries = fmap Registry.mergeRegistries maybeRegistry return $ diff --git a/terminal/src/Bump.hs b/terminal/src/Bump.hs index 7a4a076e7..3c0fdb34d 100644 --- a/terminal/src/Bump.hs +++ b/terminal/src/Bump.hs @@ -49,7 +49,7 @@ data Env = { _root :: FilePath , _cache :: Stuff.PackageCache , _manager :: Http.Manager - , _registry :: Registry.ZelmRegistries + , _registry :: Registry.ZokkaRegistries , _outline :: Outline.PkgOutline } @@ -63,11 +63,11 @@ getEnv = Just root -> do cache <- Task.io $ Stuff.getPackageCache - zelmCache <- Task.io $ Stuff.getZelmCache + zokkaCache <- Task.io $ Stuff.getZokkaCache manager <- Task.io $ Http.getManager - reposConfigLocation <- Task.io $ Stuff.getOrCreateZelmCustomRepositoryConfig + reposConfigLocation <- Task.io $ Stuff.getOrCreateZokkaCustomRepositoryConfig customReposData <- Task.eio BumpCustomRepositoryDataProblem $ loadCustomRepositoriesData reposConfigLocation - registry <- Task.eio Exit.BumpMustHaveLatestRegistry $ Registry.latest manager customReposData zelmCache + registry <- Task.eio Exit.BumpMustHaveLatestRegistry $ Registry.latest manager customReposData zokkaCache outline <- Task.eio Exit.BumpBadOutline $ Outline.read root case outline of Outline.App _ -> diff --git a/terminal/src/Diff.hs b/terminal/src/Diff.hs index b98b44e76..1dafcc95b 100644 --- a/terminal/src/Diff.hs +++ b/terminal/src/Diff.hs @@ -65,7 +65,7 @@ data Env = { _maybeRoot :: Maybe FilePath , _cache :: Stuff.PackageCache , _manager :: Http.Manager - , _registry :: Registry.ZelmRegistries + , _registry :: Registry.ZokkaRegistries } @@ -73,11 +73,11 @@ getEnv :: Task Env getEnv = do maybeRoot <- Task.io $ Stuff.findRoot cache <- Task.io $ Stuff.getPackageCache - zelmCache <- Task.io $ Stuff.getZelmCache + zokkaCache <- Task.io $ Stuff.getZokkaCache manager <- Task.io $ Http.getManager - reposConf <- Task.io $ Stuff.getOrCreateZelmCustomRepositoryConfig + reposConf <- Task.io $ Stuff.getOrCreateZokkaCustomRepositoryConfig reposData <- Task.eio Exit.DiffCustomReposDataProblem $ loadCustomRepositoriesData reposConf - registry <- Task.eio Exit.DiffMustHaveLatestRegistry $ Registry.latest manager reposData zelmCache + registry <- Task.eio Exit.DiffMustHaveLatestRegistry $ Registry.latest manager reposData zokkaCache return (Env maybeRoot cache manager registry) diff --git a/terminal/src/Main.hs b/terminal/src/Main.hs index 468648c0c..7cc1ba4af 100644 --- a/terminal/src/Main.hs +++ b/terminal/src/Main.hs @@ -195,7 +195,7 @@ make = |-- 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 "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." - |-- onOff "verbose" "Turn on verbose logging when compiling. Useful for debugging errors in the Zelm compiler itself." + |-- onOff "verbose" "Turn on verbose logging when compiling. Useful for debugging errors in the Zokka compiler itself." in Terminal.Command "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run @@ -252,7 +252,7 @@ publish = [ reflow "For example, if you have a custom repository located at https://www.example.com/my-custom-repo you can run the following command" , P.indent 4 $ P.green $ P.vcat $ - [ "zelm publish https://www.example.com/my-custom-repo" + [ "zokka publish https://www.example.com/my-custom-repo" ] ] diff --git a/terminal/src/Publish.hs b/terminal/src/Publish.hs index d42ebb1bb..9dd5d418b 100644 --- a/terminal/src/Publish.hs +++ b/terminal/src/Publish.hs @@ -79,7 +79,7 @@ data Env = { _root :: FilePath , _cache :: Stuff.PackageCache , _manager :: Http.Manager - , _registry :: Registry.ZelmRegistries + , _registry :: Registry.ZokkaRegistries , _outline :: Outline.Outline } @@ -88,13 +88,13 @@ getEnv :: Task.Task Exit.Publish Env getEnv = do root <- Task.mio Exit.PublishNoOutline $ Stuff.findRoot cache <- Task.io $ Stuff.getPackageCache - zelmCache <- Task.io $ Stuff.getZelmCache + zokkaCache <- Task.io $ Stuff.getZokkaCache manager <- Task.io $ Http.getManager - reposConfigLocation <- Task.io $ Stuff.getOrCreateZelmCustomRepositoryConfig + reposConfigLocation <- Task.io $ Stuff.getOrCreateZokkaCustomRepositoryConfig customReposData <- Task.eio PublishCustomRepositoryConfigDataError $ loadCustomRepositoriesData reposConfigLocation - zelmRegistries <- Task.eio Exit.PublishMustHaveLatestRegistry $ Registry.latest manager customReposData zelmCache + zokkaRegistries <- Task.eio Exit.PublishMustHaveLatestRegistry $ Registry.latest manager customReposData zokkaCache outline <- Task.eio Exit.PublishBadOutline $ Outline.read root - return $ Env root cache manager zelmRegistries outline + return $ Env root cache manager zokkaRegistries outline @@ -110,7 +110,7 @@ publish env@(Env root _ manager registry outline) repositoryUrl = Outline.Pkg (Outline.PkgOutline pkg summary _ vsn exposed _ _ _) -> if Utf8.toChars standardElmPkgRepoDomain `isInfixOf` Utf8.toChars repositoryUrl then - Task.throw Exit.PublishToStandardElmRepositoryUsingZelm + Task.throw Exit.PublishToStandardElmRepositoryUsingZokka else do let maybeKnownVersions = Registry.getVersions pkg registry diff --git a/tests/TestMain.hs b/tests/TestMain.hs index 1428f3d91..b6606b79f 100644 --- a/tests/TestMain.hs +++ b/tests/TestMain.hs @@ -11,7 +11,7 @@ import Data.Function ((&)) import Hedgehog ((===)) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) -import Deps.Registry (ZelmRegistries (..), RegistryKey(..), Registry(..), KnownVersions(..)) +import Deps.Registry (ZokkaRegistries (..), RegistryKey(..), Registry(..), KnownVersions(..)) import qualified Data.Binary as Binary import qualified Data.Utf8 import qualified Data.Utf8 as Utf8 @@ -64,11 +64,11 @@ pkgNameGen = do packagesToLocationsGen :: Hedgehog.Gen (Map.Map Pkg.Name (Map.Map V.Version RegistryKey)) packagesToLocationsGen = Gen.map (Range.linear 0 10) ((,) <$> pkgNameGen <*> versionToRegistryKeyGen) -zelmRegistriesGen :: Hedgehog.Gen ZelmRegistries -zelmRegistriesGen = do +zokkaRegistriesGen :: Hedgehog.Gen ZokkaRegistries +zokkaRegistriesGen = do registryKeyToRegistry <- registryKeyToRegistryGen packagesToLocations <- packagesToLocationsGen - pure (ZelmRegistries{_registries=registryKeyToRegistry, _packagesToLocations=packagesToLocations}) + pure (ZokkaRegistries{_registries=registryKeyToRegistry, _packagesToLocations=packagesToLocations}) main :: IO () main = defaultMain tests @@ -89,7 +89,7 @@ hedgehogProperties = testGroup "(checked by Hedgehog)" [ HH.testProperty "dummy property" $ dummyProperty , HH.testProperty "make sure roundtrip works" $ - roundtripBinaryEncodingOfZelmRegistryChangesNothing + roundtripBinaryEncodingOfZokkaRegistryChangesNothing ] dummyProperty :: Hedgehog.Property @@ -98,10 +98,10 @@ dummyProperty = x <- Hedgehog.forAll $ Gen.int (Range.linear 1 10) x === x -roundtripBinaryEncodingOfZelmRegistryChangesNothing :: Hedgehog.Property -roundtripBinaryEncodingOfZelmRegistryChangesNothing = +roundtripBinaryEncodingOfZokkaRegistryChangesNothing :: Hedgehog.Property +roundtripBinaryEncodingOfZokkaRegistryChangesNothing = Hedgehog.property $ do - x <- Hedgehog.forAll zelmRegistriesGen + x <- Hedgehog.forAll zokkaRegistriesGen Binary.decode (Binary.encode x) === x unitTests :: TestTree