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
|
, mtl
|
||||||
, optparse-applicative
|
, optparse-applicative
|
||||||
, text
|
, text
|
||||||
|
, unix
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -3,11 +3,16 @@ module Context (
|
||||||
, Context(..)
|
, Context(..)
|
||||||
, Contextual
|
, Contextual
|
||||||
, Path(..)
|
, Path(..)
|
||||||
|
, packages
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.RWS (RWST)
|
import Control.Monad.RWS (RWST)
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import Data.Map (Map)
|
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.ReadP (char, munch, sepBy)
|
||||||
import Text.ParserCombinators.ReadPrec (lift)
|
import Text.ParserCombinators.ReadPrec (lift)
|
||||||
import Text.Read (readPrec)
|
import Text.Read (readPrec)
|
||||||
|
@ -32,3 +37,18 @@ instance Read Path where
|
||||||
|
|
||||||
instance Show CodePath where
|
instance Show CodePath where
|
||||||
show (CodePath dirs) = intercalate ":" dirs
|
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
|
module Main where
|
||||||
|
|
||||||
import qualified Compiler (main)
|
import qualified Compiler (main)
|
||||||
import Context (CodePath(..), Context (..), Path(..))
|
import Context (CodePath(..), Context (..), Path(..), packages)
|
||||||
import Control.Applicative (many, optional)
|
import Control.Applicative (many, optional)
|
||||||
import Control.Monad.RWS (evalRWST)
|
import Control.Monad.RWS (evalRWST)
|
||||||
import qualified Data.Map as Map (empty)
|
import qualified Data.Map as Map (empty)
|
||||||
|
@ -18,7 +18,7 @@ import qualified Paths_SJW as SJW (version)
|
||||||
import System.IO (stderr, hPutStrLn)
|
import System.IO (stderr, hPutStrLn)
|
||||||
|
|
||||||
data Config = Config {
|
data Config = Config {
|
||||||
includes :: [FilePath]
|
includes :: [String]
|
||||||
, mainIs :: String
|
, mainIs :: String
|
||||||
, outputFile :: FilePath
|
, outputFile :: FilePath
|
||||||
, target :: FilePath
|
, target :: FilePath
|
||||||
|
@ -58,9 +58,10 @@ getConfig = execParser $
|
||||||
(fullDesc <> header ("SJW v" ++ showVersion SJW.version))
|
(fullDesc <> header ("SJW v" ++ showVersion SJW.version))
|
||||||
|
|
||||||
runCompiler :: Config -> IO (Text, [String])
|
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 {
|
flip (evalRWST Compiler.main) Map.empty $ Context {
|
||||||
codePaths = CodePath (target : includes)
|
codePaths
|
||||||
, mainModule = read mainIs
|
, mainModule = read mainIs
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue