49 lines
1.3 KiB
Haskell
49 lines
1.3 KiB
Haskell
module Context (
|
|
CodePath(..)
|
|
, Context(..)
|
|
, Path(..)
|
|
, packages
|
|
) where
|
|
|
|
import Data.List (intercalate)
|
|
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)
|
|
|
|
newtype Path = Path [String] deriving (Eq, Ord)
|
|
newtype CodePath = CodePath [FilePath]
|
|
|
|
data Context = Context {
|
|
codePaths :: CodePath
|
|
, mainModule :: Path
|
|
}
|
|
|
|
instance Show Path where
|
|
show (Path components) = intercalate "." components
|
|
|
|
instance Read Path where
|
|
readPrec = fmap Path . lift $
|
|
munch (/= '.') `sepBy` char '.'
|
|
|
|
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
|