@@ -1,25 +1,26 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Init
3− ( Flags(..)
4− , run
3+ ( run
54 )
65 where
76
87
98import Prelude hiding (init)
109import Control.Monad.Trans (liftIO)
11−import qualified Data.ByteString.Lazy as LBS
12−import Data.Monoid ((<>))
13−import qualified Network.HTTP.Client as Client
10+import qualified Data.Map as Map
1411import qualified System.Directory as Dir
1512
13+import qualified Deps.Cache as Cache
14+import qualified Deps.Explorer as Explorer
15+import qualified Deps.Solver as Solver
1616import qualified Elm.Compiler.Version as Compiler
1717import qualified Elm.Package as Pkg
18+import qualified Elm.Project.Constraint as Con
19+import qualified Elm.Project.Json as Project
1820import qualified Reporting.Doc as D
1921import qualified Reporting.Exit as Exit
2022import qualified Reporting.Exit.Init as E
2123import qualified Reporting.Task as Task
22−import qualified Reporting.Task.Http as Http
2324import qualified Reporting.Progress.Terminal as Terminal
2425
2526
@@ -27,81 +28,73 @@ import qualified Reporting.Progress.Terminal as Terminal
2728-- RUN
2829
2930
30−data Flags =
31− Flags
32− { _element :: Bool
33− , _document :: Bool
34− }
35−
36−
37−run :: () -> Flags -> IO ()
38−run () flags =
31+run :: () -> () -> IO ()
32+run () () =
3933 do reporter <- Terminal.create
34+ exists <- Dir.doesFileExist "elm.json"
4035 Task.run reporter $
41− do approved <- Task.getApproval question
42− if approved
43− then
44− do init flags
45− liftIO $ putStrLn "Okay, I created them!"
46− else
47− liftIO $ putStrLn "Okay, I left everything the same!"
36+ if exists then
37+ Task.throw (Exit.Init E.AlreadyStarted)
38+ else
39+ do approved <- Task.getApproval question
40+ if approved
41+ then
42+ do init
43+ liftIO $ putStrLn "Okay, I created it. Now read that link!"
44+ else
45+ liftIO $ putStrLn "Okay, I did not make any changes!"
4846
4947
5048question :: D.Doc
5149question =
5250 D.stack
53− [ "Hello! Elm projects are pretty simple. They include:"
54− , D.indent 2 $ D.vcat $
55− [ "1. " <> D.green "elm.json" <> D.black " ------------ describes your dependencies"
56− , "2. " <> D.green "src/Main.elm" <> D.black " ------ a small Elm program to expand"
51+ [ D.fillSep
52+ ["Hello!"
53+ ,"Elm","projects","always","start","with","an",D.green "elm.json","file."
54+ ,"I","can","create","them!"
5755 ]
58− , customReflow
59− "Now you may be wondering, what will be in these files? How do I see\
60− \ it in the browser? How will my code grow? Do I need more\
61− \ directories? What about tests? Etc. Check out"
62− (D.dullyellow (D.fromString (D.makeLink "init")))
63− "for all the answers!"
64− , "So, would you like me to create these two files now? [Y/n]: "
56+ , D.reflow
57+ "Now you may be wondering, what will be in this file? How do I add Elm files to\
58+ \ my project? How do I see it in the browser? How will my code grow? Do I need\
59+ \ more directories? What about tests? Etc."
60+ , D.fillSep
61+ ["Check","out",D.cyan (D.fromString (D.makeLink "init"))
62+ ,"for","all","the","answers!"
63+ ]
64+ , "Knowing all that, would you like me to create an elm.json file now? [Y/n]: "
6565 ]
6666
6767
68−customReflow :: String -> D.Doc -> String -> D.Doc
69−customReflow before doc after =
70− D.fillSep $
71− map D.fromString (words before) ++ [doc] ++ map D.fromString (words after)
72−
73−
7468
7569-- INIT
7670
7771
78−init :: Flags -> Task.Task ()
79−init flags =
80− case flags of
81− Flags False False -> download "sandbox"
82− Flags True False -> download "element"
83− Flags False True -> download "document"
84− Flags _ _ -> Task.throw $ Exit.Init E.ClashingFlags
85−
72+init :: Task.Task ()
73+init =
74+ do registry <- Cache.optionalUpdate
8675
87−download :: String -> Task.Task ()
88−download projectType =
89− do fetch projectType "elm.json" $ return ()
90− fetch projectType "src/Main.elm" $ Dir.createDirectoryIfMissing True "src"
76+ maybeSolution <-
77+ Explorer.run registry $ Solver.run $ Solver.solve defaults
9178
79+ case maybeSolution of
80+ Just solution ->
81+ let
82+ directs = Map.intersection solution defaults
83+ indirects = Map.difference solution defaults
84+ in
85+ liftIO $
86+ do Dir.createDirectoryIfMissing True "src"
87+ Project.write "." $ Project.App $
88+ Project.AppInfo Compiler.version ["src"] directs indirects Map.empty Map.empty
9289
93−fetch :: String -> FilePath -> IO () -> Task.Task ()
94−fetch projectType path setup =
95− Http.run $
96− Http.anything
97− ("https://experiment.elm-lang.org/" ++ vsn ++ "/init/" ++ projectType ++ "/" ++ path)
98− (\request manager ->
99− do response <- Client.httpLbs request manager
100− setup
101− Right <$> LBS.writeFile path (Client.responseBody response)
102− )
90+ Nothing ->
91+ Task.throw (Exit.Init (E.NoSolution (Map.keys defaults)))
10392
10493
105−vsn :: String
106−vsn =
107− Pkg.versionToString Compiler.version
94+defaults :: Map.Map Pkg.Name Con.Constraint
95+defaults =
96+ Map.fromList
97+ [ (Pkg.core, Con.anything)
98+ , (Pkg.browser, Con.anything)
99+ , (Pkg.html, Con.anything)
100+ ]