@@ -12,17 +12,21 @@
1212--
1313-----------------------------------------------------------------------------
1414
15+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
16+
1517module Main where
1618
1719import Control.Applicative
18−import Control.Monad (forM)
20+import Control.Monad.Error
1921
2022import Data.Version (showVersion)
2123
2224import System.Console.CmdTheLine
23−import System.Directory (createDirectoryIfMissing)
25+import System.Directory
26+ (doesFileExist, getModificationTime, createDirectoryIfMissing)
2427import System.FilePath (takeDirectory)
2528import System.Exit (exitSuccess, exitFailure)
29+import System.IO.Error (tryIOError)
2630
2731import Text.Parsec (ParseError)
2832
@@ -33,35 +37,73 @@ import qualified System.IO.UTF8 as U
3337preludeFilename :: IO FilePath
3438preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
3539
36−readInput :: Maybe [FilePath] -> IO (Either ParseError [P.Module])
37−readInput Nothing = P.runIndentParser "" P.parseModules <$> getContents
38−readInput (Just input) = fmap (fmap concat . sequence) $ forM input $ \inputFile -> do
40+readInput :: Maybe [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])
41+readInput Nothing = do
42+ text <- getContents
43+ return $ map ((,) undefined) <$> P.runIndentParser "" P.parseModules text
44+readInput (Just input) = fmap collect $ forM input $ \inputFile -> do
3945 text <- U.readFile inputFile
40− return $ P.runIndentParser inputFile P.parseModules text
41−
42−compile :: P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
43−compile opts input output externs = do
46+ return $ (inputFile, P.runIndentParser inputFile P.parseModules text)
47+ where
48+ collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]
49+ collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)
50+
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 ()
75+compile makeMode opts input output externs = do
4476 modules <- readInput input
4577 case modules of
4678 Left err -> do
4779 U.print err
4880 exitFailure
4981 Right ms ->
50− case P.compile opts ms of
51− Left err -> do
52− U.putStrLn err
53− exitFailure
54− Right (js, exts, _) -> do
55− case output of
56− Just path -> mkdirp path >> U.writeFile path js
57− Nothing -> U.putStrLn js
58− case externs of
59− Just path -> mkdirp path >> U.writeFile path exts
60− Nothing -> return ()
61− exitSuccess
62− where
63− mkdirp :: FilePath -> IO ()
64− mkdirp = createDirectoryIfMissing True . takeDirectory
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
93+ Left err -> do
94+ U.putStrLn err
95+ exitFailure
96+ Right (js, exts, _) -> do
97+ case output of
98+ Just path -> mkdirp path >> U.writeFile path js
99+ Nothing -> U.putStrLn js
100+ case externs of
101+ Just path -> mkdirp path >> U.writeFile path exts
102+ Nothing -> return ()
103+ exitSuccess
104+
105+mkdirp :: FilePath -> IO ()
106+mkdirp = createDirectoryIfMissing True . takeDirectory
65107
66108useStdIn :: Term Bool
67109useStdIn = value . flag $ (optInfo [ "s", "stdin" ])
@@ -103,6 +145,10 @@ noOpts :: Term Bool
103145noOpts = value $ flag $ (optInfo [ "no-opts" ])
104146 { optDoc = "Skip the optimization phase." }
105147
148+make :: Term Bool
149+make = value $ flag $ (optInfo [ "make" ])
150+ { optDoc = "Run in make mode" }
151+
106152browserNamespace :: Term String
107153browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
108154 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
@@ -119,14 +165,15 @@ options :: Term P.Options
119165options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules <*> codeGenModules
120166
121167stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
122−stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
168+stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles <*> make
123169 where
124− combine False True input = Just (prelude : input)
125− combine False False input = Just input
126− combine True _ _ = Nothing
170+ combine _ _ input True = Just input
171+ combine False True input _ = Just (prelude : input)
172+ combine False False input _ = Just input
173+ combine True _ _ _ = Nothing
127174
128175term :: FilePath -> Term (IO ())
129−term prelude = compile <$> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile
176+term prelude = compile <$> make <*> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile
130177
131178termInfo :: TermInfo
132179termInfo = defTI