git.iko.soy/rowtype-yoga/purescript-native
on 28fa718 help sign in
rowtype-yoga/purescript-native/psc/Main.hs
128 lines 4.4 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-----------------------------------------------------------------------------
15module Main where
17import qualified Language.PureScript as P
18import System.Console.CmdTheLine
19import Control.Applicative
20import Control.Monad (forM)
21import System.Exit (exitSuccess, exitFailure)
22import qualified System.IO.UTF8 as U
23import Text.Parsec (ParseError)
24import qualified Paths_purescript as Paths
25import Data.Version (showVersion)
27preludeFilename :: IO FilePath
28preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
30readInput :: Maybe [FilePath] -> IO (Either ParseError [P.Module])
31readInput Nothing = getContents >>= return . P.runIndentParser "" P.parseModules
32readInput (Just input) = fmap (fmap concat . sequence) $ forM input $ \inputFile -> do
33 text <- U.readFile inputFile
34 return $ P.runIndentParser inputFile P.parseModules text
36compile :: P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
37compile opts input output externs = do
38 modules <- readInput input
39 case modules of
40 Left err -> do
41 U.print err
42 exitFailure
43 Right ms ->
44 case P.compile opts ms of
45 Left err -> do
46 U.putStrLn err
47 exitFailure
48 Right (js, exts, _) -> do
49 case output of
50 Just path -> U.writeFile path js
51 Nothing -> U.putStrLn js
52 case externs of
53 Nothing -> return ()
54 Just filePath -> U.writeFile filePath exts
55 exitSuccess
57useStdIn :: Term Bool
58useStdIn = value . flag $ (optInfo [ "s", "stdin" ])
59 { optDoc = "Read from standard input" }
61inputFiles :: Term [FilePath]
62inputFiles = value $ posAny [] $ posInfo
63 { posDoc = "The input .ps files" }
65outputFile :: Term (Maybe FilePath)
66outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])
67 { optDoc = "The output .js file" }
69externsFile :: Term (Maybe FilePath)
70externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])
71 { optDoc = "The output .e.ps file" }
73tco :: Term Bool
74tco = value $ flag $ (optInfo [ "tco" ])
75 { optDoc = "Perform tail call optimizations" }
77performRuntimeTypeChecks :: Term Bool
78performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])
79 { optDoc = "Generate runtime type checks" }
81noPrelude :: Term Bool
82noPrelude = value $ flag $ (optInfo [ "no-prelude" ])
83 { optDoc = "Omit the Prelude" }
85magicDo :: Term Bool
86magicDo = value $ flag $ (optInfo [ "magic-do" ])
87 { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }
89runMain :: Term (Maybe String)
90runMain = value $ defaultOpt (Just "Main") Nothing $ (optInfo [ "main" ])
91 { optDoc = "Generate code to run the main method in the specified module." }
93noOpts :: Term Bool
94noOpts = value $ flag $ (optInfo [ "no-opts" ])
95 { optDoc = "Skip the optimization phase." }
97browserNamespace :: Term String
98browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
99 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
101dceModules :: Term [String]
102dceModules = value $ optAll [] $ (optInfo [ "m", "module" ])
103 { 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." }
105options :: Term P.Options
106options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules
108stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
109stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
110 where
111 combine False True input = Just (prelude : input)
112 combine False False input = Just input
113 combine True _ _ = Nothing
115term :: FilePath -> Term (IO ())
116term prelude = compile <$> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile
118termInfo :: TermInfo
119termInfo = defTI
120 { termName = "psc"
121 , version = showVersion $ Paths.version
122 , termDoc = "Compiles PureScript to Javascript"
123 }
125main :: IO ()
126main = do
127 prelude <- preludeFilename
128 run (term prelude, termInfo)