@@ -0,0 +1,102 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Init
3+ ( Flags(..)
4+ , run
5+ )
6+ where
7+
8+
9+import Prelude hiding (init)
10+import Control.Monad.Trans (liftIO)
11+import qualified Data.ByteString.Lazy as LBS
12+import Data.Monoid ((<>))
13+import qualified Network.HTTP.Client as Client
14+
15+import qualified Elm.Compiler.Version as Compiler
16+import qualified Elm.Package as Pkg
17+import qualified Reporting.Doc as D
18+import qualified Reporting.Exit as Exit
19+import qualified Reporting.Exit.Init as E
20+import qualified Reporting.Task as Task
21+import qualified Reporting.Task.Http as Http
22+import qualified Reporting.Progress.Terminal as Terminal
23+
24+
25+
26+-- RUN
27+
28+
29+data Flags =
30+ Flags
31+ { _embed :: Bool
32+ , _fullscreen :: Bool
33+ }
34+
35+
36+run :: () -> Flags -> IO ()
37+run () flags =
38+ do reporter <- Terminal.create
39+ Task.run reporter $
40+ do approved <- Task.getApproval question
41+ if approved
42+ then init flags
43+ else liftIO $ putStrLn "TODO"
44+
45+
46+question :: D.Doc
47+question =
48+ D.stack
49+ [ "Hello! Elm projects are pretty simple. They include:"
50+ , D.indent 2 $ D.vcat $
51+ [ "1. " <> D.green "elm.json" <> D.black " ------------ describes your dependencies"
52+ , "2. " <> D.green "src/Main.elm" <> D.black " ------ a small Elm program to expand"
53+ ]
54+ , customReflow
55+ "Now you may be wondering, what will be in these files? How do I see\
56+ \ it in the browser? How will my code grow? Do I need more\
57+ \ directories? What about tests? Etc. Check out"
58+ (D.dullyellow (D.fromString (D.makeLink "init")))
59+ "for all the answers!"
60+ , "So, would you like me to create these two files now? [Y/n]: "
61+ ]
62+
63+
64+customReflow :: String -> D.Doc -> String -> D.Doc
65+customReflow before doc after =
66+ D.fillSep $
67+ map D.fromString (words before) ++ [doc] ++ map D.fromString (words after)
68+
69+
70+
71+-- INIT
72+
73+
74+init :: Flags -> Task.Task ()
75+init flags =
76+ case flags of
77+ Flags False False -> download "sandbox"
78+ Flags True False -> download "embed"
79+ Flags False True -> download "fullscreen"
80+ Flags _ _ -> Task.throw $ Exit.Init E.ClashingFlags
81+
82+
83+download :: String -> Task.Task ()
84+download projectType =
85+ do fetch (projectType ++ "/elm.json")
86+ fetch (projectType ++ "/src/Main.elm")
87+
88+
89+fetch :: FilePath -> Task.Task ()
90+fetch path =
91+ Http.run $
92+ Http.anything
93+ ("https://experiment.elm-lang.org/" ++ vsn ++ "/init/" ++ path)
94+ (\request manager ->
95+ do response <- Client.httpLbs request manager
96+ Right <$> LBS.writeFile path (Client.responseBody response)
97+ )
98+
99+
100+vsn :: String
101+vsn =
102+ Pkg.versionToString Compiler.version