aca96b2 · rowtype-yoga/purescript-native

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

Comments, type synonyms for better documentation

commitaca96b24a895ffb9adbd9b2ab48278e0c1c3e5dd authorGary Burgess <gary.burgess@gmail.com> dateSat 9 May 2015, 12:01 (11 years ago) parent8df45c5

5 files changed+62−48

compare with golang

unifiedsplit

psc-make/Main.hs+2−2 psc-make/Make.hs+3−3 psc/Main.hs+3−3 src/Language/PureScript.hs+47−38 src/Language/PureScript/Parser/JS.hs+7−2

psc-make/Main.hs+2−2

@@ -78,8 +78,8 @@ readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$>

7878

7979parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

8080 => [(Either P.RebuildPolicy FilePath, String)]

81− -> [(FilePath, String)]

82− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName String)

81+ -> [(FilePath, P.ForeignJS)]

82+ -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName P.ForeignJS)

8383parseInputs modules foreigns =

8484 (,) <$> P.parseModulesFromFiles (either (const "") id) modules

8585 <*> P.parseForeignModulesFromFiles foreigns

psc-make/Make.hs+3−3

@@ -64,7 +64,7 @@ traverseEither f (Right y) = Right <$> f y

6464

6565buildMakeActions :: FilePath

6666 -> M.Map P.ModuleName (Either P.RebuildPolicy String)

67− -> M.Map P.ModuleName String

67+ -> M.Map P.ModuleName P.ForeignJS

6868 -> Bool

6969 -> P.MakeActions Make

7070buildMakeActions outputDir filePathMap foreigns usePrefix =

@@ -88,8 +88,8 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

8888 let path = outputDir </> P.runModuleName mn </> "externs.purs"

8989 (path, ) <$> readTextFile path

9090

91− codegen :: CF.Module CF.Ann -> String -> P.Environment -> Integer -> Make ()

92− codegen m exts _ nextVar = do

91+ codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()

92+ codegen m _ nextVar exts = do

9393 foreignInclude <- case CF.moduleName m `M.lookup` foreigns of

9494 Just _ | not $ requiresForeign m -> error "Found unnecessary foreign module"

9595 | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]

psc/Main.hs+3−3

@@ -99,15 +99,15 @@ compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do

9999 exitSuccess

100100

101101parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

102− => [(Maybe FilePath, String)] -> [(FilePath, String)] -> m ([(Maybe FilePath, P.Module)], M.Map P.ModuleName String)

102+ => [(Maybe FilePath, String)] -> [(FilePath, P.ForeignJS)] -> m ([(Maybe FilePath, P.Module)], M.Map P.ModuleName String)

103103parseInputs modules foreigns =

104104 (,) <$> P.parseModulesFromFiles (fromMaybe "") modules

105105 <*> P.parseForeignModulesFromFiles foreigns

106106

107107compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)

108− => [P.Module] -> M.Map P.ModuleName String -> [String] -> m (String, String)

108+ => [P.Module] -> M.Map P.ModuleName P.ForeignJS -> [String] -> m (String, String)

109109compileJS ms foreigns prefix = do

110− (modulesToCodeGen, exts, env, nextVar) <- P.compile ms

110+ (modulesToCodeGen, env, nextVar, exts) <- P.compile ms

111111 js <- concat <$> evalSupplyT nextVar (traverse codegenModule modulesToCodeGen)

112112 js' <- generateMain env js

113113 let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']

src/Language/PureScript.hs+47−38

@@ -24,6 +24,8 @@ module Language.PureScript

2424 , compile'

2525 , RebuildPolicy(..)

2626 , MakeActions(..)

27+ , SupplyVar()

28+ , Externs()

2729 , make

2830 , version

2931 ) where

@@ -46,7 +48,7 @@ import Control.Monad.Supply.Class (fresh)

4648

4749import Language.PureScript.AST as P

4850import Language.PureScript.Comments as P

49−import Language.PureScript.CodeGen

51+import Language.PureScript.CodeGen.Externs (moduleToPs)

5052import Language.PureScript.DeadCodeElimination as P

5153import Language.PureScript.Environment as P

5254import Language.PureScript.Errors as P

@@ -87,11 +89,11 @@ import qualified Paths_purescript as Paths

8789-- * Pretty-print the generated Javascript

8890--

8991compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

90− => [Module] -> m ([CoreFn.Module CoreFn.Ann], String, Environment, Integer)

92+ => [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)

9193compile = compile' initEnvironment

9294

9395compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

94− => Environment -> [Module] -> m ([CoreFn.Module CoreFn.Ann], String, Environment, Integer)

96+ => Environment -> [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)

9597compile' env ms = do

9698 noPrelude <- asks optionsNoPrelude

9799 unless noPrelude (checkPreludeIsDefined ms)

@@ -108,40 +110,48 @@ compile' env ms = do

108110 renamed = renameInModules elim

109111 codeGenModuleNames = moduleNameFromString `map` codeGenModules additional

110112 modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed

111− let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped

112− return (modulesToCodeGen, exts, env', nextVar)

113+ exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped

114+ return (modulesToCodeGen, env', nextVar, exts)

113115

114116-- |

115−-- A type class which collects the IO actions we need to be able to run in "make" mode

116−--

117−--class (MonadReader (P.Options P.Make) m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MonadMake m where

118−-- -- |

119−-- -- Get a file timestamp

120−-- --

121−-- getTimestamp :: FilePath -> m (Maybe UTCTime)

122−

123−-- -- |

124−-- -- Read a file as a string

125−-- --

126−-- readTextFile :: FilePath -> m String

127−

128−-- -- |

129−-- -- Write a text file

130−-- --

131−-- writeTextFile :: FilePath -> String -> m ()

132−

133−-- -- |

134−-- -- Respond to a progress update

135−-- --

136−-- progress :: String -> m ()

137−

138−data MakeActions m = MakeActions

139− { getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))

140− , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)

141− , readExterns :: ModuleName -> m (FilePath, String)

142− , codegen :: CoreFn.Module CoreFn.Ann -> String -> Environment -> Integer -> m ()

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

144− }

117+-- Actions that require implementations when running in "make" mode.

118+--

119+data MakeActions m = MakeActions {

120+ -- |

121+ -- Get the timestamp for the input file(s) for a module. If there are multiple

122+ -- files (.purs and foreign files, for example) the timestamp should be for

123+ -- the most recently modified file.

124+ --

125+ getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))

126+ -- |

127+ -- Get the timestamp for the output files for a module. This should be the

128+ -- timestamp for the oldest modified file, or Nothing if any of the required

129+ -- output files are missing.

130+ --

131+ , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)

132+ -- |

133+ -- Read the externs file for a module as a string and also return the actual

134+ -- path for the file.

135+ , readExterns :: ModuleName -> m (FilePath, String)

136+ -- |

137+ -- Run the code generator for the module and write any required output files.

138+ --

139+ , codegen :: CoreFn.Module CoreFn.Ann -> Environment -> SupplyVar -> Externs -> m ()

140+ -- |

141+ -- Respond to a progress update.

142+ --

143+ , progress :: String -> m ()

144+ }

145+

146+-- |

147+-- Generated code for an externs file.

148+--

149+type Externs = String

150+

151+-- |

152+-- A value to be used in the Supply monad.

153+--

154+type SupplyVar = Integer

145155

146156-- |

147157-- Determines when to rebuild a module

@@ -186,16 +196,15 @@ make MakeActions{..} ms = do

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

187197 go env' ms'

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

189−

190199 lift $ progress $ "Compiling " ++ runModuleName moduleName'

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

192201 regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated

193202 let mod' = Module coms moduleName' regrouped exps

194203 corefn = CoreFn.moduleToCoreFn env' mod'

195204 [renamed] = renameInModules [corefn]

196− let exts = moduleToPs mod' env'

205+ exts = moduleToPs mod' env'

197206 nextVar <- fresh

198− lift $ codegen renamed exts env' nextVar

207+ lift $ codegen renamed env' nextVar exts

199208 go env' ms'

200209

201210 rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

src/Language/PureScript/Parser/JS.hs+7−2

@@ -14,7 +14,10 @@

1414

1515{-# LANGUAGE FlexibleContexts #-}

1616

17−module Language.PureScript.Parser.JS (parseForeignModulesFromFiles) where

17+module Language.PureScript.Parser.JS

18+ ( ForeignJS()

19+ , parseForeignModulesFromFiles

20+ ) where

1821

1922import Control.Applicative ((*>), (<*))

2023import Control.Monad (msum)

@@ -27,7 +30,9 @@ import Prelude hiding (lex)

2730import qualified Data.Map as M

2831import qualified Text.Parsec as PS

2932

30−parseForeignModulesFromFiles :: (MonadError MultipleErrors m, Functor m) => [(FilePath, String)] -> m (M.Map ModuleName String)

33+type ForeignJS = String

34+

35+parseForeignModulesFromFiles :: (MonadError MultipleErrors m, Functor m) => [(FilePath, ForeignJS)] -> m (M.Map ModuleName ForeignJS)

3136parseForeignModulesFromFiles files = do

3237 foreigns <- parU files $ \(path, file) ->

3338 case findModuleName (lines file) of