{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
module SJW (
      Source
    , Path(..)
    , compile
    , mainIs
    , source
  ) where

import Control.Applicative ((<|>))
import Control.Monad.Except (MonadError(..), runExceptT)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.RWS (evalRWST)
import qualified Data.Map as Map (empty)
import Data.Text (Text)
import qualified SJW.Compiler as Compiler (main)
import SJW.Dependencies (Failable)
import SJW.Module (Modules(..))
import SJW.Source (CodePath(..), Source(..), Path(..), source)
import System.Directory (doesDirectoryExist)
import System.Environment (lookupEnv)
import System.FilePath ((</>))
import System.Posix.User (getRealUserID, getUserEntryForID, homeDirectory)
import Text.Printf (printf)

compile :: Source -> IO (Either String (Text, [String]))
compile inputSource = runExceptT $ do
  checkedPackages <- check packages
  let checkedSource = inputSource {code = CodePath checkedPackages}
  evalRWST Compiler.main checkedSource emptyEnvironment
  where
    CodePath packages = code inputSource
    emptyEnvironment = Modules {
        modules = Map.empty
      }

mainIs :: Source -> String -> Source
mainIs context dotSeparated = context {mainModule = read dotSeparated}

(<||>) :: (Monad m) => m (Maybe a) -> a -> m a
(<||>) value defaultValue = maybe defaultValue id <$> value

dbDirectory :: MonadIO m => m FilePath
dbDirectory = liftIO $ do
  unixHome <- homeDirectory <$> (getUserEntryForID =<< getRealUserID)
  homeDB <- lookupEnv "HOME" <||> unixHome
  lookupEnv "SJW_PACKAGE_DB" <||> (homeDB </> ".sjw")

checkPath :: MonadIO m => FilePath -> m (Maybe FilePath)
checkPath filePath = liftIO $ do
  directoryExists <- doesDirectoryExist filePath
  return $ if directoryExists then Just filePath else Nothing

check :: (MonadIO m, Failable m) => [String] -> m [FilePath]
check names = do
  db <- dbDirectory
  mapM (pathOrPackageName db) names
  where
    notFound = throwError . printf "%s: package and directory not found"
    pathOrPackageName db name =
      (<|>) <$> checkPath name <*> checkPath (db </> name)
      >>= maybe (notFound name) return