git.iko.soy/elk
on 071556d help sign in
elk/builder/src/Elm/Project/Root.hs
132 lines 3.9 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Elm.Project.Root
3 ( get
4 , unsafeGet
5 , getWithReplFallback
6 )
7 where
9import Control.Monad.Trans (liftIO)
10import qualified Data.ByteString.Lazy as LBS
11import qualified Data.Map as Map
12import Data.Monoid ((<>))
13import qualified Network.HTTP.Client as Client
14import qualified System.Directory as Dir
15import System.FilePath ((</>))
17import qualified Elm.Compiler.Version as Elm
18import qualified Elm.Package as Pkg
19import qualified Elm.Project.Constraint as Con
20import qualified Elm.Project.Json as Project
21import qualified Elm.Project.Licenses as Licenses
22import Elm.Project.Json (Project(..), PkgInfo(..))
23import Elm.Project.Summary (Summary)
24import qualified Elm.PerUserCache as PerUserCache
25import qualified File.IO as IO
26import qualified Reporting.Doc as D
27import qualified Reporting.Exit as Exit
28import qualified Reporting.Progress as Progress
29import qualified Reporting.Task as Task
30import qualified Reporting.Task.Http as Http
31import qualified Stuff.Verify as Verify
32import qualified Json.Encode as Encode
36-- GET
39get :: Task.Task Summary
40get =
41 do root <- moveToRoot
42 project <- Project.read "elm.json"
43 Verify.verify root project
46unsafeGet :: Task.Task (FilePath, Project)
47unsafeGet =
48 (,) <$> moveToRoot <*> Project.read "elm.json"
52-- MOVE TO ROOT
55moveToRoot :: Task.Task FilePath
56moveToRoot =
57 do maybeRoot <- liftIO $ IO.find "elm.json"
58 case maybeRoot of
59 Just root ->
60 do liftIO $ Dir.setCurrentDirectory root
61 return root
63 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 ]
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
87fetch :: FilePath -> Task.Task ()
88fetch 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 )
99-- GET WITH FALLBACK
102getWithReplFallback :: IO FilePath
103getWithReplFallback =
104 do maybeRoot <- IO.find "elm.json"
106 case maybeRoot of
107 Just root ->
108 do Dir.setCurrentDirectory root
109 return root
111 Nothing ->
112 do cache <- PerUserCache.getReplRoot
113 let root = cache </> "tmp"
114 Dir.createDirectoryIfMissing True root
115 Dir.setCurrentDirectory root
116 IO.removeDir "elm-stuff"
117 Encode.write "elm.json" (Project.encode (Pkg replInfo))
118 return root
121replInfo :: PkgInfo
122replInfo =
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
132 }