diff --git a/SJW.cabal b/SJW.cabal index a572918..58b7440 100644 --- a/SJW.cabal +++ b/SJW.cabal @@ -32,5 +32,6 @@ executable sjw , mtl , optparse-applicative , text + , unix hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Context.hs b/src/Context.hs index a8cd742..c0ed04a 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 0e4c9a1..ea3ece5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 }