on 39ea786 help sign in
94 lines 2.3 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Elm.Project.Root
3 ( get
4 , unsafeGet
5 , getWithReplFallback
6 )
7 where
10import Control.Monad.Trans (liftIO)
11import qualified Data.Map as Map
12import qualified System.Directory as Dir
13import System.FilePath ((</>))
15import qualified Elm.Package as Pkg
16import qualified Elm.Project.Constraint as Con
17import qualified Elm.Project.Json as Project
18import qualified Elm.Project.Licenses as Licenses
19import qualified Elm.Project.Summary as Summary
20import qualified Elm.PerUserCache as PerUserCache
21import qualified File.IO as IO
22import qualified Reporting.Exit as Exit
23import qualified Reporting.Task as Task
24import qualified Stuff.Verify as Verify
25import qualified Json.Encode as Encode
29-- GET
32get :: Task.Task Summary.Summary
33get =
34 do root <- moveToRoot
35 project <- Project.read "elm.json"
36 Verify.verify root project
39unsafeGet :: Task.Task (FilePath, Project.Project)
40unsafeGet =
41 (,) <$> moveToRoot <*> Project.read "elm.json"
45-- MOVE TO ROOT
48moveToRoot :: Task.Task FilePath
49moveToRoot =
50 do maybeRoot <- liftIO $ IO.find "elm.json"
51 case maybeRoot of
52 Just root ->
53 do liftIO $ Dir.setCurrentDirectory root
54 return root
56 Nothing ->
57 Task.throw Exit.NoElmJson
61-- GET WITH FALLBACK
64getWithReplFallback :: IO FilePath
65getWithReplFallback =
66 do maybeRoot <- IO.find "elm.json"
68 case maybeRoot of
69 Just root ->
70 do Dir.setCurrentDirectory root
71 return root
73 Nothing ->
74 do cache <- PerUserCache.getReplRoot
75 let root = cache </> "tmp"
76 Dir.createDirectoryIfMissing True root
77 Dir.setCurrentDirectory root
78 IO.removeDir "elm-stuff"
79 Encode.write "elm.json" (Project.encode (Project.Pkg replInfo))
80 return root
83replInfo :: Project.PkgInfo
84replInfo =
85 Project.PkgInfo
86 { Project._pkg_name = Pkg.dummyName
87 , Project._pkg_summary = "dummy code for the REPL"
88 , Project._pkg_license = Licenses.bsd3
89 , Project._pkg_version = Pkg.dummyVersion
90 , Project._pkg_exposed = Project.ExposedList []
91 , Project._pkg_deps = Map.singleton Pkg.core Con.anything
92 , Project._pkg_test_deps = Map.empty
93 , Project._pkg_elm_version = Con.defaultElm
94 }