diff --git a/src/Main.hs b/src/Main.hs index 9750e8e..48a2dc9 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -9,8 +9,7 @@ import Options.Applicative ( , short, strArgument, strOption, value ) import Paths_SJW (version) -import SJW (Source, compile, mainIs, source) -import System.IO (stderr, hPutStrLn) +import SJW (Source, compile, mainIs, source, sourceCode) data Config = Config { includes :: [String] @@ -60,13 +59,10 @@ getSource (Config {includes, mainModuleName = Just moduleName, target}) = main :: IO () main = do config@(Config {outputFile}) <- getConfig - result <- SJW.compile $ getSource config + result <- SJW.sourceCode =<< SJW.compile (getSource config) case result of - Left errorMessage -> printErr errorMessage - Right (sourceCode, logs) -> do - mapM_ printErr logs - output outputFile . Text.unpack $ sourceCode + Nothing -> return () + Just code -> output outputFile $ Text.unpack code where - printErr = hPutStrLn stderr output "-" = putStr output fileName = writeFile fileName diff --git a/src/SJW.hs b/src/SJW.hs index 354819c..ce6dd92 100644 --- a/src/SJW.hs +++ b/src/SJW.hs @@ -6,6 +6,7 @@ module SJW ( , compile , mainIs , source + , sourceCode ) where import Control.Applicative ((<|>)) @@ -21,10 +22,13 @@ 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) -compile :: Source -> IO (Either String (Text, [String])) +type Result = Either String (Text, [String]) + +compile :: Source -> IO Result compile inputSource = runExceptT $ do checkedPackages <- check packages let checkedSource = inputSource {code = CodePath checkedPackages} @@ -35,6 +39,11 @@ compile inputSource = runExceptT $ do 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}