git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Copy foreigns during psc-make and use require
cc52a68Gary Burgess
psc-make/Main.hs+54−18
compare with golang
unifiedsplit
@@ -13,9 +13,10 @@
13-----------------------------------------------------------------------------
13-----------------------------------------------------------------------------
14
14
15{-# LANGUAGE DataKinds #-}
15{-# LANGUAGE DataKinds #-}
16+{-# LANGUAGE FlexibleContexts #-}
16{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17−{-# LANGUAGE TupleSections #-}
18{-# LANGUAGE RecordWildCards #-}
18{-# LANGUAGE RecordWildCards #-}
19+{-# LANGUAGE TupleSections #-}
19
20
20module Main where
21module Main where
21
22
@@ -38,19 +39,21 @@ import System.Directory
38 (doesFileExist, getModificationTime, createDirectoryIfMissing)
39 (doesFileExist, getModificationTime, createDirectoryIfMissing)
39import System.FilePath ((</>), takeDirectory)
40import System.FilePath ((</>), takeDirectory)
40import System.Exit (exitSuccess, exitFailure)
41import System.Exit (exitSuccess, exitFailure)
42+import System.IO (hPutStrLn, stderr)
41import System.IO.Error (tryIOError)
43import System.IO.Error (tryIOError)
42
44
43import qualified Language.PureScript as P
45import qualified Language.PureScript as P
44import qualified Language.PureScript.CodeGen.JS as J
46import qualified Language.PureScript.CodeGen.JS as J
45−import qualified Language.PureScript.CoreFn as CoreFn
47+import qualified Language.PureScript.CoreFn as CF
46import qualified Paths_purescript as Paths
48import qualified Paths_purescript as Paths
47
49
48
50
49data PSCMakeOptions = PSCMakeOptions
51data PSCMakeOptions = PSCMakeOptions
50− { pscmInput :: [FilePath]
52+ { pscmInput :: [FilePath]
53+ , pscmForeignInput :: [FilePath]
51− , pscmOutputDir :: FilePath
54+ , pscmOutputDir :: FilePath
52− , pscmOpts :: P.Options P.Make
55+ , pscmOpts :: P.Options P.Make
53− , pscmUsePrefix :: Bool
56+ , pscmUsePrefix :: Bool
54 }
57 }
55
58
56data InputOptions = InputOptions
59data InputOptions = InputOptions
@@ -90,20 +93,33 @@ traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
90traverseEither _ (Left x) = pure (Left x)
93traverseEither _ (Left x) = pure (Left x)
91traverseEither f (Right y) = Right <$> f y
94traverseEither f (Right y) = Right <$> f y
92
95
96+parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
97+ => [(Either P.RebuildPolicy FilePath, String)]
98+ -> [(FilePath, String)]
99+ -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName String)
100+parseInputs modules foreigns =
101+ (,) <$> P.parseModulesFromFiles (either (const "") id) modules
102+ <*> P.parseForeignModulesFromFiles foreigns
103+
93compile :: PSCMakeOptions -> IO ()
104compile :: PSCMakeOptions -> IO ()
94−compile (PSCMakeOptions input outputDir opts usePrefix) = do
105+compile (PSCMakeOptions input inputForeign outputDir opts usePrefix) = do
95− modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)
106+ moduleFiles <- readInput (InputOptions (P.optionsNoPrelude opts) input)
96− case modules of
107+ foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
108+ case runWriterT (parseInputs moduleFiles foreignFiles) of
109+ Left errs -> do
110+ hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
97− Left err -> print err >> exitFailure
111+ exitFailure
98− Right ms -> do
112+ Right ((ms, foreigns), warnings) -> do
113+ when (P.nonEmpty warnings) $
114+ hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
99 let filePathMap = M.fromList $ map (\(fp, P.Module _ mn _ _) -> (mn, fp)) ms
115 let filePathMap = M.fromList $ map (\(fp, P.Module _ mn _ _) -> (mn, fp)) ms
100− e <- runMake opts $ P.make (getInputTimestamp filePathMap) getOutputTimestamp readExterns codegen ms
116+ e <- runMake opts $ P.make (getInputTimestamp filePathMap) getOutputTimestamp readExterns (codegen foreigns) ms
101 case e of
117 case e of
102 Left errs -> do
118 Left errs -> do
103 putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
119 putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
104 exitFailure
120 exitFailure
105− Right (_, warnings) -> do
121+ Right (_, warnings') -> do
106− when (P.nonEmpty warnings) $
122+ when (P.nonEmpty warnings') $
107 putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
123 putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
108 exitSuccess
124 exitSuccess
109 where
125 where
@@ -125,15 +141,28 @@ compile (PSCMakeOptions input outputDir opts usePrefix) = do
125 let path = outputDir </> P.runModuleName mn </> "externs.purs"
141 let path = outputDir </> P.runModuleName mn </> "externs.purs"
126 (path, ) <$> P.readTextFile path
142 (path, ) <$> P.readTextFile path
127
143
128− codegen :: CoreFn.Module CoreFn.Ann -> String -> P.Environment -> Integer -> Make ()
144+ codegen :: M.Map P.ModuleName String
145+ -> CF.Module CF.Ann
146+ -> String
147+ -> P.Environment
148+ -> Integer
149+ -> Make ()
129− codegen m exts _ nextVar = do
150+ codegen foreigns m exts _ nextVar = do
151+ let requiresForeign = not $ null (CF.moduleForeign m)
152+ foreignInclude <- case CF.moduleName m `M.lookup` foreigns of
153+ Just _ | not requiresForeign -> error "Found unnecessary foreign module"
154+ | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
155+ Nothing | requiresForeign -> error "Foreign module missing"
156+ | otherwise -> return Nothing
130− pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m Nothing
157+ pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude
131− let filePath = P.runModuleName $ CoreFn.moduleName m
158+ let filePath = P.runModuleName $ CF.moduleName m
132 jsFile = outputDir </> filePath </> "index.js"
159 jsFile = outputDir </> filePath </> "index.js"
133 externsFile = outputDir </> filePath </> "externs.purs"
160 externsFile = outputDir </> filePath </> "externs.purs"
161+ foreignFile = outputDir </> filePath </> "foreign.js"
134 prefix = ["Generated by psc-make version " ++ showVersion Paths.version | usePrefix]
162 prefix = ["Generated by psc-make version " ++ showVersion Paths.version | usePrefix]
135 js = unlines $ map ("// " ++) prefix ++ [pjs]
163 js = unlines $ map ("// " ++) prefix ++ [pjs]
136 P.writeTextFile jsFile js
164 P.writeTextFile jsFile js
165+ maybe (return ()) (P.writeTextFile foreignFile) $ CF.moduleName m `M.lookup` foreigns
137 P.writeTextFile externsFile exts
166 P.writeTextFile externsFile exts
138
167
139mkdirp :: FilePath -> IO ()
168mkdirp :: FilePath -> IO ()
@@ -144,6 +173,12 @@ inputFile = strArgument $
144 metavar "FILE"
173 metavar "FILE"
145 <> help "The input .purs file(s)"
174 <> help "The input .purs file(s)"
146
175
176+inputForeignFile :: Parser FilePath
177+inputForeignFile = strOption $
178+ short 'f'
179+ <> long "ffi"
180+ <> help "The input .js file(s) providing foreign import implementations"
181+
147outputDirectory :: Parser FilePath
182outputDirectory :: Parser FilePath
148outputDirectory = strOption $
183outputDirectory = strOption $
149 short 'o'
184 short 'o'
@@ -203,6 +238,7 @@ options = P.Options <$> noPrelude
203
238
204pscMakeOptions :: Parser PSCMakeOptions
239pscMakeOptions :: Parser PSCMakeOptions
205pscMakeOptions = PSCMakeOptions <$> many inputFile
240pscMakeOptions = PSCMakeOptions <$> many inputFile
241+ <*> many inputForeignFile
206 <*> outputDirectory
242 <*> outputDirectory
207 <*> options
243 <*> options
208 <*> (not <$> noPrefix)
244 <*> (not <$> noPrefix)