mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 16:56:29 +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.Canonical as Can
|
||||||
import qualified AST.Optimized as Opt
|
import qualified AST.Optimized as Opt
|
||||||
import qualified AST.Source as Src
|
import qualified AST.Source as Src
|
||||||
|
import AbsoluteSrcDir (AbsoluteSrcDir (..))
|
||||||
|
import qualified AbsoluteSrcDir
|
||||||
import qualified Compile
|
import qualified Compile
|
||||||
import Control.Concurrent (forkIO)
|
import Control.Concurrent (forkIO)
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
@ -75,31 +77,13 @@ makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =
|
|||||||
case validOutline of
|
case validOutline of
|
||||||
Details.ValidApp givenSrcDirs ->
|
Details.ValidApp givenSrcDirs ->
|
||||||
do
|
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
|
return $ Env key root Parse.Application srcDirs buildID locals foreigns
|
||||||
Details.ValidPkg pkg _ _ ->
|
Details.ValidPkg pkg _ _ ->
|
||||||
do
|
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
|
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
|
-- FORK
|
||||||
|
|
||||||
-- PERF try using IORef semephore on file crawl phase?
|
-- 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
|
do
|
||||||
let fileName = ModuleName.toFilePath name <.> "gren"
|
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
|
case paths of
|
||||||
[path] ->
|
[path] ->
|
||||||
@ -899,8 +883,8 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
|
|||||||
case matchingDirs of
|
case matchingDirs of
|
||||||
d1 : d2 : _ ->
|
d1 : d2 : _ ->
|
||||||
do
|
do
|
||||||
let p1 = addRelative d1 (FP.joinPath names <.> "gren")
|
let p1 = AbsoluteSrcDir.addRelative d1 (FP.joinPath names <.> "gren")
|
||||||
let p2 = addRelative d2 (FP.joinPath names <.> "gren")
|
let p2 = AbsoluteSrcDir.addRelative d2 (FP.joinPath names <.> "gren")
|
||||||
return $ Left $ Exit.BP_RootNameDuplicate name p1 p2
|
return $ Left $ Exit.BP_RootNameDuplicate name p1 p2
|
||||||
_ ->
|
_ ->
|
||||||
return $ Right $ RootInfo absolutePath path (LInside name)
|
return $ Right $ RootInfo absolutePath path (LInside name)
|
||||||
@ -911,7 +895,7 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
|
|||||||
|
|
||||||
isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool
|
isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool
|
||||||
isInsideSrcDirByName names srcDir =
|
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 :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])
|
||||||
isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =
|
isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =
|
||||||
|
@ -14,9 +14,14 @@ module Gren.Outline
|
|||||||
decoder,
|
decoder,
|
||||||
defaultSummary,
|
defaultSummary,
|
||||||
flattenExposed,
|
flattenExposed,
|
||||||
|
toAbsoluteSrcDir,
|
||||||
|
sourceDirs,
|
||||||
|
testDirs,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import AbsoluteSrcDir (AbsoluteSrcDir)
|
||||||
|
import qualified AbsoluteSrcDir
|
||||||
import Control.Monad (filterM, liftM)
|
import Control.Monad (filterM, liftM)
|
||||||
import Data.Binary (Binary, get, getWord8, put, putWord8)
|
import Data.Binary (Binary, get, getWord8, put, putWord8)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
@ -204,6 +209,10 @@ toAbsolute root srcDir =
|
|||||||
AbsoluteSrcDir dir -> dir
|
AbsoluteSrcDir dir -> dir
|
||||||
RelativeSrcDir dir -> root </> 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 :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath)))
|
||||||
detectDuplicates root srcDirs =
|
detectDuplicates root srcDirs =
|
||||||
do
|
do
|
||||||
@ -225,6 +234,18 @@ isDup paths =
|
|||||||
OneOrMore.One _ -> Nothing
|
OneOrMore.One _ -> Nothing
|
||||||
OneOrMore.More a b -> Just (OneOrMore.getFirstTwo a b)
|
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
|
-- JSON DECODE
|
||||||
|
|
||||||
type Decoder a =
|
type Decoder a =
|
||||||
|
@ -68,6 +68,7 @@ Executable gren
|
|||||||
Terminal.Internal
|
Terminal.Internal
|
||||||
|
|
||||||
-- from builder/
|
-- from builder/
|
||||||
|
AbsoluteSrcDir
|
||||||
Build
|
Build
|
||||||
BackgroundWriter
|
BackgroundWriter
|
||||||
Deps.Diff
|
Deps.Diff
|
||||||
|
Loading…
Reference in New Issue
Block a user