on 32ff950 help sign in
95 lines 2.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Project.Root
4 ( get
5 , unsafeGet
6 , getWithReplFallback
7 )
8 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 Elm.Project.Json (Project(..), PkgInfo(..))
20import Elm.Project.Summary (Summary)
21import qualified Elm.PerUserCache as PerUserCache
22import qualified File.IO as IO
23import qualified Reporting.Error2 as Error
24import qualified Reporting.Task as Task
25import qualified Stuff.Verify as Verify
26import qualified Json.Encode as Encode
30-- GET
33get :: Task.Task Summary
34get =
35 do root <- moveToRoot
36 project <- Project.read "elm.json"
37 Verify.verify root project
40unsafeGet :: Task.Task (FilePath, Project)
41unsafeGet =
42 (,) <$> moveToRoot <*> Project.read "elm.json"
46-- MOVE TO ROOT
49moveToRoot :: Task.Task FilePath
50moveToRoot =
51 do maybeRoot <- liftIO $ IO.find "elm.json"
52 case maybeRoot of
53 Just root ->
54 do liftIO $ Dir.setCurrentDirectory root
55 return root
57 Nothing ->
58 Task.throw Error.NoElmJson
62-- GET WITH FALLBACK
65getWithReplFallback :: IO FilePath
66getWithReplFallback =
67 do maybeRoot <- IO.find "elm.json"
69 case maybeRoot of
70 Just root ->
71 do Dir.setCurrentDirectory root
72 return root
74 Nothing ->
75 do cache <- PerUserCache.getReplRoot
76 let root = cache </> "tmp"
77 Dir.createDirectoryIfMissing True root
78 Dir.setCurrentDirectory root
79 IO.removeDir "elm-stuff"
80 Encode.write "elm.json" (Project.encode (Pkg replInfo))
81 return root
84replInfo :: PkgInfo
85replInfo =
86 PkgInfo
87 { _pkg_name = Pkg.dummyName
88 , _pkg_summary = "dummy code for the REPL"
89 , _pkg_license = Licenses.bsd3
90 , _pkg_version = Pkg.dummyVersion
91 , _pkg_exposed = Project.ExposedList []
92 , _pkg_deps = Map.singleton Pkg.core Con.anything
93 , _pkg_test_deps = Map.empty
94 , _pkg_elm_version = Con.defaultElm
95 }