git.iko.soy/rowtype-yoga/purescript-native
on 8030607 help sign in
rowtype-yoga/purescript-native/psc/Main.hs
148 lines 5.2 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 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)
29import Text.Parsec (ParseError)
31import qualified Language.PureScript as P
32import qualified Paths_purescript as Paths
33import qualified System.IO.UTF8 as U
35preludeFilename :: IO FilePath
36preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
38readInput :: Maybe [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])
39readInput Nothing = do
40 text <- getContents
41 return $ map ((,) undefined) <$> P.runIndentParser "" P.parseModules text
42readInput (Just input) = fmap collect $ forM input $ \inputFile -> do
43 text <- U.readFile inputFile
44 return $ (inputFile, P.runIndentParser inputFile P.parseModules text)
45 where
46 collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]
47 collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)
49compile :: P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
50compile opts input output externs = do
51 modules <- readInput input
52 case modules of
53 Left err -> do
54 U.print err
55 exitFailure
56 Right ms -> do
57 case P.compile opts (map snd ms) of
58 Left err -> do
59 U.putStrLn err
60 exitFailure
61 Right (js, exts, _) -> do
62 case output of
63 Just path -> mkdirp path >> U.writeFile path js
64 Nothing -> U.putStrLn js
65 case externs of
66 Just path -> mkdirp path >> U.writeFile path exts
67 Nothing -> return ()
68 exitSuccess
70mkdirp :: FilePath -> IO ()
71mkdirp = createDirectoryIfMissing True . takeDirectory
73useStdIn :: Term Bool
74useStdIn = value . flag $ (optInfo [ "s", "stdin" ])
75 { optDoc = "Read from standard input" }
77inputFiles :: Term [FilePath]
78inputFiles = value $ posAny [] $ posInfo
79 { posDoc = "The input .ps files" }
81outputFile :: Term (Maybe FilePath)
82outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])
83 { optDoc = "The output .js file" }
85externsFile :: Term (Maybe FilePath)
86externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])
87 { optDoc = "The output .e.ps file" }
89tco :: Term Bool
90tco = value $ flag $ (optInfo [ "tco" ])
91 { optDoc = "Perform tail call optimizations" }
93performRuntimeTypeChecks :: Term Bool
94performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])
95 { optDoc = "Generate runtime type checks" }
97noPrelude :: Term Bool
98noPrelude = value $ flag $ (optInfo [ "no-prelude" ])
99 { optDoc = "Omit the Prelude" }
101magicDo :: Term Bool
102magicDo = value $ flag $ (optInfo [ "magic-do" ])
103 { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }
105runMain :: Term (Maybe String)
106runMain = value $ defaultOpt (Just "Main") Nothing $ (optInfo [ "main" ])
107 { optDoc = "Generate code to run the main method in the specified module." }
109noOpts :: Term Bool
110noOpts = value $ flag $ (optInfo [ "no-opts" ])
111 { optDoc = "Skip the optimization phase." }
113browserNamespace :: Term String
114browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
115 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
117dceModules :: Term [String]
118dceModules = value $ optAll [] $ (optInfo [ "m", "module" ])
119 { 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." }
121codeGenModules :: Term [String]
122codeGenModules = value $ optAll [] $ (optInfo [ "codegen" ])
123 { optDoc = "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times." }
125options :: Term P.Options
126options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules <*> codeGenModules
128stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
129stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
130 where
131 combine False True input = Just (prelude : input)
132 combine False False input = Just input
133 combine True _ _ = Nothing
135term :: FilePath -> Term (IO ())
136term prelude = compile <$> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile
138termInfo :: TermInfo
139termInfo = defTI
140 { termName = "psc"
141 , version = showVersion Paths.version
142 , termDoc = "Compiles PureScript to Javascript"
143 }
145main :: IO ()
146main = do
147 prelude <- preludeFilename
148 run (term prelude, termInfo)