@@ -6,28 +6,27 @@ module Elm.Project.Root
66 )
77 where
88
9+
10+import Control.Monad (msum)
911import Control.Monad.Trans (liftIO)
10−import qualified Data.ByteString.Lazy as LBS
1112import qualified Data.Map as Map
12−import Data.Monoid ((<>))
13−import qualified Network.HTTP.Client as Client
1413import qualified System.Directory as Dir
1514import System.FilePath ((</>))
1615
16+import qualified Deps.Cache as Cache
17+import qualified Deps.Explorer as Explorer
18+import qualified Deps.Solver as Solver
1719import qualified Elm.Compiler.Version as Elm
1820import qualified Elm.Package as Pkg
1921import qualified Elm.Project.Constraint as Con
2022import qualified Elm.Project.Json as Project
2123import qualified Elm.Project.Licenses as Licenses
22−import Elm.Project.Json (Project(..), PkgInfo(..))
23−import Elm.Project.Summary (Summary)
24+import qualified Elm.Project.Summary as Summary
2425import qualified Elm.PerUserCache as PerUserCache
2526import qualified File.IO as IO
26−import qualified Reporting.Doc as D
2727import qualified Reporting.Exit as Exit
2828import qualified Reporting.Progress as Progress
2929import qualified Reporting.Task as Task
30−import qualified Reporting.Task.Http as Http
3130import qualified Stuff.Verify as Verify
3231import qualified Json.Encode as Encode
3332
@@ -36,14 +35,14 @@ import qualified Json.Encode as Encode
3635-- GET
3736
3837
39−get :: Task.Task Summary
38+get :: Task.Task Summary.Summary
4039get =
4140 do root <- moveToRoot
4241 project <- Project.read "elm.json"
4342 Verify.verify root project
4443
4544
46−unsafeGet :: Task.Task (FilePath, Project)
45+unsafeGet :: Task.Task (FilePath, Project.Project)
4746unsafeGet =
4847 (,) <$> moveToRoot <*> Project.read "elm.json"
4948
@@ -61,38 +60,41 @@ moveToRoot =
6160 return root
6261
6362 Nothing ->
64− do approved <- Task.getApproval $ D.vcat $
65− [ "It looks like you are starting a new Elm project. Very exciting!"
66− , ""
67− , "I would like to create two files to help you get started:"
68− , ""
69− , " 1. elm.json" <> D.black " ------------ describes your dependencies"
70− , " 2. src/Main.elm" <> D.black " ------ a basic Elm program to expand"
71− , ""
72− , "This is common to all Elm projects. Would you like me to create them? [Y/n]: "
73− ]
74−
75− if approved
76− then
77− do liftIO $ Dir.createDirectoryIfMissing True "src"
78− fetch "elm.json"
79− fetch "src/Main.elm"
80− Task.report Progress.ElmJsonApproved
81− liftIO $ Dir.getCurrentDirectory
82− else
83− do Task.report Progress.ElmJsonRejected
84− Task.throw Exit.NoElmJson
85−
86−
87−fetch :: FilePath -> Task.Task ()
88−fetch path =
89− Http.run $
90− Http.anything
91− ("https://experiment.elm-lang.org/" ++ Pkg.versionToString Elm.version ++ "/starter/" ++ path)
92− (\request manager ->
93− do response <- Client.httpLbs request manager
94− Right <$> LBS.writeFile path (Client.responseBody response)
95− )
63+ do addElmJson
64+ Task.report Progress.ElmJsonAdded
65+ liftIO $ Dir.getCurrentDirectory
66+
67+
68+addElmJson :: Task.Task ()
69+addElmJson =
70+ do registry <- Cache.optionalUpdate
71+ maybeSolution <- Explorer.run registry $ Solver.run $
72+ msum $ map Solver.solve $
73+ [ defaultDependencies
74+ , Map.singleton Pkg.core Con.anything
75+ ]
76+ case maybeSolution of
77+ Nothing ->
78+ Task.throw Exit.NoElmJson
79+
80+ Just solution ->
81+ liftIO $ Encode.write "elm.json" $ Project.encode $ Project.App $
82+ Project.AppInfo
83+ Elm.version
84+ ["src"]
85+ (Map.intersection solution defaultDependencies)
86+ Map.empty
87+ (Map.difference solution defaultDependencies)
88+
89+
90+defaultDependencies :: Map.Map Pkg.Name Con.Constraint
91+defaultDependencies =
92+ Map.fromList
93+ [ (Pkg.browser, Con.anything)
94+ , (Pkg.core, Con.anything)
95+ , (Pkg.html, Con.anything)
96+ , (Pkg.json, Con.anything)
97+ ]
9698
9799
98100
@@ -114,19 +116,19 @@ getWithReplFallback =
114116 Dir.createDirectoryIfMissing True root
115117 Dir.setCurrentDirectory root
116118 IO.removeDir "elm-stuff"
117− Encode.write "elm.json" (Project.encode (Pkg replInfo))
119+ Encode.write "elm.json" (Project.encode (Project.Pkg replInfo))
118120 return root
119121
120122
121−replInfo :: PkgInfo
123+replInfo :: Project.PkgInfo
122124replInfo =
123− PkgInfo
124− { _pkg_name = Pkg.dummyName
125− , _pkg_summary = "dummy code for the REPL"
126− , _pkg_license = Licenses.bsd3
127− , _pkg_version = Pkg.dummyVersion
128− , _pkg_exposed = Project.ExposedList []
129− , _pkg_deps = Map.singleton Pkg.core Con.anything
130− , _pkg_test_deps = Map.empty
131− , _pkg_elm_version = Con.defaultElm
125+ Project.PkgInfo
126+ { Project._pkg_name = Pkg.dummyName
127+ , Project._pkg_summary = "dummy code for the REPL"
128+ , Project._pkg_license = Licenses.bsd3
129+ , Project._pkg_version = Pkg.dummyVersion
130+ , Project._pkg_exposed = Project.ExposedList []
131+ , Project._pkg_deps = Map.singleton Pkg.core Con.anything
132+ , Project._pkg_test_deps = Map.empty
133+ , Project._pkg_elm_version = Con.defaultElm
132134 }