SJW/src/Context.hs

55 lines
1.5 KiB
Haskell

module Context (
CodePath(..)
, 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)
newtype Path = Path [String]
newtype CodePath = CodePath [FilePath]
type Dependencies = Map Path [Path]
data Context = Context {
codePaths :: CodePath
, mainModule :: Path
}
type Contextual = RWST Context [String] Dependencies IO
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