Allow includes to be full path or mere package names

This commit is contained in:
Tissevert 2019-12-30 13:06:54 +01:00
parent 3ebe1040dd
commit 12fb295610
3 changed files with 26 additions and 4 deletions

View File

@ -32,5 +32,6 @@ executable sjw
, mtl
, optparse-applicative
, text
, unix
hs-source-dirs: src
default-language: Haskell2010

View File

@ -3,11 +3,16 @@ module Context (
, Context(..)
, Contextual
, Path(..)
, packages
) where
import Control.Monad.RWS (RWST)
import Data.List (intercalate)
import Data.Map (Map)
import System.Directory (doesDirectoryExist)
import System.Environment (lookupEnv)
import System.FilePath ((</>))
import System.Posix.User (getRealUserID, getUserEntryForID, homeDirectory)
import Text.ParserCombinators.ReadP (char, munch, sepBy)
import Text.ParserCombinators.ReadPrec (lift)
import Text.Read (readPrec)
@ -32,3 +37,18 @@ instance Read Path where
instance Show CodePath where
show (CodePath dirs) = intercalate ":" dirs
dbDirectory :: IO FilePath
dbDirectory = do
unixHome <- homeDirectory <$> (getUserEntryForID =<< getRealUserID)
home <- maybe unixHome id <$> lookupEnv "HOME"
maybe (home </> ".sjw") id <$> lookupEnv "SJW_PACKAGE_DB"
packages :: [String] -> IO [FilePath]
packages names = do
db <- dbDirectory
mapM (pathOrPackageName db) names
where
pathOrPackageName db name = do
directoryExists <- doesDirectoryExist name
return $ if directoryExists then name else db </> name

View File

@ -2,7 +2,7 @@
module Main where
import qualified Compiler (main)
import Context (CodePath(..), Context (..), Path(..))
import Context (CodePath(..), Context (..), Path(..), packages)
import Control.Applicative (many, optional)
import Control.Monad.RWS (evalRWST)
import qualified Data.Map as Map (empty)
@ -18,7 +18,7 @@ import qualified Paths_SJW as SJW (version)
import System.IO (stderr, hPutStrLn)
data Config = Config {
includes :: [FilePath]
includes :: [String]
, mainIs :: String
, outputFile :: FilePath
, target :: FilePath
@ -58,9 +58,10 @@ getConfig = execParser $
(fullDesc <> header ("SJW v" ++ showVersion SJW.version))
runCompiler :: Config -> IO (Text, [String])
runCompiler (Config {includes, mainIs, target}) =
runCompiler (Config {includes, mainIs, target}) = do
codePaths <- CodePath . (target:) <$> packages includes
flip (evalRWST Compiler.main) Map.empty $ Context {
codePaths = CodePath (target : includes)
codePaths
, mainModule = read mainIs
}