--- SJW -- Clean Javascript modules for front-end development
--- Copyright © 2022 Tissevert <tissevert+devel@marvid.fr>
---
--- This file is part of SJW.
---
--- SJW is free software: you can redistribute it and/or modify it under the
--- terms of the GNU General Public License as published by the Free Software
--- Foundation, either version 3 of the License, or (at your option) any later
--- version.
---
--- SJW is distributed in the hope that it will be useful, but WITHOUT ANY
--- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
--- FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
--- details.
---
--- You should have received a copy of the GNU General Public License along
--- with this program.  If not, see <http://www.gnu.org/licenses/>.

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

import Control.Applicative ((<|>))
import Control.Monad (foldM)
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.IO (stderr, hPutStrLn)
import System.Posix.User (getRealUserID, getUserEntryForID, homeDirectory)
import Text.Printf (printf)

type Result = Either String (Text, [String])

compile :: Source -> IO Result
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
      }

sourceCode :: Result -> IO (Maybe Text)
sourceCode (Left errorMessage) = hPutStrLn stderr errorMessage >> return Nothing
sourceCode (Right (output, logs)) =
  mapM_ (hPutStrLn stderr) logs >> return (Just output)

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

getSearchPaths :: MonadIO m => m [FilePath]
getSearchPaths = liftIO $ do
  unixHome <- homeDirectory <$> (getUserEntryForID =<< getRealUserID)
  homeDB <- lookupEnv "HOME" <||> unixHome
  customDB <- lookupEnv "SJW_PACKAGE_DB" <||> (homeDB </> ".sjw")
  (fmap splitPath <$> lookupEnv "SJW_PATH") <||> [customDB]
  where
    splitPath = collect . break (== ':') . dropWhile (== ':')
    collect (before, []) = if null before then [] else [before]
    collect (before, after) = before:(splitPath after)

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
  searchPaths <- (".":) <$> getSearchPaths
  mapM (pathOrPackageName searchPaths) names
  where
    notFound = throwError . printf "%s: package and directory not found"
    pathOrPackageName paths name =
      foldM (\b -> fmap (b <|>) . checkPath) Nothing ((</> name) <$> paths)
      >>= maybe (notFound name) return