git.iko.soy/rowtype-yoga/purescript-native
on 33db511 help sign in
rowtype-yoga/purescript-native/psc/Main.hs
155 lines 5.5 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Main
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving #-}
17module Main where
19import Control.Applicative
20import Control.Monad.Error
22import Data.Version (showVersion)
24import System.Console.CmdTheLine
25import System.Directory (createDirectoryIfMissing)
26import System.FilePath (takeDirectory)
27import System.Exit (exitSuccess, exitFailure)
28import System.IO (stderr)
30import Text.Parsec (ParseError)
32import qualified Language.PureScript as P
33import qualified Paths_purescript as Paths
34import qualified System.IO.UTF8 as U
36readInput :: Maybe [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])
37readInput Nothing = do
38 text <- getContents
39 return $ map ((,) undefined) <$> P.runIndentParser "" P.parseModules text
40readInput (Just input) = fmap collect $ forM input $ \inputFile -> do
41 text <- U.readFile inputFile
42 return $ (inputFile, P.runIndentParser inputFile P.parseModules text)
43 where
44 collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]
45 collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)
47compile :: FilePath -> P.Options P.Compile -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()
48compile prelude opts stdin input output externs usePrefix = do
49 modules <- readInput stdInOrInputFiles
50 case modules of
51 Left err -> do
52 U.hPutStr stderr $ show err
53 exitFailure
54 Right ms -> do
55 case P.compile opts (map snd ms) prefix of
56 Left err -> do
57 U.hPutStrLn stderr err
58 exitFailure
59 Right (js, exts, _) -> do
60 case output of
61 Just path -> mkdirp path >> U.writeFile path js
62 Nothing -> U.putStrLn js
63 case externs of
64 Just path -> mkdirp path >> U.writeFile path exts
65 Nothing -> return ()
66 exitSuccess
67 where
68 stdInOrInputFiles :: Maybe [FilePath]
69 stdInOrInputFiles | stdin = Nothing
70 | P.optionsNoPrelude opts = Just input
71 | otherwise = Just $ prelude : input
72 prefix = if usePrefix
73 then ["Generated by psc version " ++ showVersion Paths.version]
74 else []
76mkdirp :: FilePath -> IO ()
77mkdirp = createDirectoryIfMissing True . takeDirectory
79useStdIn :: Term Bool
80useStdIn = value . flag $ (optInfo [ "s", "stdin" ])
81 { optDoc = "Read from standard input" }
83inputFiles :: Term [FilePath]
84inputFiles = value $ posAny [] $ posInfo
85 { posDoc = "The input .ps files" }
87outputFile :: Term (Maybe FilePath)
88outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])
89 { optDoc = "The output .js file" }
91externsFile :: Term (Maybe FilePath)
92externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])
93 { optDoc = "The output .e.ps file" }
95noTco :: Term Bool
96noTco = value $ flag $ (optInfo [ "no-tco" ])
97 { optDoc = "Disable tail call optimizations" }
99noPrelude :: Term Bool
100noPrelude = value $ flag $ (optInfo [ "no-prelude" ])
101 { optDoc = "Omit the Prelude" }
103noMagicDo :: Term Bool
104noMagicDo = value $ flag $ (optInfo [ "no-magic-do" ])
105 { optDoc = "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad." }
107runMain :: Term (Maybe String)
108runMain = value $ defaultOpt (Just "Main") Nothing $ (optInfo [ "main" ])
109 { optDoc = "Generate code to run the main method in the specified module." }
111noOpts :: Term Bool
112noOpts = value $ flag $ (optInfo [ "no-opts" ])
113 { optDoc = "Skip the optimization phase." }
115browserNamespace :: Term String
116browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
117 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
119dceModules :: Term [String]
120dceModules = value $ optAll [] $ (optInfo [ "m", "module" ])
121 { optDoc = "Enables dead code elimination, all code which is not a transitive dependency of a specified module will be removed. This argument can be used multiple times." }
123codeGenModules :: Term [String]
124codeGenModules = value $ optAll [] $ (optInfo [ "codegen" ])
125 { optDoc = "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times." }
127verboseErrors :: Term Bool
128verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])
129 { optDoc = "Display verbose error messages" }
131noPrefix :: Term Bool
132noPrefix = value $ flag $ (optInfo ["no-prefix" ])
133 { optDoc = "Do not include comment header"}
135options :: Term (P.Options P.Compile)
136options = P.Options <$> noPrelude <*> noTco <*> noMagicDo <*> runMain <*> noOpts <*> verboseErrors <*> additionalOptions
137 where
138 additionalOptions = P.CompileOptions <$> browserNamespace <*> dceModules <*> codeGenModules
140term :: FilePath -> Term (IO ())
141term prelude = compile prelude <$> options <*> useStdIn <*> inputFiles <*> outputFile <*> externsFile <*> (not <$> noPrefix)
143termInfo :: TermInfo
144termInfo = defTI
145 { termName = "psc"
146 , version = showVersion Paths.version
147 , termDoc = "Compiles PureScript to Javascript"
148 }
150main :: IO ()
151main = do
152 prelude <- P.preludeFilename
153 run (term prelude, termInfo)