git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Move psc --make into a new executable psc-make
bdaf5c9Phil Freeman
psc-make/Main.hsnew file+140
compare with golang
unifiedsplit
@@ -0,0 +1,140 @@
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+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
16+
17+module Main where
18+
19+import Control.Applicative
20+import Control.Monad.Error
21+
22+import Data.Version (showVersion)
23+
24+import System.Console.CmdTheLine
25+import System.Directory
26+ (doesFileExist, getModificationTime, createDirectoryIfMissing)
27+import System.FilePath (takeDirectory)
28+import System.Exit (exitSuccess, exitFailure)
29+import System.IO.Error (tryIOError)
30+
31+import Text.Parsec (ParseError)
32+
33+import qualified Language.PureScript as P
34+import qualified Paths_purescript as Paths
35+import qualified System.IO.UTF8 as U
36+
37+preludeFilename :: IO FilePath
38+preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
39+
40+readInput :: [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])
41+readInput 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)
47+
48+newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Monad, MonadIO, MonadError String)
49+
50+runMake :: Make a -> IO (Either String a)
51+runMake = runErrorT . unMake
52+
53+makeIO :: IO a -> Make a
54+makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
55+
56+instance 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
70+
71+compile :: P.Options -> [FilePath] -> IO ()
72+compile 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
86+
87+mkdirp :: FilePath -> IO ()
88+mkdirp = createDirectoryIfMissing True . takeDirectory
89+
90+inputFiles :: Term [FilePath]
91+inputFiles = value $ posAny [] $ posInfo
92+ { posDoc = "The input .ps files" }
93+
94+tco :: Term Bool
95+tco = value $ flag $ (optInfo [ "tco" ])
96+ { optDoc = "Perform tail call optimizations" }
97+
98+performRuntimeTypeChecks :: Term Bool
99+performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])
100+ { optDoc = "Generate runtime type checks" }
101+
102+noPrelude :: Term Bool
103+noPrelude = value $ flag $ (optInfo [ "no-prelude" ])
104+ { optDoc = "Omit the Prelude" }
105+
106+magicDo :: Term Bool
107+magicDo = value $ flag $ (optInfo [ "magic-do" ])
108+ { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }
109+
110+noOpts :: Term Bool
111+noOpts = value $ flag $ (optInfo [ "no-opts" ])
112+ { optDoc = "Skip the optimization phase." }
113+
114+browserNamespace :: Term String
115+browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
116+ { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
117+
118+options :: Term P.Options
119+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> pure Nothing <*> noOpts <*> browserNamespace <*> pure [] <*> pure []
120+
121+inputFilesAndPrelude :: FilePath -> Term [FilePath]
122+inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles
123+ where
124+ combine True input = prelude : input
125+ combine False input = input
126+
127+term :: FilePath -> Term (IO ())
128+term prelude = compile <$> options <*> inputFilesAndPrelude prelude
129+
130+termInfo :: TermInfo
131+termInfo = defTI
132+ { termName = "psc-make"
133+ , version = showVersion Paths.version
134+ , termDoc = "Compiles PureScript to Javascript"
135+ }
136+
137+main :: IO ()
138+main = do
139+ prelude <- preludeFilename
140+ run (term prelude, termInfo)
psc/Main.hs+17−56
@@ -22,11 +22,9 @@ import Control.Monad.Error
22import Data.Version (showVersion)
22import Data.Version (showVersion)
23
23
24import System.Console.CmdTheLine
24import System.Console.CmdTheLine
25−import System.Directory
25+import System.Directory (createDirectoryIfMissing)
26− (doesFileExist, getModificationTime, createDirectoryIfMissing)
27import System.FilePath (takeDirectory)
26import System.FilePath (takeDirectory)
28import System.Exit (exitSuccess, exitFailure)
27import System.Exit (exitSuccess, exitFailure)
29−import System.IO.Error (tryIOError)
30
28
31import Text.Parsec (ParseError)
29import Text.Parsec (ParseError)
32
30
@@ -48,59 +46,26 @@ readInput (Just input) = fmap collect $ forM input $ \inputFile -> do
48 collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]
46 collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]
49 collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)
47 collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)
50
48
51−newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Monad, MonadIO, MonadError String)
52−
53−runMake :: Make a -> IO (Either String a)
54−runMake = runErrorT . unMake
55−
56−makeIO :: IO a -> Make a
57−makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
58−
59−instance P.MonadMake Make where
60− getTimestamp path = makeIO $ do
61− exists <- doesFileExist path
62− case exists of
63− True -> Just <$> getModificationTime path
64− False -> return Nothing
65− readTextFile path = makeIO $ do
66− U.putStrLn $ "Reading " ++ path
67− U.readFile path
68− writeTextFile path text = makeIO $ do
69− mkdirp path
70− U.putStrLn $ "Writing " ++ path
71− U.writeFile path text
72− liftError = either throwError return
73−
74−compile :: Bool -> P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
49+compile :: P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
75−compile makeMode opts input output externs = do
50+compile opts input output externs = do
76 modules <- readInput input
51 modules <- readInput input
77 case modules of
52 case modules of
78 Left err -> do
53 Left err -> do
79 U.print err
54 U.print err
80 exitFailure
55 exitFailure
81− Right ms ->
56+ Right ms -> do
82− case makeMode of
83− True -> do
84− e <- runMake $ P.make opts ms
85− case e of
86− Left err -> do
87− U.putStrLn err
88− exitFailure
89− Right _ -> do
90− exitSuccess
91− False ->
92− case P.compile opts (map snd ms) of
57+ case P.compile opts (map snd ms) of
93− Left err -> do
58+ Left err -> do
94− U.putStrLn err
59+ U.putStrLn err
95− exitFailure
60+ exitFailure
96− Right (js, exts, _) -> do
61+ Right (js, exts, _) -> do
97− case output of
62+ case output of
98− Just path -> mkdirp path >> U.writeFile path js
63+ Just path -> mkdirp path >> U.writeFile path js
99− Nothing -> U.putStrLn js
64+ Nothing -> U.putStrLn js
100− case externs of
65+ case externs of
101− Just path -> mkdirp path >> U.writeFile path exts
66+ Just path -> mkdirp path >> U.writeFile path exts
102− Nothing -> return ()
67+ Nothing -> return ()
103− exitSuccess
68+ exitSuccess
104
69
105mkdirp :: FilePath -> IO ()
70mkdirp :: FilePath -> IO ()
106mkdirp = createDirectoryIfMissing True . takeDirectory
71mkdirp = createDirectoryIfMissing True . takeDirectory
@@ -145,10 +110,6 @@ noOpts :: Term Bool
145noOpts = value $ flag $ (optInfo [ "no-opts" ])
110noOpts = value $ flag $ (optInfo [ "no-opts" ])
146 { optDoc = "Skip the optimization phase." }
111 { optDoc = "Skip the optimization phase." }
147
112
148−make :: Term Bool
149−make = value $ flag $ (optInfo [ "make" ])
150− { optDoc = "Run in make mode" }
151−
152browserNamespace :: Term String
113browserNamespace :: Term String
153browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
114browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
154 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
115 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
@@ -172,7 +133,7 @@ stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inp
172 combine True _ _ = Nothing
133 combine True _ _ = Nothing
173
134
174term :: FilePath -> Term (IO ())
135term :: FilePath -> Term (IO ())
175−term prelude = compile <$> make <*> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile
136+term prelude = compile <$> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile
176
137
177termInfo :: TermInfo
138termInfo :: TermInfo
178termInfo = defTI
139termInfo = defTI
purescript.cabal+10
@@ -93,6 +93,16 @@ executable psc
93 other-modules:
93 other-modules:
94 ghc-options: -Wall -O2 -fno-warn-unused-do-bind
94 ghc-options: -Wall -O2 -fno-warn-unused-do-bind
95
95
96+executable psc-make
97+ build-depends: base >=4 && <5, cmdtheline -any, containers -any,
98+ directory -any, filepath -any, mtl -any, parsec -any,
99+ purescript -any, syb -any, transformers -any, utf8-string -any
100+ main-is: Main.hs
101+ buildable: True
102+ hs-source-dirs: psc-make
103+ other-modules:
104+ ghc-options: -Wall -O2 -fno-warn-unused-do-bind
105+
96executable psci
106executable psci
97 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
107 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
98 mtl -any, parsec -any, haskeline -any, purescript -any,
108 mtl -any, parsec -any, haskeline -any, purescript -any,