@@ -12,7 +12,10 @@
13-----------------------------------------------------------------------------
13-----------------------------------------------------------------------------
15+{-# LANGUAGE DataKinds #-}
15−{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}
16+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17+{-# LANGUAGE TupleSections #-}
18+{-# LANGUAGE RecordWildCards #-}
17module Main where
20module Main where
@@ -91,11 +94,10 @@ compile :: PSCMakeOptions -> IO ()
91compile (PSCMakeOptions input outputDir opts usePrefix) = do
94compile (PSCMakeOptions input outputDir opts usePrefix) = do
92 modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)
95 modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)
93 case modules of
96 case modules of
96− exitFailure
97+ Left err -> print err >> exitFailure
97 Right ms -> do
98 Right ms -> do
99+ let filePathMap = M.fromList $ map (\(fp, P.Module _ mn _ _) -> (mn, fp)) ms
98− e <- runMake opts $ P.make getInputTimestamp getOutputTimestamp readExterns codegen ms
100+ e <- runMake opts $ P.make (getInputTimestamp filePathMap) getOutputTimestamp readExterns codegen ms
99 case e of
101 case e of
100 Left errs -> do
102 Left errs -> do
101 putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
103 putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
@@ -105,16 +107,11 @@ compile (PSCMakeOptions input outputDir opts usePrefix) = do
105 putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
107 putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
106 exitSuccess
108 exitSuccess
108− prefix = if usePrefix
109− then ["Generated by psc-make version " ++ showVersion Paths.version]
112− filePathMap = M.empty -- M.fromList (map (\(fp, Module _ mn _ _) -> (mn, fp)) ms)
114− getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
111+ getInputTimestamp :: M.Map P.ModuleName (Either P.RebuildPolicy String) -> P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
115− getInputTimestamp mn = do
112+ getInputTimestamp filePathMap mn = do
116− let inputFile = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
113+ let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
117− traverseEither P.getTimestamp inputFile
114+ traverseEither P.getTimestamp path
119 getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
116 getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
120 getOutputTimestamp mn = do
117 getOutputTimestamp mn = do
@@ -129,12 +126,13 @@ compile (PSCMakeOptions input outputDir opts usePrefix) = do
129 (path, ) <$> P.readTextFile path
126 (path, ) <$> P.readTextFile path
131 codegen :: CoreFn.Module CoreFn.Ann -> String -> P.Environment -> Integer -> Make ()
128 codegen :: CoreFn.Module CoreFn.Ann -> String -> P.Environment -> Integer -> Make ()
132− codegen m exts env nextVar = do
129+ codegen m exts _ nextVar = do
130+ pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m Nothing
133 let filePath = P.runModuleName $ CoreFn.moduleName m
131 let filePath = P.runModuleName $ CoreFn.moduleName m
134 jsFile = outputDir </> filePath </> "index.js"
132 jsFile = outputDir </> filePath </> "index.js"
135 externsFile = outputDir </> filePath </> "externs.purs"
133 externsFile = outputDir </> filePath </> "externs.purs"
136− pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m Nothing
134+ prefix = ["Generated by psc-make version " ++ showVersion Paths.version | usePrefix]
137− let js = unlines $ map ("// " ++) prefix ++ [pjs]
135+ js = unlines $ map ("// " ++) prefix ++ [pjs]
138 P.writeTextFile jsFile js
136 P.writeTextFile jsFile js
139 P.writeTextFile externsFile exts
137 P.writeTextFile externsFile exts