mirror of
https://github.com/gren-lang/compiler.git
synced 2024-08-16 12:00:22 +03:00
Rename Stuff.hs to the more descriptibe Directories.hs
This commit is contained in:
parent
4c20a17cf7
commit
48bc8ef1f2
2
.gitignore
vendored
2
.gitignore
vendored
@ -1,4 +1,4 @@
|
||||
elm-stuff
|
||||
.gren_cache
|
||||
dist
|
||||
dist-newstyle
|
||||
cabal-dev
|
||||
|
@ -55,7 +55,7 @@ import qualified Reporting.Error.Syntax as Syntax
|
||||
import qualified Reporting.Error.Import as Import
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Render.Type.Localizer as L
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -556,7 +556,7 @@ loadInterface root (name, ciMvar) =
|
||||
return (Just (name, iface))
|
||||
|
||||
Unneeded ->
|
||||
do maybeIface <- File.readBinary (Stuff.elmi root name)
|
||||
do maybeIface <- File.readBinary (Dirs.elmi root name)
|
||||
case maybeIface of
|
||||
Nothing ->
|
||||
do putMVar ciMvar Corrupted
|
||||
@ -715,8 +715,8 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path ti
|
||||
Right docs ->
|
||||
do let name = Src.getName modul
|
||||
let iface = I.fromModule pkg canonical annotations
|
||||
let elmi = Stuff.elmi root name
|
||||
File.writeBinary (Stuff.elmo root name) objects
|
||||
let elmi = Dirs.elmi root name
|
||||
File.writeBinary (Dirs.elmo root name) objects
|
||||
maybeOldi <- File.readBinary elmi
|
||||
case maybeOldi of
|
||||
Just oldi | oldi == iface ->
|
||||
@ -750,7 +750,7 @@ projectTypeToPkg projectType =
|
||||
|
||||
writeDetails :: FilePath -> Details.Details -> Map.Map ModuleName.Raw Result -> IO ()
|
||||
writeDetails root (Details.Details time outline buildID locals foreigns extras) results =
|
||||
File.writeBinary (Stuff.details root) $
|
||||
File.writeBinary (Dirs.details root) $
|
||||
Details.Details time outline buildID (Map.foldrWithKey addNewLocal locals results) foreigns extras
|
||||
|
||||
|
||||
@ -1220,7 +1220,7 @@ gatherProblemsOrMains results (NE.List rootResult rootResults) =
|
||||
(ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)
|
||||
(ROutsideOk _ _ _, (e:es, _ )) -> Left (NE.List e es)
|
||||
(ROutsideErr e , ( es, _ )) -> Left (NE.List e es)
|
||||
(ROutsideBlocked , ( [], _ )) -> error "seems like elm-stuff/ is corrupted"
|
||||
(ROutsideBlocked , ( [], _ )) -> error "seems like .gren_cache/ is corrupted"
|
||||
(ROutsideBlocked , (e:es, _ )) -> Left (NE.List e es)
|
||||
|
||||
|
||||
|
@ -32,7 +32,7 @@ import qualified File
|
||||
import qualified Http
|
||||
import qualified Json.Decode as D
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -355,9 +355,9 @@ changeMagnitude (Changes added changed removed) =
|
||||
-- GET DOCS
|
||||
|
||||
|
||||
getDocs :: Stuff.PackageCache -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.DocsProblem Docs.Documentation)
|
||||
getDocs :: Dirs.PackageCache -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.DocsProblem Docs.Documentation)
|
||||
getDocs cache manager name version =
|
||||
do let home = Stuff.package cache name version
|
||||
do let home = Dirs.package cache name version
|
||||
let path = home </> "docs.json"
|
||||
exists <- File.exists path
|
||||
if exists
|
||||
|
@ -27,7 +27,7 @@ import qualified Http
|
||||
import qualified Json.Decode as D
|
||||
import qualified Parse.Primitives as P
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -52,22 +52,22 @@ data KnownVersions =
|
||||
-- READ
|
||||
|
||||
|
||||
read :: Stuff.PackageCache -> IO (Maybe Registry)
|
||||
read :: Dirs.PackageCache -> IO (Maybe Registry)
|
||||
read cache =
|
||||
File.readBinary (Stuff.registry cache)
|
||||
File.readBinary (Dirs.registry cache)
|
||||
|
||||
|
||||
|
||||
-- FETCH
|
||||
|
||||
|
||||
fetch :: Http.Manager -> Stuff.PackageCache -> IO (Either Exit.RegistryProblem Registry)
|
||||
fetch :: Http.Manager -> Dirs.PackageCache -> IO (Either Exit.RegistryProblem Registry)
|
||||
fetch manager cache =
|
||||
post manager "/all-packages" allPkgsDecoder $
|
||||
\versions ->
|
||||
do let size = Map.foldr' addEntry 0 versions
|
||||
let registry = Registry size versions
|
||||
let path = Stuff.registry cache
|
||||
let path = Dirs.registry cache
|
||||
File.writeBinary path registry
|
||||
return registry
|
||||
|
||||
@ -98,7 +98,7 @@ allPkgsDecoder =
|
||||
-- UPDATE
|
||||
|
||||
|
||||
update :: Http.Manager -> Stuff.PackageCache -> Registry -> IO (Either Exit.RegistryProblem Registry)
|
||||
update :: Http.Manager -> Dirs.PackageCache -> Registry -> IO (Either Exit.RegistryProblem Registry)
|
||||
update manager cache oldRegistry@(Registry size packages) =
|
||||
post manager ("/all-packages/since/" ++ show size) (D.list newPkgDecoder) $
|
||||
\news ->
|
||||
@ -112,7 +112,7 @@ update manager cache oldRegistry@(Registry size packages) =
|
||||
newPkgs = foldr addNew packages news
|
||||
newRegistry = Registry newSize newPkgs
|
||||
in
|
||||
do File.writeBinary (Stuff.registry cache) newRegistry
|
||||
do File.writeBinary (Dirs.registry cache) newRegistry
|
||||
return newRegistry
|
||||
|
||||
|
||||
@ -156,7 +156,7 @@ bail _ _ =
|
||||
-- LATEST
|
||||
|
||||
|
||||
latest :: Http.Manager -> Stuff.PackageCache -> IO (Either Exit.RegistryProblem Registry)
|
||||
latest :: Http.Manager -> Dirs.PackageCache -> IO (Either Exit.RegistryProblem Registry)
|
||||
latest manager cache =
|
||||
do maybeOldRegistry <- read cache
|
||||
case maybeOldRegistry of
|
||||
|
@ -33,7 +33,7 @@ import qualified Http
|
||||
import qualified Git
|
||||
import qualified Json.Decode as D
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -54,7 +54,7 @@ newtype Solver a =
|
||||
|
||||
data State =
|
||||
State
|
||||
{ _cache :: Stuff.PackageCache
|
||||
{ _cache :: Dirs.PackageCache
|
||||
, _constraints :: Map.Map (Pkg.Name, V.Version) Constraints
|
||||
}
|
||||
|
||||
@ -85,9 +85,9 @@ data Details =
|
||||
Details V.Version (Map.Map Pkg.Name C.Constraint)
|
||||
|
||||
|
||||
verify :: Stuff.PackageCache -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details))
|
||||
verify :: Dirs.PackageCache -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details))
|
||||
verify cache constraints =
|
||||
Stuff.withRegistryLock cache $
|
||||
Dirs.withRegistryLock cache $
|
||||
case try constraints of
|
||||
Solver solver ->
|
||||
solver (State cache Map.empty)
|
||||
@ -114,9 +114,9 @@ data AppSolution =
|
||||
}
|
||||
|
||||
|
||||
addToApp :: Stuff.PackageCache -> Pkg.Name -> Outline.AppOutline -> IO (Result AppSolution)
|
||||
addToApp :: Dirs.PackageCache -> Pkg.Name -> Outline.AppOutline -> IO (Result AppSolution)
|
||||
addToApp cache pkg outline@(Outline.AppOutline _ _ direct indirect testDirect testIndirect) =
|
||||
Stuff.withRegistryLock cache $
|
||||
Dirs.withRegistryLock cache $
|
||||
let
|
||||
allIndirects = Map.union indirect testIndirect
|
||||
allDirects = Map.union direct testDirect
|
||||
@ -258,9 +258,9 @@ getRelevantVersions name constraint =
|
||||
back state
|
||||
|
||||
|
||||
getRelevantVersionsHelper :: Stuff.PackageCache -> Pkg.Name -> IO (Maybe (V.Version, [V.Version]))
|
||||
getRelevantVersionsHelper :: Dirs.PackageCache -> Pkg.Name -> IO (Maybe (V.Version, [V.Version]))
|
||||
getRelevantVersionsHelper cache name = do
|
||||
let repoPath = Stuff.basePackage cache name
|
||||
let repoPath = Dirs.basePackage cache name
|
||||
repoExists <- Dir.doesDirectoryExist repoPath
|
||||
_ <-
|
||||
if repoExists then
|
||||
@ -283,7 +283,7 @@ getConstraints pkg vsn =
|
||||
|
||||
Nothing ->
|
||||
do let toNewState cs = State cache (Map.insert key cs cDict)
|
||||
let home = Stuff.package cache pkg vsn
|
||||
let home = Dirs.package cache pkg vsn
|
||||
let path = home </> "elm.json"
|
||||
outlineExists <- File.exists path
|
||||
if outlineExists then
|
||||
@ -295,7 +295,7 @@ getConstraints pkg vsn =
|
||||
Left _ ->
|
||||
err (Exit.SolverBadCacheData pkg vsn)
|
||||
else
|
||||
do let basePath = Stuff.basePackage cache pkg
|
||||
do let basePath = Dirs.basePackage cache pkg
|
||||
_ <- Git.localClone basePath vsn home
|
||||
bytes <- File.readUtf8 path
|
||||
case D.fromByteString constraintsDecoder bytes of
|
||||
@ -322,12 +322,12 @@ constraintsDecoder =
|
||||
|
||||
|
||||
newtype Env =
|
||||
Env Stuff.PackageCache
|
||||
Env Dirs.PackageCache
|
||||
|
||||
|
||||
initEnv :: IO (Either Exit.RegistryProblem Env)
|
||||
initEnv =
|
||||
do cache <- Stuff.getPackageCache
|
||||
do cache <- Dirs.getPackageCache
|
||||
return $ Right $ Env cache
|
||||
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
{-# OPTIONS_GHC -Wall #-}
|
||||
module Stuff
|
||||
module Directories
|
||||
( details
|
||||
, interfaces
|
||||
, objects
|
||||
@ -16,7 +16,7 @@ module Stuff
|
||||
, package
|
||||
, basePackage
|
||||
, getReplCache
|
||||
, getElmHome
|
||||
, getGrenHome
|
||||
)
|
||||
where
|
||||
|
||||
@ -36,29 +36,29 @@ import qualified Elm.Version as V
|
||||
-- PATHS
|
||||
|
||||
|
||||
stuff :: FilePath -> FilePath
|
||||
stuff root =
|
||||
root </> "elm-stuff" </> compilerVersion
|
||||
projectCache :: FilePath -> FilePath
|
||||
projectCache root =
|
||||
root </> ".gren_cache" </> compilerVersion
|
||||
|
||||
|
||||
details :: FilePath -> FilePath
|
||||
details root =
|
||||
stuff root </> "d.dat"
|
||||
projectCache root </> "d.dat"
|
||||
|
||||
|
||||
interfaces :: FilePath -> FilePath
|
||||
interfaces root =
|
||||
stuff root </> "i.dat"
|
||||
projectCache root </> "i.dat"
|
||||
|
||||
|
||||
objects :: FilePath -> FilePath
|
||||
objects root =
|
||||
stuff root </> "o.dat"
|
||||
projectCache root </> "o.dat"
|
||||
|
||||
|
||||
prepublishDir :: FilePath -> FilePath
|
||||
prepublishDir root =
|
||||
stuff root </> "prepublish"
|
||||
projectCache root </> "prepublish"
|
||||
|
||||
|
||||
compilerVersion :: FilePath
|
||||
@ -82,7 +82,7 @@ elmo root name =
|
||||
|
||||
toArtifactPath :: FilePath -> ModuleName.Raw -> String -> FilePath
|
||||
toArtifactPath root name ext =
|
||||
stuff root </> ModuleName.toHyphenPath name <.> ext
|
||||
projectCache root </> ModuleName.toHyphenPath name <.> ext
|
||||
|
||||
|
||||
|
||||
@ -91,7 +91,7 @@ toArtifactPath root name ext =
|
||||
|
||||
temp :: FilePath -> String -> FilePath
|
||||
temp root ext =
|
||||
stuff root </> "temp" <.> ext
|
||||
projectCache root </> "temp" <.> ext
|
||||
|
||||
|
||||
|
||||
@ -123,7 +123,7 @@ findRootHelp dirs =
|
||||
|
||||
withRootLock :: FilePath -> IO a -> IO a
|
||||
withRootLock root work =
|
||||
do let dir = stuff root
|
||||
do let dir = projectCache root
|
||||
Dir.createDirectoryIfMissing True dir
|
||||
Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)
|
||||
|
||||
@ -171,14 +171,14 @@ getReplCache =
|
||||
|
||||
getCacheDir :: FilePath -> IO FilePath
|
||||
getCacheDir projectName =
|
||||
do home <- getElmHome
|
||||
do home <- getGrenHome
|
||||
let root = home </> compilerVersion </> projectName
|
||||
Dir.createDirectoryIfMissing True root
|
||||
return root
|
||||
|
||||
|
||||
getElmHome :: IO FilePath
|
||||
getElmHome =
|
||||
getGrenHome :: IO FilePath
|
||||
getGrenHome =
|
||||
do maybeCustomHome <- Env.lookupEnv "GREN_HOME"
|
||||
case maybeCustomHome of
|
||||
Just customHome -> return customHome
|
@ -57,7 +57,7 @@ import qualified Reporting
|
||||
import qualified Reporting.Annotation as A
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -128,14 +128,14 @@ loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))
|
||||
loadObjects root (Details _ _ _ _ _ extras) =
|
||||
case extras of
|
||||
ArtifactsFresh _ o -> newMVar (Just o)
|
||||
ArtifactsCached -> fork (File.readBinary (Stuff.objects root))
|
||||
ArtifactsCached -> fork (File.readBinary (Dirs.objects root))
|
||||
|
||||
|
||||
loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))
|
||||
loadInterfaces root (Details _ _ _ _ _ extras) =
|
||||
case extras of
|
||||
ArtifactsFresh i _ -> newMVar (Just i)
|
||||
ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))
|
||||
ArtifactsCached -> fork (File.readBinary (Dirs.interfaces root))
|
||||
|
||||
|
||||
|
||||
@ -159,7 +159,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")
|
||||
maybeDetails <- File.readBinary (Stuff.details root)
|
||||
maybeDetails <- File.readBinary (Dirs.details root)
|
||||
case maybeDetails of
|
||||
Nothing ->
|
||||
generate style scope root newTime
|
||||
@ -197,7 +197,7 @@ data Env =
|
||||
{ _key :: Reporting.DKey
|
||||
, _scope :: BW.Scope
|
||||
, _root :: FilePath
|
||||
, _cache :: Stuff.PackageCache
|
||||
, _cache :: Dirs.PackageCache
|
||||
}
|
||||
|
||||
|
||||
@ -313,13 +313,13 @@ verifyDependencies env@(Env key scope root cache) time outline solution directDe
|
||||
Task.eio id $
|
||||
do Reporting.report key (Reporting.DStart (Map.size solution))
|
||||
mvar <- newEmptyMVar
|
||||
mvars <- Stuff.withRegistryLock cache $
|
||||
mvars <- Dirs.withRegistryLock cache $
|
||||
Map.traverseWithKey (\k v -> fork (verifyDep env mvar solution k v)) solution
|
||||
putMVar mvar mvars
|
||||
deps <- traverse readMVar mvars
|
||||
case sequence deps of
|
||||
Left _ ->
|
||||
do home <- Stuff.getElmHome
|
||||
do home <- Dirs.getGrenHome
|
||||
return $ Left $ Exit.DetailsBadDeps home $
|
||||
Maybe.catMaybes $ Either.lefts $ Map.elems deps
|
||||
|
||||
@ -330,9 +330,9 @@ verifyDependencies env@(Env key scope root cache) time outline solution directDe
|
||||
foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty $ Map.intersection artifacts directDeps
|
||||
details = Details time outline 0 Map.empty foreigns (ArtifactsFresh ifaces objs)
|
||||
in
|
||||
do BW.writeBinary scope (Stuff.objects root) objs
|
||||
BW.writeBinary scope (Stuff.interfaces root) ifaces
|
||||
BW.writeBinary scope (Stuff.details root) details
|
||||
do BW.writeBinary scope (Dirs.objects root) objs
|
||||
BW.writeBinary scope (Dirs.interfaces root) ifaces
|
||||
BW.writeBinary scope (Dirs.details root) details
|
||||
return (Right details)
|
||||
|
||||
|
||||
@ -378,11 +378,11 @@ type Dep =
|
||||
verifyDep :: Env -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Pkg.Name -> Solver.Details -> IO Dep
|
||||
verifyDep (Env key _ _ cache) depsMVar solution pkg details@(Solver.Details vsn directDeps) =
|
||||
do let fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps
|
||||
exists <- Dir.doesDirectoryExist (Stuff.package cache pkg vsn </> "src")
|
||||
exists <- Dir.doesDirectoryExist (Dirs.package cache pkg vsn </> "src")
|
||||
if exists
|
||||
then
|
||||
do Reporting.report key Reporting.DCached
|
||||
maybeCache <- File.readBinary (Stuff.package cache pkg vsn </> "artifacts.dat")
|
||||
maybeCache <- File.readBinary (Dirs.package cache pkg vsn </> "artifacts.dat")
|
||||
case maybeCache of
|
||||
Nothing ->
|
||||
build key cache depsMVar pkg details fingerprint Set.empty
|
||||
@ -414,9 +414,9 @@ type Fingerprint =
|
||||
-- BUILD
|
||||
|
||||
|
||||
build :: Reporting.DKey -> Stuff.PackageCache -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Pkg.Name -> Solver.Details -> Fingerprint -> Set.Set Fingerprint -> IO Dep
|
||||
build :: Reporting.DKey -> Dirs.PackageCache -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Pkg.Name -> Solver.Details -> Fingerprint -> Set.Set Fingerprint -> IO Dep
|
||||
build key cache depsMVar pkg (Solver.Details vsn _) f fs =
|
||||
do eitherOutline <- Outline.read (Stuff.package cache pkg vsn)
|
||||
do eitherOutline <- Outline.read (Dirs.package cache pkg vsn)
|
||||
case eitherOutline of
|
||||
Left _ ->
|
||||
do Reporting.report key Reporting.DBroken
|
||||
@ -435,7 +435,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs =
|
||||
return $ Left $ Nothing
|
||||
|
||||
Right directArtifacts ->
|
||||
do let src = Stuff.package cache pkg vsn </> "src"
|
||||
do let src = Dirs.package cache pkg vsn </> "src"
|
||||
let foreignDeps = gatherForeignInterfaces directArtifacts
|
||||
let exposedDict = Map.fromKeys (\_ -> ()) (Outline.flattenExposed exposed)
|
||||
docsStatus <- getDocsStatus cache pkg vsn
|
||||
@ -461,7 +461,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs =
|
||||
|
||||
Just results ->
|
||||
let
|
||||
path = Stuff.package cache pkg vsn </> "artifacts.dat"
|
||||
path = Dirs.package cache pkg vsn </> "artifacts.dat"
|
||||
ifaces = gatherInterfaces exposedDict results
|
||||
objects = gatherObjects results
|
||||
artifacts = Artifacts ifaces objects
|
||||
@ -689,9 +689,9 @@ data DocsStatus
|
||||
| DocsNotNeeded
|
||||
|
||||
|
||||
getDocsStatus :: Stuff.PackageCache -> Pkg.Name -> V.Version -> IO DocsStatus
|
||||
getDocsStatus :: Dirs.PackageCache -> Pkg.Name -> V.Version -> IO DocsStatus
|
||||
getDocsStatus cache pkg vsn =
|
||||
do exists <- File.exists (Stuff.package cache pkg vsn </> "docs.json")
|
||||
do exists <- File.exists (Dirs.package cache pkg vsn </> "docs.json")
|
||||
if exists
|
||||
then return DocsNotNeeded
|
||||
else return DocsNeeded
|
||||
@ -709,11 +709,11 @@ makeDocs status modul =
|
||||
Nothing
|
||||
|
||||
|
||||
writeDocs :: Stuff.PackageCache -> Pkg.Name -> V.Version -> DocsStatus -> Map.Map ModuleName.Raw Result -> IO ()
|
||||
writeDocs :: Dirs.PackageCache -> Pkg.Name -> V.Version -> DocsStatus -> Map.Map ModuleName.Raw Result -> IO ()
|
||||
writeDocs cache pkg vsn status results =
|
||||
case status of
|
||||
DocsNeeded ->
|
||||
E.writeUgly (Stuff.package cache pkg vsn </> "docs.json") $
|
||||
E.writeUgly (Dirs.package cache pkg vsn </> "docs.json") $
|
||||
Docs.encode $ Map.mapMaybe toDocs results
|
||||
|
||||
DocsNotNeeded ->
|
||||
|
@ -31,7 +31,7 @@ import qualified Generate.Mode as Mode
|
||||
import qualified Nitpick.Debug as Nitpick
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
-- NOTE: This is used by Make, Repl, and Reactor right now. But it may be
|
||||
@ -143,7 +143,7 @@ loadObject root modul =
|
||||
|
||||
Build.Cached name _ _ ->
|
||||
do mvar <- newEmptyMVar
|
||||
_ <- forkIO $ putMVar mvar =<< File.readBinary (Stuff.elmo root name)
|
||||
_ <- forkIO $ putMVar mvar =<< File.readBinary (Dirs.elmo root name)
|
||||
return (name, mvar)
|
||||
|
||||
|
||||
@ -200,7 +200,7 @@ loadTypesHelp root modul =
|
||||
Build.Unneeded ->
|
||||
do mvar <- newEmptyMVar
|
||||
_ <- forkIO $
|
||||
do maybeIface <- File.readBinary (Stuff.elmi root name)
|
||||
do maybeIface <- File.readBinary (Dirs.elmi root name)
|
||||
putMVar mvar (Extract.fromInterface name <$> maybeIface)
|
||||
return mvar
|
||||
|
||||
|
@ -90,7 +90,7 @@ Executable gren
|
||||
Reporting.Exit
|
||||
Reporting.Exit.Help
|
||||
Reporting.Task
|
||||
Stuff
|
||||
Directories
|
||||
|
||||
-- Elm things
|
||||
Elm.Outline
|
||||
|
@ -19,7 +19,7 @@ import qualified Deps.Registry as Registry
|
||||
import qualified Elm.Package as Pkg
|
||||
import qualified Elm.Version as V
|
||||
import qualified Parse.Primitives as P
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
import qualified Reporting.Suggest as Suggest
|
||||
|
||||
|
||||
@ -119,7 +119,7 @@ parsePackage chars =
|
||||
|
||||
suggestPackages :: String -> IO [String]
|
||||
suggestPackages given =
|
||||
do cache <- Stuff.getPackageCache
|
||||
do cache <- Dirs.getPackageCache
|
||||
maybeRegistry <- Registry.read cache
|
||||
return $
|
||||
case maybeRegistry of
|
||||
@ -133,7 +133,7 @@ suggestPackages given =
|
||||
|
||||
examplePackages :: String -> IO [String]
|
||||
examplePackages given =
|
||||
do cache <- Stuff.getPackageCache
|
||||
do cache <- Dirs.getPackageCache
|
||||
maybeRegistry <- Registry.read cache
|
||||
return $
|
||||
case maybeRegistry of
|
||||
|
@ -25,7 +25,7 @@ import qualified Reporting.Doc as D
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Exit.Help as Help
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -45,7 +45,7 @@ run () () =
|
||||
data Env =
|
||||
Env
|
||||
{ _root :: FilePath
|
||||
, _cache :: Stuff.PackageCache
|
||||
, _cache :: Dirs.PackageCache
|
||||
, _manager :: Http.Manager
|
||||
, _registry :: Registry.Registry
|
||||
, _outline :: Outline.PkgOutline
|
||||
@ -54,13 +54,13 @@ data Env =
|
||||
|
||||
getEnv :: Task.Task Exit.Bump Env
|
||||
getEnv =
|
||||
do maybeRoot <- Task.io $ Stuff.findRoot
|
||||
do maybeRoot <- Task.io $ Dirs.findRoot
|
||||
case maybeRoot of
|
||||
Nothing ->
|
||||
Task.throw Exit.BumpNoOutline
|
||||
|
||||
Just root ->
|
||||
do cache <- Task.io $ Stuff.getPackageCache
|
||||
do cache <- Task.io $ Dirs.getPackageCache
|
||||
manager <- Task.io $ Http.getManager
|
||||
registry <- Task.eio Exit.BumpMustHaveLatestRegistry $ Registry.latest manager cache
|
||||
outline <- Task.eio Exit.BumpBadOutline $ Outline.read root
|
||||
|
@ -31,7 +31,7 @@ import qualified Generate
|
||||
import qualified Reporting
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -151,13 +151,13 @@ serveElm path =
|
||||
|
||||
compile :: FilePath -> IO (Either Exit.Reactor B.Builder)
|
||||
compile path =
|
||||
do maybeRoot <- Stuff.findRoot
|
||||
do maybeRoot <- Dirs.findRoot
|
||||
case maybeRoot of
|
||||
Nothing ->
|
||||
return $ Left $ Exit.ReactorNoOutline
|
||||
|
||||
Just root ->
|
||||
BW.withScope $ \scope -> Stuff.withRootLock root $ Task.run $
|
||||
BW.withScope $ \scope -> Dirs.withRootLock root $ Task.run $
|
||||
do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
|
||||
artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details (NE.List path [])
|
||||
javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts
|
||||
|
@ -22,7 +22,7 @@ import qualified Elm.Version as V
|
||||
import qualified Json.Encode as E
|
||||
import Json.Encode ((==>))
|
||||
import qualified Reporting
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -131,7 +131,7 @@ toFile pwd path =
|
||||
|
||||
getOutline :: IO (Maybe Outline.Outline)
|
||||
getOutline =
|
||||
do maybeRoot <- Stuff.findRoot
|
||||
do maybeRoot <- Dirs.findRoot
|
||||
case maybeRoot of
|
||||
Nothing ->
|
||||
return Nothing
|
||||
@ -162,7 +162,7 @@ getExactDeps maybeOutline =
|
||||
return Map.empty
|
||||
|
||||
Outline.Pkg _ ->
|
||||
do maybeRoot <- Stuff.findRoot
|
||||
do maybeRoot <- Dirs.findRoot
|
||||
case maybeRoot of
|
||||
Nothing ->
|
||||
return Map.empty
|
||||
|
@ -33,7 +33,7 @@ import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Exit.Help as Help
|
||||
import qualified Reporting.Render.Type.Localizer as L
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -62,7 +62,7 @@ run args () =
|
||||
data Env =
|
||||
Env
|
||||
{ _maybeRoot :: Maybe FilePath
|
||||
, _cache :: Stuff.PackageCache
|
||||
, _cache :: Dirs.PackageCache
|
||||
, _manager :: Http.Manager
|
||||
, _registry :: Registry.Registry
|
||||
}
|
||||
@ -70,8 +70,8 @@ data Env =
|
||||
|
||||
getEnv :: Task Env
|
||||
getEnv =
|
||||
do maybeRoot <- Task.io $ Stuff.findRoot
|
||||
cache <- Task.io $ Stuff.getPackageCache
|
||||
do maybeRoot <- Task.io $ Dirs.findRoot
|
||||
cache <- Task.io $ Dirs.getPackageCache
|
||||
manager <- Task.io $ Http.getManager
|
||||
registry <- Task.eio Exit.DiffMustHaveLatestRegistry $ Registry.latest manager cache
|
||||
return (Env maybeRoot cache manager registry)
|
||||
|
@ -23,7 +23,7 @@ import Reporting.Doc ((<>), (<+>))
|
||||
import qualified Reporting.Doc as D
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -38,7 +38,7 @@ data Args
|
||||
run :: Args -> () -> IO ()
|
||||
run args () =
|
||||
Reporting.attempt Exit.installToReport $
|
||||
do maybeRoot <- Stuff.findRoot
|
||||
do maybeRoot <- Dirs.findRoot
|
||||
case maybeRoot of
|
||||
Nothing ->
|
||||
return (Left Exit.InstallNoOutline)
|
||||
@ -46,7 +46,7 @@ run args () =
|
||||
Just root ->
|
||||
case args of
|
||||
NoArgs ->
|
||||
do elmHome <- Stuff.getElmHome
|
||||
do elmHome <- Dirs.getGrenHome
|
||||
return (Left (Exit.InstallNoArgs elmHome))
|
||||
|
||||
Install pkg ->
|
||||
|
@ -28,7 +28,7 @@ import qualified Generate.Html as Html
|
||||
import qualified Reporting
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
import Terminal (Parser(..))
|
||||
|
||||
|
||||
@ -66,7 +66,7 @@ type Task a = Task.Task Exit.Make a
|
||||
run :: [FilePath] -> Flags -> IO ()
|
||||
run paths flags@(Flags _ _ _ report _) =
|
||||
do style <- getStyle report
|
||||
maybeRoot <- Stuff.findRoot
|
||||
maybeRoot <- Dirs.findRoot
|
||||
Reporting.attemptWithStyle style Exit.makeToReport $
|
||||
case maybeRoot of
|
||||
Just root -> runHelp root paths style flags
|
||||
@ -76,7 +76,7 @@ run paths flags@(Flags _ _ _ report _) =
|
||||
runHelp :: FilePath -> [FilePath] -> Reporting.Style -> Flags -> IO (Either Exit.Make ())
|
||||
runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =
|
||||
BW.withScope $ \scope ->
|
||||
Stuff.withRootLock root $ Task.run $
|
||||
Dirs.withRootLock root $ Task.run $
|
||||
do desiredMode <- getMode debug optimize
|
||||
details <- Task.eio Exit.MakeBadDetails (Details.load style scope root)
|
||||
case paths of
|
||||
|
@ -39,7 +39,7 @@ import qualified Reporting.Doc as D
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Exit.Help as Help
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -63,7 +63,7 @@ run () () =
|
||||
data Env =
|
||||
Env
|
||||
{ _root :: FilePath
|
||||
, _cache :: Stuff.PackageCache
|
||||
, _cache :: Dirs.PackageCache
|
||||
, _manager :: Http.Manager
|
||||
, _registry :: Registry.Registry
|
||||
, _outline :: Outline.Outline
|
||||
@ -72,8 +72,8 @@ data Env =
|
||||
|
||||
getEnv :: Task.Task Exit.Publish Env
|
||||
getEnv =
|
||||
do root <- Task.mio Exit.PublishNoOutline $ Stuff.findRoot
|
||||
cache <- Task.io $ Stuff.getPackageCache
|
||||
do root <- Task.mio Exit.PublishNoOutline $ Dirs.findRoot
|
||||
cache <- Task.io $ Dirs.getPackageCache
|
||||
manager <- Task.io $ Http.getManager
|
||||
registry <- Task.eio Exit.PublishMustHaveLatestRegistry $ Registry.latest manager cache
|
||||
outline <- Task.eio Exit.PublishBadOutline $ Outline.read root
|
||||
@ -297,7 +297,7 @@ toZipUrl pkg vsn =
|
||||
withPrepublishDir :: FilePath -> (FilePath -> Task.Task x a) -> Task.Task x a
|
||||
withPrepublishDir root callback =
|
||||
let
|
||||
dir = Stuff.prepublishDir root
|
||||
dir = Dirs.prepublishDir root
|
||||
in
|
||||
Task.eio id $
|
||||
bracket_
|
||||
|
@ -66,7 +66,7 @@ import qualified Reporting.Exit as Exit
|
||||
import qualified Reporting.Render.Code as Code
|
||||
import qualified Reporting.Report as Report
|
||||
import qualified Reporting.Task as Task
|
||||
import qualified Stuff
|
||||
import qualified Directories as Dirs
|
||||
|
||||
|
||||
|
||||
@ -496,7 +496,7 @@ attemptEval :: Env -> State -> State -> Output -> IO State
|
||||
attemptEval (Env root interpreter ansi) oldState newState output =
|
||||
do result <-
|
||||
BW.withScope $ \scope ->
|
||||
Stuff.withRootLock root $ Task.run $
|
||||
Dirs.withRootLock root $ Task.run $
|
||||
do details <-
|
||||
Task.eio Exit.ReplBadDetails $
|
||||
Details.load Reporting.silent scope root
|
||||
@ -606,13 +606,13 @@ genericHelpMessage =
|
||||
|
||||
getRoot :: IO FilePath
|
||||
getRoot =
|
||||
do maybeRoot <- Stuff.findRoot
|
||||
do maybeRoot <- Dirs.findRoot
|
||||
case maybeRoot of
|
||||
Just root ->
|
||||
return root
|
||||
|
||||
Nothing ->
|
||||
do cache <- Stuff.getReplCache
|
||||
do cache <- Dirs.getReplCache
|
||||
let root = cache </> "tmp"
|
||||
Dir.createDirectoryIfMissing True (root </> "src")
|
||||
Outline.write root $ Outline.Pkg $
|
||||
@ -681,7 +681,7 @@ exeNotFound name =
|
||||
|
||||
initSettings :: IO (Repl.Settings M)
|
||||
initSettings =
|
||||
do cache <- Stuff.getReplCache
|
||||
do cache <- Dirs.getReplCache
|
||||
return $
|
||||
Repl.Settings
|
||||
{ Repl.historyFile = Just (cache </> "history")
|
||||
|
Loading…
Reference in New Issue
Block a user