mirror of
https://github.com/gren-lang/compiler.git
synced 2024-10-26 18:00:47 +03:00
Expose Outline source directories
This commit is contained in:
parent
969a98844e
commit
215609cdc4
25
builder/src/AbsoluteSrcDir.hs
Normal file
25
builder/src/AbsoluteSrcDir.hs
Normal file
@ -0,0 +1,25 @@
|
||||
module AbsoluteSrcDir
|
||||
( AbsoluteSrcDir (..),
|
||||
mkAbsoluteSrcDir,
|
||||
addRelative,
|
||||
toFilePath,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified System.Directory as Dir
|
||||
import System.FilePath ((</>))
|
||||
|
||||
newtype AbsoluteSrcDir
|
||||
= AbsoluteSrcDir FilePath
|
||||
|
||||
toFilePath :: AbsoluteSrcDir -> FilePath
|
||||
toFilePath (AbsoluteSrcDir path) = path
|
||||
|
||||
mkAbsoluteSrcDir :: FilePath -> IO AbsoluteSrcDir
|
||||
mkAbsoluteSrcDir srcDir =
|
||||
AbsoluteSrcDir
|
||||
<$> Dir.canonicalizePath srcDir
|
||||
|
||||
addRelative :: AbsoluteSrcDir -> FilePath -> FilePath
|
||||
addRelative (AbsoluteSrcDir srcDir) path =
|
||||
srcDir </> path
|
@ -20,6 +20,8 @@ where
|
||||
import qualified AST.Canonical as Can
|
||||
import qualified AST.Optimized as Opt
|
||||
import qualified AST.Source as Src
|
||||
import AbsoluteSrcDir (AbsoluteSrcDir (..))
|
||||
import qualified AbsoluteSrcDir
|
||||
import qualified Compile
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Concurrent.MVar
|
||||
@ -75,31 +77,13 @@ makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =
|
||||
case validOutline of
|
||||
Details.ValidApp givenSrcDirs ->
|
||||
do
|
||||
srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs)
|
||||
srcDirs <- traverse (Outline.toAbsoluteSrcDir root) (NE.toList givenSrcDirs)
|
||||
return $ Env key root Parse.Application srcDirs buildID locals foreigns
|
||||
Details.ValidPkg pkg _ _ ->
|
||||
do
|
||||
srcDir <- toAbsoluteSrcDir root (Outline.RelativeSrcDir "src")
|
||||
srcDir <- Outline.toAbsoluteSrcDir root (Outline.RelativeSrcDir "src")
|
||||
return $ Env key root (Parse.Package pkg) [srcDir] buildID locals foreigns
|
||||
|
||||
-- SOURCE DIRECTORY
|
||||
|
||||
newtype AbsoluteSrcDir
|
||||
= AbsoluteSrcDir FilePath
|
||||
|
||||
toAbsoluteSrcDir :: FilePath -> Outline.SrcDir -> IO AbsoluteSrcDir
|
||||
toAbsoluteSrcDir root srcDir =
|
||||
AbsoluteSrcDir
|
||||
<$> Dir.canonicalizePath
|
||||
( case srcDir of
|
||||
Outline.AbsoluteSrcDir dir -> dir
|
||||
Outline.RelativeSrcDir dir -> root </> dir
|
||||
)
|
||||
|
||||
addRelative :: AbsoluteSrcDir -> FilePath -> FilePath
|
||||
addRelative (AbsoluteSrcDir srcDir) path =
|
||||
srcDir </> path
|
||||
|
||||
-- FORK
|
||||
|
||||
-- PERF try using IORef semephore on file crawl phase?
|
||||
@ -242,7 +226,7 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do
|
||||
do
|
||||
let fileName = ModuleName.toFilePath name <.> "gren"
|
||||
|
||||
paths <- filterM File.exists (map (`addRelative` fileName) srcDirs)
|
||||
paths <- filterM File.exists (map (`AbsoluteSrcDir.addRelative` fileName) srcDirs)
|
||||
|
||||
case paths of
|
||||
[path] ->
|
||||
@ -899,8 +883,8 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
|
||||
case matchingDirs of
|
||||
d1 : d2 : _ ->
|
||||
do
|
||||
let p1 = addRelative d1 (FP.joinPath names <.> "gren")
|
||||
let p2 = addRelative d2 (FP.joinPath names <.> "gren")
|
||||
let p1 = AbsoluteSrcDir.addRelative d1 (FP.joinPath names <.> "gren")
|
||||
let p2 = AbsoluteSrcDir.addRelative d2 (FP.joinPath names <.> "gren")
|
||||
return $ Left $ Exit.BP_RootNameDuplicate name p1 p2
|
||||
_ ->
|
||||
return $ Right $ RootInfo absolutePath path (LInside name)
|
||||
@ -911,7 +895,7 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
|
||||
|
||||
isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool
|
||||
isInsideSrcDirByName names srcDir =
|
||||
File.exists (addRelative srcDir (FP.joinPath names <.> "gren"))
|
||||
File.exists (AbsoluteSrcDir.addRelative srcDir (FP.joinPath names <.> "gren"))
|
||||
|
||||
isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])
|
||||
isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =
|
||||
|
@ -14,9 +14,14 @@ module Gren.Outline
|
||||
decoder,
|
||||
defaultSummary,
|
||||
flattenExposed,
|
||||
toAbsoluteSrcDir,
|
||||
sourceDirs,
|
||||
testDirs,
|
||||
)
|
||||
where
|
||||
|
||||
import AbsoluteSrcDir (AbsoluteSrcDir)
|
||||
import qualified AbsoluteSrcDir
|
||||
import Control.Monad (filterM, liftM)
|
||||
import Data.Binary (Binary, get, getWord8, put, putWord8)
|
||||
import qualified Data.Map as Map
|
||||
@ -204,6 +209,10 @@ toAbsolute root srcDir =
|
||||
AbsoluteSrcDir dir -> dir
|
||||
RelativeSrcDir dir -> root </> dir
|
||||
|
||||
toAbsoluteSrcDir :: FilePath -> SrcDir -> IO AbsoluteSrcDir
|
||||
toAbsoluteSrcDir root srcDir =
|
||||
AbsoluteSrcDir.mkAbsoluteSrcDir (toAbsolute root srcDir)
|
||||
|
||||
detectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath)))
|
||||
detectDuplicates root srcDirs =
|
||||
do
|
||||
@ -225,6 +234,18 @@ isDup paths =
|
||||
OneOrMore.One _ -> Nothing
|
||||
OneOrMore.More a b -> Just (OneOrMore.getFirstTwo a b)
|
||||
|
||||
sourceDirs :: Outline -> NE.List SrcDir
|
||||
sourceDirs outline =
|
||||
case outline of
|
||||
App (AppOutline _ srcDirs _ _ _ _) ->
|
||||
srcDirs
|
||||
Pkg _ ->
|
||||
NE.singleton (RelativeSrcDir "src")
|
||||
|
||||
testDirs :: Outline -> NE.List SrcDir
|
||||
testDirs _ =
|
||||
NE.singleton (RelativeSrcDir "tests")
|
||||
|
||||
-- JSON DECODE
|
||||
|
||||
type Decoder a =
|
||||
|
@ -68,6 +68,7 @@ Executable gren
|
||||
Terminal.Internal
|
||||
|
||||
-- from builder/
|
||||
AbsoluteSrcDir
|
||||
Build
|
||||
BackgroundWriter
|
||||
Deps.Diff
|
||||
|
Loading…
Reference in New Issue
Block a user