328eea1 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

More minor tidying

commit328eea1f2fdc5a7fc6e0c3975e9366d74de0de6c authorPhil Freeman <paf31@cantab.net> dateSun 9 Aug 2015, 15:10 (11 years ago) parent5342b8d

2 files changed+23−14

compare with golang

unifiedsplit

src/Language/PureScript/Make.hs+14−6 tests/Main.hs+9−8

src/Language/PureScript/Make.hs+14−6

@@ -24,6 +24,7 @@ module Language.PureScript.Make

2424 (

2525 -- * Make API

2626 RebuildPolicy(..)

27+ , ProgressMessage(..), renderProgressMessage

2728 , MakeActions(..)

2829 , Externs()

2930 , make

@@ -77,6 +78,15 @@ import qualified Language.PureScript.CodeGen.JS as J

7778import qualified Language.PureScript.CoreFn as CF

7879import qualified Paths_purescript as Paths

7980

81+-- | Progress messages from the make process

82+data ProgressMessage

83+ = CompilingModule ModuleName

84+ deriving (Show, Eq, Ord)

85+

86+-- | Render a progress message

87+renderProgressMessage :: ProgressMessage -> String

88+renderProgressMessage (CompilingModule mn) = "Compiling " ++ runModuleName mn

89+

8090-- | Actions that require implementations when running in "make" mode.

8191--

8292-- This type exists to make two things abstract:

@@ -109,7 +119,7 @@ data MakeActions m = MakeActions {

109119 -- |

110120 -- Respond to a progress update.

111121 --

112− , progress :: String -> m ()

122+ , progress :: ProgressMessage -> m ()

113123 }

114124

115125-- |

@@ -158,7 +168,7 @@ make MakeActions{..} ms = do

158168 (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m

159169 go env' ms'

160170 go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do

161− lift $ progress $ "Compiling " ++ runModuleName moduleName'

171+ lift . progress $ CompilingModule moduleName'

162172 (checked@(Module _ _ elaborated _), env') <- lift . runCheck' env $ typeCheckModule Nothing m

163173 checkExhaustiveModule env' checked

164174 regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated

@@ -279,9 +289,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

279289 foreignFile = outputDir </> filePath </> "foreign.js"

280290 prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]

281291 js = unlines $ map ("// " ++) prefix ++ [pjs]

282− verboseErrorsEnabled <- asks optionsVerboseErrors

283292 lift $ do

284− when verboseErrorsEnabled $ progress $ "Writing " ++ jsFile

285293 writeTextFile jsFile js

286294 maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns

287295 writeTextFile externsFile exts

@@ -305,5 +313,5 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

305313 mkdirp :: FilePath -> IO ()

306314 mkdirp = createDirectoryIfMissing True . takeDirectory

307315

308− progress :: String -> Make ()

309− progress = liftIO . putStrLn

316+ progress :: ProgressMessage -> Make ()

317+ progress = liftIO . putStrLn . renderProgressMessage

tests/Main.hs+9−8

@@ -96,22 +96,23 @@ makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readEx

9696 let filePath = modulesDir </> P.runModuleName mn </> "externs.purs"

9797 (filePath, ) <$> readTextFile filePath

9898

99− codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Test ()

100− codegen m _ nextVar exts = do

99+ codegen :: CF.Module CF.Ann -> P.Environment -> P.Externs -> P.SupplyT Test ()

100+ codegen m _ exts = do

101101 let mn = CF.moduleName m

102102 foreignInclude <- case (CF.moduleName m `M.lookup` foreigns, CF.moduleForeign m) of

103103 (Just _, []) -> error "Unnecessary foreign module"

104104 (Just path, _) -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]

105105 (Nothing, []) -> return Nothing

106106 (Nothing, _) -> error "Missing foreign module"

107− pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude

107+ pjs <- P.prettyPrintJS <$> J.moduleToJs m foreignInclude

108108 let filePath = P.runModuleName $ CF.moduleName m

109109 jsFile = modulesDir </> filePath </> "index.js"

110110 externsFile = modulesDir </> filePath </> "externs.purs"

111111 foreignFile = modulesDir </> filePath </> "foreign.js"

112− writeTextFile jsFile pjs

113− maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns

114− writeTextFile externsFile exts

112+ lift $ do

113+ writeTextFile jsFile pjs

114+ maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns

115+ writeTextFile externsFile exts

115116

116117 readTextFile :: FilePath -> Test String

117118 readTextFile path = liftIO $ readFile path

@@ -121,8 +122,8 @@ makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readEx

121122 createDirectoryIfMissing True (takeDirectory path)

122123 writeFile path text

123124

124− progress :: String -> Test ()

125− progress = liftIO . putStrLn

125+ progress :: P.ProgressMessage -> Test ()

126+ progress = liftIO . putStrLn . P.renderProgressMessage

126127

127128readInput :: [FilePath] -> IO [(FilePath, String)]

128129readInput inputFiles = forM inputFiles $ \inputFile -> do