git.iko.soy/rowtype-yoga/purescript-native
on 24fdff2 help sign in
rowtype-yoga/purescript-native/psc/Main.hs
191 lines 6.4 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Main
4-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5-- License : MIT (http://opensource.org/licenses/MIT)
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15{-# LANGUAGE DataKinds #-}
16{-# LANGUAGE FlexibleContexts #-}
17{-# LANGUAGE RecordWildCards #-}
18{-# LANGUAGE TupleSections #-}
20module Main where
22import Control.Applicative
23import Control.Monad
24import Control.Monad.Error.Class (MonadError(..))
25import Control.Monad.Writer.Strict
27import Data.List (isSuffixOf, partition)
28import Data.Version (showVersion)
29import qualified Data.Map as M
31import Options.Applicative as Opts
33import System.Exit (exitSuccess, exitFailure)
34import System.IO (hPutStrLn, stderr)
35import System.IO.UTF8
36import System.FilePath.Glob (glob)
38import qualified Language.PureScript as P
39import qualified Paths_purescript as Paths
41import Language.PureScript.Make
43data PSCMakeOptions = PSCMakeOptions
44 { pscmInput :: [FilePath]
45 , pscmForeignInput :: [FilePath]
46 , pscmOutputDir :: FilePath
47 , pscmOpts :: P.Options
48 , pscmUsePrefix :: Bool
49 }
51data InputOptions = InputOptions
52 { ioInputFiles :: [FilePath]
53 }
55compile :: PSCMakeOptions -> IO ()
56compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
57 input <- globWarningOnMisses warnFileTypeNotFound inputGlob
58 when (null input) $ do
59 hPutStrLn stderr "psc: No input files."
60 exitFailure
61 let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input
62 moduleFiles <- readInput (InputOptions pursFiles)
63 inputForeign <- globWarningOnMisses warnFileTypeNotFound inputForeignGlob
64 foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readUTF8File inFile)
65 case runWriterT (parseInputs moduleFiles foreignFiles) of
66 Left errs -> do
67 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
68 exitFailure
69 Right ((ms, foreigns), warnings) -> do
70 when (P.nonEmpty warnings) $
71 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
72 let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
73 makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix
74 (e, warnings') <- runMake opts $ P.make makeActions (map snd ms)
75 when (P.nonEmpty warnings') $
76 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
77 case e of
78 Left errs -> do
79 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
80 exitFailure
81 Right _ -> exitSuccess
83warnFileTypeNotFound :: String -> IO ()
84warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)
86globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
87globWarningOnMisses warn = concatMapM globWithWarning
88 where
89 globWithWarning pattern = do
90 paths <- glob pattern
91 when (null paths) $ warn pattern
92 return paths
93 concatMapM f = liftM concat . mapM f
95readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
96readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
98parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
99 => [(Either P.RebuildPolicy FilePath, String)]
100 -> [(FilePath, P.ForeignJS)]
101 -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)
102parseInputs modules foreigns =
103 (,) <$> P.parseModulesFromFiles (either (const "") id) modules
104 <*> P.parseForeignModulesFromFiles foreigns
106inputFile :: Parser FilePath
107inputFile = strArgument $
108 metavar "FILE"
109 <> help "The input .purs file(s)"
111inputForeignFile :: Parser FilePath
112inputForeignFile = strOption $
113 short 'f'
114 <> long "ffi"
115 <> help "The input .js file(s) providing foreign import implementations"
117outputDirectory :: Parser FilePath
118outputDirectory = strOption $
119 short 'o'
120 <> long "output"
121 <> Opts.value "output"
122 <> showDefault
123 <> help "The output directory"
125requirePath :: Parser (Maybe FilePath)
126requirePath = optional $ strOption $
127 short 'r'
128 <> long "require-path"
129 <> help "The path prefix to use for require() calls in the generated JavaScript"
131noTco :: Parser Bool
132noTco = switch $
133 long "no-tco"
134 <> help "Disable tail call optimizations"
136noMagicDo :: Parser Bool
137noMagicDo = switch $
138 long "no-magic-do"
139 <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
141noOpts :: Parser Bool
142noOpts = switch $
143 long "no-opts"
144 <> help "Skip the optimization phase"
146comments :: Parser Bool
147comments = switch $
148 short 'c'
149 <> long "comments"
150 <> help "Include comments in the generated code"
152verboseErrors :: Parser Bool
153verboseErrors = switch $
154 short 'v'
155 <> long "verbose-errors"
156 <> help "Display verbose error messages"
158noPrefix :: Parser Bool
159noPrefix = switch $
160 short 'p'
161 <> long "no-prefix"
162 <> help "Do not include comment header"
165options :: Parser P.Options
166options = P.Options <$> noTco
167 <*> noMagicDo
168 <*> pure Nothing
169 <*> noOpts
170 <*> verboseErrors
171 <*> (not <$> comments)
172 <*> requirePath
174pscMakeOptions :: Parser PSCMakeOptions
175pscMakeOptions = PSCMakeOptions <$> many inputFile
176 <*> many inputForeignFile
177 <*> outputDirectory
178 <*> options
179 <*> (not <$> noPrefix)
182main :: IO ()
183main = execParser opts >>= compile
184 where
185 opts = info (version <*> helper <*> pscMakeOptions) infoModList
186 infoModList = fullDesc <> headerInfo <> footerInfo
187 headerInfo = header "psc - Compiles PureScript to Javascript"
188 footerInfo = footer $ "psc " ++ showVersion Paths.version
190 version :: Parser (a -> a)
191 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden