@@ -15,84 +15,94 @@
1515{-# LANGUAGE DataKinds #-}
1616{-# LANGUAGE FlexibleContexts #-}
1717{-# LANGUAGE RecordWildCards #-}
18+{-# LANGUAGE ScopedTypeVariables #-}
1819{-# LANGUAGE TupleSections #-}
1920
2021module Main where
2122
22−import Control.Applicative
23−import Control.Monad
24−import Control.Monad.Error.Class (MonadError(..))
25−import Control.Monad.Writer.Strict
23+import Control.Applicative
24+import Control.Monad
25+import Control.Monad.Writer.Strict
2626
27−import Data.Version (showVersion)
27+import qualified Data.Aeson as A
28+import qualified Data.ByteString.Lazy as B
29+import qualified Data.ByteString.UTF8 as BU8
2830import qualified Data.Map as M
31+import Data.Version (showVersion)
2932
30−import Options.Applicative as Opts
33+import qualified Language.PureScript as P
34+import Language.PureScript.Errors.JSON
35+import Language.PureScript.Make
3136
32−import System.Exit (exitSuccess, exitFailure)
33−import System.IO (hPutStrLn, stderr)
34−import System.IO.UTF8
37+import Options.Applicative as Opts
3538
36−import qualified Language.PureScript as P
3739import qualified Paths_purescript as Paths
3840
39−import Make
40−import Makefile
41+import System.Exit (exitSuccess, exitFailure)
42+import System.FilePath.Glob (glob)
43+import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)
44+import System.IO.UTF8
4145
42−data PCCOptions = PCCOptions
46+data PCCMakeOptions = PCCMakeOptions
4347 { pccmInput :: [FilePath]
44− , pccmForeignInput :: [FilePath]
4548 , pccmOutputDir :: FilePath
4649 , pccmOpts :: P.Options
4750 , pccmUsePrefix :: Bool
51+ , pccmJSONErrors :: Bool
4852 }
4953
50−data InputOptions = InputOptions
51− { ioInputFiles :: [FilePath]
52− }
53−
54−compile :: PCCOptions -> IO ()
55−compile (PCCOptions input _ outputDir opts usePrefix) = do
56− when (null input) generateMakefile
57− moduleFiles <- readInput (InputOptions input)
58− case runWriterT (parseInputs moduleFiles []) of
54+-- | Argumnets: verbose, use JSON, warnings, errors
55+printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()
56+printWarningsAndErrors verbose False warnings errors = do
57+ when (P.nonEmpty warnings) $
58+ hPutStrLn stderr (P.prettyPrintMultipleWarnings verbose warnings)
59+ case errors of
5960 Left errs -> do
60− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
61+ hPutStrLn stderr (P.prettyPrintMultipleErrors verbose errs)
6162 exitFailure
62− Right ((ms, _), warnings) -> do
63− when (P.nonEmpty warnings) $
64− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
65− let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
66− makeActions = buildMakeActions outputDir filePathMap usePrefix
67− (e, warnings') <- runMake opts $ P.make makeActions (map snd ms)
68− case e of
69− Left errs -> do
70− putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
71− exitFailure
72− Right _ -> exitSuccess
73−
74−readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
75−readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
76−
77−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
78− => [(Either P.RebuildPolicy FilePath, String)]
79− -> [(FilePath, P.ForeignJS)]
80− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)
81−parseInputs modules foreigns =
82− (,) <$> P.parseModulesFromFiles (either (const "") id) modules
83− <*> P.parseForeignModulesFromFiles foreigns
63+ Right _ -> return ()
64+printWarningsAndErrors verbose True warnings errors = do
65+ hPutStrLn stderr . BU8.toString . B.toStrict . A.encode $
66+ JSONResult (toJSONErrors verbose P.Warning warnings)
67+ (either (toJSONErrors verbose P.Error) (const []) errors)
68+ either (const exitFailure) (const (return ())) errors
69+
70+compile :: PCCMakeOptions -> IO ()
71+compile PCCMakeOptions{..} = do
72+ input <- globWarningOnMisses (unless pccmJSONErrors . warnFileTypeNotFound) pccmInput
73+ when (null input && not pccmJSONErrors) $ do
74+ hPutStrLn stderr "pcc: No input files."
75+ exitFailure
76+ moduleFiles <- readInput input
77+ (makeErrors, makeWarnings) <- runMake pccmOpts $ do
78+ ms <- P.parseModulesFromFiles id moduleFiles
79+ let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, Right fp)) ms
80+ foreigns <- inferForeignModules filePathMap
81+ let makeActions = buildMakeActions pccmOutputDir filePathMap foreigns pccmUsePrefix
82+ P.make makeActions (map snd ms)
83+ printWarningsAndErrors (P.optionsVerboseErrors pccmOpts) pccmJSONErrors makeWarnings makeErrors
84+ exitSuccess
85+
86+warnFileTypeNotFound :: String -> IO ()
87+warnFileTypeNotFound = hPutStrLn stderr . ("pcc: No files found using pattern: " ++)
88+
89+globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
90+globWarningOnMisses warn = concatMapM globWithWarning
91+ where
92+ globWithWarning pattern = do
93+ paths <- glob pattern
94+ when (null paths) $ warn pattern
95+ return paths
96+ concatMapM f = liftM concat . mapM f
97+
98+readInput :: [FilePath] -> IO [(FilePath, String)]
99+readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile
84100
85101inputFile :: Parser FilePath
86102inputFile = strArgument $
87103 metavar "FILE"
88104 <> help "The input .purs file(s)"
89105
90−inputForeignFile :: Parser FilePath
91−inputForeignFile = strOption $
92− short 'f'
93− <> long "ffi"
94− <> help "The input .js file(s) providing foreign import implementations"
95−
96106outputDirectory :: Parser FilePath
97107outputDirectory = strOption $
98108 short 'o'
@@ -106,26 +116,21 @@ noTco = switch $
106116 long "no-tco"
107117 <> help "Disable tail call optimizations"
108118
109−noPrelude :: Parser Bool
110−noPrelude = switch $
111− long "no-prelude"
112− <> help "Omit the automatic Prelude import"
113−
114119noMagicDo :: Parser Bool
115120noMagicDo = switch $
116121 long "no-magic-do"
117− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
122+ <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
118123
119124noOpts :: Parser Bool
120125noOpts = switch $
121126 long "no-opts"
122− <> help "Skip the optimization phase."
127+ <> help "Skip the optimization phase"
123128
124129comments :: Parser Bool
125130comments = switch $
126131 short 'c'
127132 <> long "comments"
128− <> help "Include comments in the generated code."
133+ <> help "Include comments in the generated code"
129134
130135verboseErrors :: Parser Bool
131136verboseErrors = switch $
@@ -139,11 +144,16 @@ noPrefix = switch $
139144 <> long "no-prefix"
140145 <> help "Do not include comment header"
141146
147+jsonErrors :: Parser Bool
148+jsonErrors = switch $
149+ long "json-errors"
150+ <> help "Print errors to stderr as JSON"
142151sourceMaps :: Parser Bool
143152sourceMaps = switch $
144153 long "source-maps"
145154 <> help "Generate source maps"
146155
156+
147157options :: Parser P.Options
148158options = P.Options <$> noTco
149159 <*> noMagicDo
@@ -153,17 +163,20 @@ options = P.Options <$> noTco
153163 <*> (not <$> comments)
154164 <*> sourceMaps
155165
156−pccOptions :: Parser PCCOptions
157−pccOptions = PCCOptions <$> many inputFile
158− <*> many inputForeignFile
159− <*> outputDirectory
160− <*> options
161− <*> (not <$> noPrefix)
166+pccMakeOptions :: Parser PCCMakeOptions
167+pccMakeOptions = PCCMakeOptions <$> many inputFile
168+ <*> outputDirectory
169+ <*> options
170+ <*> (not <$> noPrefix)
171+ <*> jsonErrors
162172
163173main :: IO ()
164−main = execParser opts >>= compile
174+main = do
175+ hSetEncoding stdout utf8
176+ hSetEncoding stderr utf8
177+ execParser opts >>= compile
165178 where
166− opts = info (version <*> helper <*> pccOptions) infoModList
179+ opts = info (version <*> helper <*> pccMakeOptions) infoModList
167180 infoModList = fullDesc <> headerInfo <> footerInfo
168181 headerInfo = header "pcc - Compiles PureScript to C++11"
169182 footerInfo = footer $ "pcc " ++ showVersion Paths.version