3c61804 · elk · git.iko.soy

git.iko.soy/elk

track if srcDir is absolute or relative

These changes are necessary for when `elm make src/Main.elm` is run with (1) absolute source directories and (2) source directories that contain .. or . in them.

commit3c618045431de75d6029cb65997113247e4a23f7 authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 1 Aug 2019, 17:36 (7 years ago) parentc76acf6

5 files changed+207−86

compare with master

unifiedsplit

builder/src/Build.hs+83−68 builder/src/Elm/Details.hs+1−1 builder/src/Elm/Outline.hs+96−12 builder/src/Reporting/Exit.hs+26−4 terminal/src/Init.hs+1−1

builder/src/Build.hs+83−68

@@ -42,6 +42,7 @@ import qualified Elm.Details as Details

4242import qualified Elm.Docs as Docs

4343import qualified Elm.Interface as I

4444import qualified Elm.ModuleName as ModuleName

45+import qualified Elm.Outline as Outline

4546import qualified Elm.Package as Pkg

4647import qualified File

4748import qualified Json.Encode as E

@@ -65,21 +66,46 @@ data Env =

6566 { _key :: Reporting.BKey

6667 , _root :: FilePath

6768 , _project :: Parse.ProjectType

68− , _srcDirs :: [FilePath]

69+ , _srcDirs :: [AbsoluteSrcDir]

6970 , _buildID :: Details.BuildID

7071 , _locals :: Map.Map ModuleName.Raw Details.Local

7172 , _foreigns :: Map.Map ModuleName.Raw Details.Foreign

7273 }

7374

7475

75−makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> Env

76+makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> IO Env

7677makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =

7778 case validOutline of

78− Details.ValidApp srcDirs ->

79− Env key root Parse.Application (NE.toList srcDirs) buildID locals foreigns

79+ Details.ValidApp givenSrcDirs ->

80+ do srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs)

81+ return $ Env key root Parse.Application srcDirs buildID locals foreigns

8082

8183 Details.ValidPkg pkg _ _ ->

82− Env key root (Parse.Package pkg) ["src"] buildID locals foreigns

84+ do srcDir <- toAbsoluteSrcDir root (Outline.RelativeSrcDir "src")

85+ return $ Env key root (Parse.Package pkg) [srcDir] buildID locals foreigns

86+

87+

88+

89+-- SOURCE DIRECTORY

90+

91+

92+newtype AbsoluteSrcDir =

93+ AbsoluteSrcDir FilePath

94+

95+

96+toAbsoluteSrcDir :: FilePath -> Outline.SrcDir -> IO AbsoluteSrcDir

97+toAbsoluteSrcDir root srcDir =

98+ AbsoluteSrcDir <$> Dir.canonicalizePath

99+ (

100+ case srcDir of

101+ Outline.AbsoluteSrcDir dir -> dir

102+ Outline.RelativeSrcDir dir -> root </> dir

103+ )

104+

105+

106+addRelative :: AbsoluteSrcDir -> FilePath -> FilePath

107+addRelative (AbsoluteSrcDir srcDir) path =

108+ srcDir </> path

83109

84110

85111

@@ -110,7 +136,7 @@ forkWithKey func dict =

110136fromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)

111137fromExposed style root details docsGoal exposed@(NE.List e es) =

112138 Reporting.trackBuild style $ \key ->

113− do let env = makeEnv key root details

139+ do env <- makeEnv key root details

114140 dmvar <- Details.loadInterfaces root details

115141

116142 -- crawl

@@ -161,7 +187,7 @@ type Dependencies =

161187fromMains :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)

162188fromMains style root details paths =

163189 Reporting.trackBuild style $ \key ->

164− do let env = makeEnv key root details

190+ do env <- makeEnv key root details

165191

166192 elmains <- findMains env paths

167193 case elmains of

@@ -241,9 +267,8 @@ crawlDeps env mvar deps blockedValue =

241267crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status

242268crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar docsNeed name =

243269 do let fileName = ModuleName.toFilePath name <.> "elm"

244− let inRoot path = File.exists (root </> path)

245270

246− paths <- filterM inRoot (map (</> fileName) srcDirs)

271+ paths <- filterM File.exists (map (`addRelative` fileName) srcDirs)

247272

248273 case paths of

249274 [path] ->

@@ -263,7 +288,7 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do

263288 else crawlDeps env mvar deps (SCached local)

264289

265290 p1:p2:ps ->

266− return $ SBadImport $ Import.AmbiguousLocal p1 p2 ps

291+ return $ SBadImport $ Import.AmbiguousLocal (FP.makeRelative root p1) (FP.makeRelative root p2) (map (FP.makeRelative root) ps)

267292

268293 [] ->

269294 case Map.lookup name foreigns of

@@ -856,35 +881,33 @@ data ReplArtifacts =

856881

857882fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)

858883fromRepl root details source =

859− let

860− env@(Env _ _ projectType _ _ _ _) = makeEnv Reporting.ignorer root details

861− in

862− case Parse.fromByteString projectType source of

863− Left syntaxError ->

864− return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError

884+ do env@(Env _ _ projectType _ _ _ _) <- makeEnv Reporting.ignorer root details

885+ case Parse.fromByteString projectType source of

886+ Left syntaxError ->

887+ return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError

865888

866− Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->

867− do dmvar <- Details.loadInterfaces root details

889+ Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->

890+ do dmvar <- Details.loadInterfaces root details

868891

869− let deps = map Src.getImportName imports

870− mvar <- newMVar Map.empty

871− crawlDeps env mvar deps ()

892+ let deps = map Src.getImportName imports

893+ mvar <- newMVar Map.empty

894+ crawlDeps env mvar deps ()

872895

873− statuses <- traverse readMVar =<< readMVar mvar

874− midpoint <- checkMidpoint dmvar statuses

896+ statuses <- traverse readMVar =<< readMVar mvar

897+ midpoint <- checkMidpoint dmvar statuses

875898

876− case midpoint of

877− Left problem ->

878− return $ Left $ Exit.ReplProjectProblem problem

899+ case midpoint of

900+ Left problem ->

901+ return $ Left $ Exit.ReplProjectProblem problem

879902

880− Right foreigns ->

881− do rmvar <- newEmptyMVar

882− resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses

883− putMVar rmvar resultMVars

884− results <- traverse readMVar resultMVars

885− writeDetails root details results

886− depsStatus <- checkDeps root resultMVars deps 0

887− finalizeReplArtifacts env source modul depsStatus resultMVars results

903+ Right foreigns ->

904+ do rmvar <- newEmptyMVar

905+ resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses

906+ putMVar rmvar resultMVars

907+ results <- traverse readMVar resultMVars

908+ writeDetails root details results

909+ depsStatus <- checkDeps root resultMVars deps 0

910+ finalizeReplArtifacts env source modul depsStatus resultMVars results

888911

889912

890913finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)

@@ -997,45 +1020,39 @@ findLoc (Env _ root _ srcDirs _ _ _) path absolutePath =

9971020 return $ Left $ Exit.BP_WithBadExtension path

9981021 else

9991022 let

1000− roots = FP.splitDirectories root

1001− segments = FP.splitDirectories dirs ++ [final]

1023+ absoluteSegments = FP.splitDirectories dirs ++ [final]

10021024 in

1003− case dropPrefix roots segments of

1004− Nothing ->

1025+ case Maybe.mapMaybe (isInsideSrcDirByPath absoluteSegments) srcDirs of

1026+ [] ->

10051027 return $ Right $ Location absolutePath path (LOutside path)

10061028

1007− Just relativeSegments ->

1008− case Maybe.mapMaybe (isInsideSrcDirByPath relativeSegments) srcDirs of

1009− [] ->

1010− return $ Right $ Location absolutePath path (LOutside path)

1011−

1012− [(_, Right names)] ->

1013− do let name = Name.fromChars (List.intercalate "." names)

1014− matchingDirs <- filterM (isInsideSrcDirByName root names) srcDirs

1015− case matchingDirs of

1016− d1:d2:_ ->

1017− do let p1 = d1 </> FP.joinPath names <.> "elm"

1018− let p2 = d2 </> FP.joinPath names <.> "elm"

1019− return $ Left $ Exit.BP_MainNameDuplicate name p1 p2

1029+ [(_, Right names)] ->

1030+ do let name = Name.fromChars (List.intercalate "." names)

1031+ matchingDirs <- filterM (isInsideSrcDirByName names) srcDirs

1032+ case matchingDirs of

1033+ d1:d2:_ ->

1034+ do let p1 = addRelative d1 (FP.joinPath names <.> "elm")

1035+ let p2 = addRelative d2 (FP.joinPath names <.> "elm")

1036+ return $ Left $ Exit.BP_MainNameDuplicate name p1 p2

10201037

1021− _ ->

1022− return $ Right $ Location absolutePath path (LInside name)

1038+ _ ->

1039+ return $ Right $ Location absolutePath path (LInside name)

10231040

1024− [(s, Left names)] ->

1025− return $ Left $ Exit.BP_MainNameInvalid path s names

1041+ [(s, Left names)] ->

1042+ return $ Left $ Exit.BP_MainNameInvalid path s names

10261043

1027− (s1,_):(s2,_):_ ->

1028− return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2

1044+ (s1,_):(s2,_):_ ->

1045+ return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2

10291046

10301047

10311048

1032−isInsideSrcDirByName :: FilePath -> [String] -> FilePath -> IO Bool

1033−isInsideSrcDirByName root names srcDir =

1034− File.exists (root </> srcDir </> FP.joinPath names <.> "elm")

1049+isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool

1050+isInsideSrcDirByName names srcDir =

1051+ File.exists (addRelative srcDir (FP.joinPath names <.> "elm"))

10351052

10361053

1037−isInsideSrcDirByPath :: [String] -> FilePath -> Maybe (FilePath, Either [String] [String])

1038−isInsideSrcDirByPath segments srcDir =

1054+isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])

1055+isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =

10391056 case dropPrefix (FP.splitDirectories srcDir) segments of

10401057 Nothing ->

10411058 Nothing

@@ -1056,20 +1073,18 @@ isGoodName name =

10561073 Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars

10571074

10581075

1076+-- INVARIANT: Dir.canonicalizePath has been run on both inputs

1077+--

10591078dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]

10601079dropPrefix roots paths =

10611080 case roots of

10621081 [] ->

10631082 Just paths

10641083

1065− ".":rs ->

1066− dropPrefix rs paths

1067−

10681084 r:rs ->

10691085 case paths of

1070− [] -> Nothing

1071− ".":ps -> dropPrefix roots ps

1072− p:ps -> if r == p then dropPrefix rs ps else Nothing

1086+ [] -> Nothing

1087+ p:ps -> if r == p then dropPrefix rs ps else Nothing

10731088

10741089

10751090

builder/src/Elm/Details.hs+1−1

@@ -79,7 +79,7 @@ type BuildID = Word64

7979

8080

8181data ValidOutline

82− = ValidApp (NE.List FilePath)

82+ = ValidApp (NE.List Outline.SrcDir)

8383 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})

8484

8585

builder/src/Elm/Outline.hs+96−12

@@ -5,6 +5,7 @@ module Elm.Outline

55 , AppOutline(..)

66 , PkgOutline(..)

77 , Exposed(..)

8+ , SrcDir(..)

89 , read

910 , write

1011 , encode

@@ -16,11 +17,14 @@ module Elm.Outline

1617

1718

1819import Prelude hiding (read)

19−import Control.Monad (filterM)

20+import Control.Monad (filterM, liftM)

21+import Data.Binary (Binary, get, put, getWord8, putWord8)

2022import qualified Data.Map as Map

2123import qualified Data.NonEmptyList as NE

24+import qualified Data.OneOrMore as OneOrMore

2225import Foreign.Ptr (minusPtr)

2326import qualified System.Directory as Dir

27+import qualified System.FilePath as FP

2428import System.FilePath ((</>))

2529

2630import qualified Elm.Constraint as Con

@@ -49,7 +53,7 @@ data Outline

4953data AppOutline =

5054 AppOutline

5155 { _app_elm_version :: V.Version

52− , _app_source_dirs :: NE.List FilePath

56+ , _app_source_dirs :: NE.List SrcDir

5357 , _app_deps_direct :: Map.Map Pkg.Name V.Version

5458 , _app_deps_indirect :: Map.Map Pkg.Name V.Version

5559 , _app_test_direct :: Map.Map Pkg.Name V.Version

@@ -75,6 +79,11 @@ data Exposed

7579 | ExposedDict [(Json.String, [ModuleName.Raw])]

7680

7781

82+data SrcDir

83+ = AbsoluteSrcDir FilePath

84+ | RelativeSrcDir FilePath

85+

86+

7887

7988-- DEFAULTS

8089

@@ -117,7 +126,7 @@ encode outline =

117126 App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->

118127 E.object

119128 [ "type" ==> E.chars "application"

120− , "source-directories" ==> E.list E.chars (NE.toList srcDirs)

129+ , "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs)

121130 , "elm-version" ==> V.encode elm

122131 , "dependencies" ==>

123132 E.object

@@ -165,6 +174,13 @@ encodeDeps encodeValue deps =

165174 E.dict Pkg.toJsonString encodeValue deps

166175

167176

177+encodeSrcDir :: SrcDir -> E.Value

178+encodeSrcDir srcDir =

179+ case srcDir of

180+ AbsoluteSrcDir dir -> E.chars dir

181+ RelativeSrcDir dir -> E.chars dir

182+

183+

168184

169185-- PARSE AND VERIFY

170186

@@ -192,15 +208,58 @@ read root =

192208 return $ Left Exit.OutlineNoAppJson

193209

194210 | otherwise ->

195− do badDirs <- filterM (isBadSrcDir root) (NE.toList srcDirs)

196− case badDirs of

197− [] -> return $ Right outline

198− d:ds -> return $ Left (Exit.OutlineHasBadSrcDirs d ds)

211+ do badDirs <- filterM (isSrcDirMissing root) (NE.toList srcDirs)

212+ case map toGiven badDirs of

213+ d:ds ->

214+ return $ Left (Exit.OutlineHasMissingSrcDirs d ds)

215+

216+ [] ->

217+ do maybeDups <- detectDuplicates root (NE.toList srcDirs)

218+ case maybeDups of

219+ Nothing ->

220+ return $ Right outline

221+

222+ Just (canonicalDir, (dir1,dir2)) ->

223+ return $ Left (Exit.OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2)

224+

225+

226+isSrcDirMissing :: FilePath -> SrcDir -> IO Bool

227+isSrcDirMissing root srcDir =

228+ not <$> Dir.doesDirectoryExist (toAbsolute root srcDir)

229+

230+

231+toGiven :: SrcDir -> FilePath

232+toGiven srcDir =

233+ case srcDir of

234+ AbsoluteSrcDir dir -> dir

235+ RelativeSrcDir dir -> dir

236+

237+

238+toAbsolute :: FilePath -> SrcDir -> FilePath

239+toAbsolute root srcDir =

240+ case srcDir of

241+ AbsoluteSrcDir dir -> dir

242+ RelativeSrcDir dir -> root </> dir

199243

200244

201−isBadSrcDir :: FilePath -> FilePath -> IO Bool

202−isBadSrcDir root dir =

203− not <$> Dir.doesDirectoryExist (root </> dir)

245+detectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath)))

246+detectDuplicates root srcDirs =

247+ do pairs <- traverse (toPair root) srcDirs

248+ return $ Map.lookupMin $ Map.mapMaybe isDup $

249+ Map.fromListWith OneOrMore.more pairs

250+

251+

252+toPair :: FilePath -> SrcDir -> IO (FilePath, OneOrMore.OneOrMore FilePath)

253+toPair root srcDir =

254+ do key <- Dir.canonicalizePath (toAbsolute root srcDir)

255+ return (key, OneOrMore.one (toGiven srcDir))

256+

257+

258+isDup :: OneOrMore.OneOrMore FilePath -> Maybe (FilePath, FilePath)

259+isDup paths =

260+ case paths of

261+ OneOrMore.One _ -> Nothing

262+ OneOrMore.More a b -> Just (OneOrMore.getFirstTwo a b)

204263

205264

206265

@@ -278,9 +337,16 @@ depsDecoder valueDecoder =

278337 D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder

279338

280339

281−dirsDecoder :: Decoder (NE.List FilePath)

340+dirsDecoder :: Decoder (NE.List SrcDir)

282341dirsDecoder =

283− fmap Json.toChars <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs

342+ fmap (toSrcDir . Json.toChars) <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs

343+

344+

345+toSrcDir :: FilePath -> SrcDir

346+toSrcDir path =

347+ if FP.isRelative path

348+ then RelativeSrcDir path

349+ else AbsoluteSrcDir path

284350

285351

286352

@@ -321,3 +387,21 @@ boundParser bound tooLong =

321387 if len < bound

322388 then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)

323389 else cerr row newCol (\_ _ -> tooLong)

390+

391+

392+

393+-- BINARY

394+

395+

396+instance Binary SrcDir where

397+ put outline =

398+ case outline of

399+ AbsoluteSrcDir a -> putWord8 0 >> put a

400+ RelativeSrcDir a -> putWord8 1 >> put a

401+

402+ get =

403+ do n <- getWord8

404+ case n of

405+ 0 -> liftM AbsoluteSrcDir get

406+ 1 -> liftM RelativeSrcDir get

407+ _ -> fail "binary encoding of SrcDir was corrupted"

builder/src/Reporting/Exit.hs+26−4

@@ -948,7 +948,8 @@ toSolverReport problem =

948948

949949data Outline

950950 = OutlineHasBadStructure (Decode.Error OutlineProblem)

951− | OutlineHasBadSrcDirs FilePath [FilePath]

951+ | OutlineHasMissingSrcDirs FilePath [FilePath]

952+ | OutlineHasDuplicateSrcDirs FilePath FilePath FilePath

952953 | OutlineNoPkgCore

953954 | OutlineNoAppCore

954955 | OutlineNoAppJson

@@ -974,12 +975,12 @@ toOutlineReport problem =

974975 Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $

975976 Json.ExplicitReason "I ran into a problem with your elm.json file."

976977

977− OutlineHasBadSrcDirs dir dirs ->

978+ OutlineHasMissingSrcDirs dir dirs ->

978979 case dirs of

979980 [] ->

980981 Help.report "MISSING SOURCE DIRECTORY" (Just "elm.json")

981982 "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:"

982− [ D.indent 4 $ D.dullyellow $ D.fromChars dir

983+ [ D.indent 4 $ D.red $ D.fromChars dir

983984 , D.reflow $

984985 "I cannot find it though. Is it missing? Is there a typo?"

985986 ]

@@ -988,11 +989,32 @@ toOutlineReport problem =

988989 Help.report "MISSING SOURCE DIRECTORIES" (Just "elm.json")

989990 "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:"

990991 [ D.indent 4 $ D.vcat $

991− map (D.dullyellow . D.fromChars) (dir:dirs)

992+ map (D.red . D.fromChars) (dir:dirs)

992993 , D.reflow $

993994 "I cannot find them though. Are they missing? Are there typos?"

994995 ]

995996

997+ OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2 ->

998+ if dir1 == dir2 then

999+ Help.report "REDUNDANT SOURCE DIRECTORIES" (Just "elm.json")

1000+ "I need a valid elm.json file, but the \"source-directories\" field lists the same directory twice:"

1001+ [ D.indent 4 $ D.vcat $

1002+ map (D.red . D.fromChars) [dir1,dir2]

1003+ , D.reflow $

1004+ "Remove one of the entries!"

1005+ ]

1006+ else

1007+ Help.report "REDUNDANT SOURCE DIRECTORIES" (Just "elm.json")

1008+ "I need a valid elm.json file, but the \"source-directories\" field has some redundant directories:"

1009+ [ D.indent 4 $ D.vcat $

1010+ map (D.red . D.fromChars) [dir1,dir2]

1011+ , D.reflow $

1012+ "These are two different ways of refering to the same directory:"

1013+ , D.indent 4 $ D.dullyellow $ D.fromChars canonicalDir

1014+ , D.reflow $

1015+ "Remove one of the redundant entries from your \"source-directories\" field."

1016+ ]

1017+

9961018 OutlineNoPkgCore ->

9971019 Help.report "MISSING DEPENDENCY" (Just "elm.json")

9981020 "I need to see an \"elm/core\" dependency your elm.json file. The default imports\

terminal/src/Init.hs+1−1

@@ -90,7 +90,7 @@ init =

9090 in

9191 do Dir.createDirectoryIfMissing True "src"

9292 Outline.write "." $ Outline.App $

93− Outline.AppOutline V.compiler (NE.List "src" []) directs indirects Map.empty Map.empty

93+ Outline.AppOutline V.compiler (NE.List (Outline.RelativeSrcDir "src") []) directs indirects Map.empty Map.empty

9494 putStrLn "Okay, I created it. Now read that link!"

9595 return (Right ())

9696