90 lines
3.3 KiB
Haskell
90 lines
3.3 KiB
Haskell
--- 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
|
|
) 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.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
|
|
}
|
|
|
|
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
|