Expose Outline source directories

builder/src/AbsoluteSrcDir.hs

@@ -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

builder/src/Build.hs

@@ -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 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 $ 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) =

builder/src/Gren/Outline.hs

@@ -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 =

gren.cabal

@@ -68,6 +68,7 @@ Executable gren
         Terminal.Internal
 
         -- from builder/
+        AbsoluteSrcDir
         Build
         BackgroundWriter
         Deps.Diff