gren-lang/compiler
1
1
Fork 0
mirror of https://github.com/gren-lang/compiler.git synced 2024-08-16 12:00:22 +03:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Rename Stuff.hs to the more descriptibe Directories.hs

Browse Source
This commit is contained in:
Robin Heggelund Hansen 2022-01-02 14:24:01 +01:00
parent 4c20a17cf7
commit 48bc8ef1f2
18 changed files with 102 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -1,4 +1,4 @@
elm-stuff
.gren_cache
dist
dist-newstyle
cabal-dev

12
builder/src/Build.hs
View File

@ -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)

6
builder/src/Deps/Diff.hs
View File

@ -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

16
builder/src/Deps/Registry.hs
View File

@ -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

24
builder/src/Deps/Solver.hs
View File

@ -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

30
builder/src/Stuff.hs → builder/src/Directories.hs
View File

@ -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

40
builder/src/Elm/Details.hs
View File

@ -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 ->

6
builder/src/Generate.hs
View File

@ -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

2
gren.cabal
View File

@ -90,7 +90,7 @@ Executable gren
Reporting.Exit
Reporting.Exit.Help
Reporting.Task
Stuff
Directories
-- Elm things
Elm.Outline

6
terminal/impl/Terminal/Helpers.hs
View File

@ -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

8
terminal/src/Bump.hs
View File

@ -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

6
terminal/src/Develop.hs
View File

@ -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

6
terminal/src/Develop/Generate/Index.hs
View File

@ -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

8
terminal/src/Diff.hs
View File

@ -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)

6
terminal/src/Install.hs
View File

@ -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 ->

6
terminal/src/Make.hs
View File

@ -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

10
terminal/src/Publish.hs
View File

@ -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_

10
terminal/src/Repl.hs
View File

@ -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")