Also expose a function to retrieve source code while printing errors and logs and logs
This commit is contained in:
parent
5ddb22fa24
commit
7edf0ef23b
2 changed files with 14 additions and 9 deletions
12
src/Main.hs
12
src/Main.hs
|
@ -9,8 +9,7 @@ import Options.Applicative (
|
||||||
, short, strArgument, strOption, value
|
, short, strArgument, strOption, value
|
||||||
)
|
)
|
||||||
import Paths_SJW (version)
|
import Paths_SJW (version)
|
||||||
import SJW (Source, compile, mainIs, source)
|
import SJW (Source, compile, mainIs, source, sourceCode)
|
||||||
import System.IO (stderr, hPutStrLn)
|
|
||||||
|
|
||||||
data Config = Config {
|
data Config = Config {
|
||||||
includes :: [String]
|
includes :: [String]
|
||||||
|
@ -60,13 +59,10 @@ getSource (Config {includes, mainModuleName = Just moduleName, target}) =
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
config@(Config {outputFile}) <- getConfig
|
config@(Config {outputFile}) <- getConfig
|
||||||
result <- SJW.compile $ getSource config
|
result <- SJW.sourceCode =<< SJW.compile (getSource config)
|
||||||
case result of
|
case result of
|
||||||
Left errorMessage -> printErr errorMessage
|
Nothing -> return ()
|
||||||
Right (sourceCode, logs) -> do
|
Just code -> output outputFile $ Text.unpack code
|
||||||
mapM_ printErr logs
|
|
||||||
output outputFile . Text.unpack $ sourceCode
|
|
||||||
where
|
where
|
||||||
printErr = hPutStrLn stderr
|
|
||||||
output "-" = putStr
|
output "-" = putStr
|
||||||
output fileName = writeFile fileName
|
output fileName = writeFile fileName
|
||||||
|
|
11
src/SJW.hs
11
src/SJW.hs
|
@ -6,6 +6,7 @@ module SJW (
|
||||||
, compile
|
, compile
|
||||||
, mainIs
|
, mainIs
|
||||||
, source
|
, source
|
||||||
|
, sourceCode
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
|
@ -21,10 +22,13 @@ import SJW.Source (CodePath(..), Source(..), Path(..), source)
|
||||||
import System.Directory (doesDirectoryExist)
|
import System.Directory (doesDirectoryExist)
|
||||||
import System.Environment (lookupEnv)
|
import System.Environment (lookupEnv)
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
|
import System.IO (stderr, hPutStrLn)
|
||||||
import System.Posix.User (getRealUserID, getUserEntryForID, homeDirectory)
|
import System.Posix.User (getRealUserID, getUserEntryForID, homeDirectory)
|
||||||
import Text.Printf (printf)
|
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
|
compile inputSource = runExceptT $ do
|
||||||
checkedPackages <- check packages
|
checkedPackages <- check packages
|
||||||
let checkedSource = inputSource {code = CodePath checkedPackages}
|
let checkedSource = inputSource {code = CodePath checkedPackages}
|
||||||
|
@ -35,6 +39,11 @@ compile inputSource = runExceptT $ do
|
||||||
modules = Map.empty
|
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 :: Source -> String -> Source
|
||||||
mainIs context dotSeparated = context {mainModule = read dotSeparated}
|
mainIs context dotSeparated = context {mainModule = read dotSeparated}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue