Allow includes to be full path or mere package names
This commit is contained in:
parent
3ebe1040dd
commit
12fb295610
3 changed files with 26 additions and 4 deletions
|
@ -32,5 +32,6 @@ executable sjw
|
|||
, mtl
|
||||
, optparse-applicative
|
||||
, text
|
||||
, unix
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in a new issue