git.iko.soy/rowtype-yoga/purescript-native
on 8030607 help sign in
rowtype-yoga/purescript-native/psc-make/Main.hs
140 lines 4.3 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
26 (doesFileExist, getModificationTime, createDirectoryIfMissing)
27import System.FilePath (takeDirectory)
28import System.Exit (exitSuccess, exitFailure)
29import System.IO.Error (tryIOError)
31import Text.Parsec (ParseError)
33import qualified Language.PureScript as P
34import qualified Paths_purescript as Paths
35import qualified System.IO.UTF8 as U
37preludeFilename :: IO FilePath
38preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
40readInput :: [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])
41readInput input = fmap collect $ forM input $ \inputFile -> do
42 text <- U.readFile inputFile
43 return $ (inputFile, P.runIndentParser inputFile P.parseModules text)
44 where
45 collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]
46 collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)
48newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Monad, MonadIO, MonadError String)
50runMake :: Make a -> IO (Either String a)
51runMake = runErrorT . unMake
53makeIO :: IO a -> Make a
54makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
56instance P.MonadMake Make where
57 getTimestamp path = makeIO $ do
58 exists <- doesFileExist path
59 case exists of
60 True -> Just <$> getModificationTime path
61 False -> return Nothing
62 readTextFile path = makeIO $ do
63 U.putStrLn $ "Reading " ++ path
64 U.readFile path
65 writeTextFile path text = makeIO $ do
66 mkdirp path
67 U.putStrLn $ "Writing " ++ path
68 U.writeFile path text
69 liftError = either throwError return
71compile :: P.Options -> [FilePath] -> IO ()
72compile opts input = do
73 modules <- readInput input
74 case modules of
75 Left err -> do
76 U.print err
77 exitFailure
78 Right ms -> do
79 e <- runMake $ P.make opts ms
80 case e of
81 Left err -> do
82 U.putStrLn err
83 exitFailure
84 Right _ -> do
85 exitSuccess
87mkdirp :: FilePath -> IO ()
88mkdirp = createDirectoryIfMissing True . takeDirectory
90inputFiles :: Term [FilePath]
91inputFiles = value $ posAny [] $ posInfo
92 { posDoc = "The input .ps files" }
94tco :: Term Bool
95tco = value $ flag $ (optInfo [ "tco" ])
96 { optDoc = "Perform tail call optimizations" }
98performRuntimeTypeChecks :: Term Bool
99performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])
100 { optDoc = "Generate runtime type checks" }
102noPrelude :: Term Bool
103noPrelude = value $ flag $ (optInfo [ "no-prelude" ])
104 { optDoc = "Omit the Prelude" }
106magicDo :: Term Bool
107magicDo = value $ flag $ (optInfo [ "magic-do" ])
108 { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }
110noOpts :: Term Bool
111noOpts = value $ flag $ (optInfo [ "no-opts" ])
112 { optDoc = "Skip the optimization phase." }
114browserNamespace :: Term String
115browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
116 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
118options :: Term P.Options
119options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> pure Nothing <*> noOpts <*> browserNamespace <*> pure [] <*> pure []
121inputFilesAndPrelude :: FilePath -> Term [FilePath]
122inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles
123 where
124 combine True input = prelude : input
125 combine False input = input
127term :: FilePath -> Term (IO ())
128term prelude = compile <$> options <*> inputFilesAndPrelude prelude
130termInfo :: TermInfo
131termInfo = defTI
132 { termName = "psc-make"
133 , version = showVersion Paths.version
134 , termDoc = "Compiles PureScript to Javascript"
135 }
137main :: IO ()
138main = do
139 prelude <- preludeFilename
140 run (term prelude, termInfo)