{-# LANGUAGE ConstraintKinds #-}
module Context (
      CodePath(..)
    , Context(..)
    , Contextual
    , Path(..)
    , packages
  ) where

import Control.Monad.Reader (MonadReader)
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
  }

type Contextual = MonadReader Context

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