@@ -5,6 +5,7 @@
55module Main where
66
77import Control.Monad (when)
8+import qualified Control.Monad.Parallel as Par
89import Data.Aeson
910import Data.Aeson.Types
1011import Data.Char
@@ -64,11 +65,16 @@ main = do
6465 T.writeFile "Makefile" $ T.decodeUtf8 $(embedFile "support/Makefile")
6566 when ("--help" `elem` opts') $
6667 putStrLn help
67− mapM (generateCode opts') files
68+ when (not $ null files) $ do
69+ let filepath = takeDirectory (head files)
70+ baseOutpath = joinPath $ (init $ splitDirectories filepath) ++ [outdir]
71+ writeRuntimeFiles baseOutpath
72+ Par.mapM (generateCode opts' baseOutpath) files
73+ return ()
6874 return ()
6975
70−generateCode :: [String] -> FilePath -> IO ()
71−generateCode opts jsonFile = do
76+generateCode :: [String] -> FilePath -> FilePath -> IO ()
77+generateCode opts baseOutpath jsonFile = do
7278 jsonModTime <- getModificationTime jsonFile
7379 let filepath = takeDirectory jsonFile
7480 dirparts = splitDirectories $ filepath
@@ -80,18 +86,16 @@ generateCode opts jsonFile = do
8086 then do
8187 modTime <- getModificationTime possInterfaceFilename
8288 when (modTime < jsonModTime) $
83− transpile opts jsonFile
84− else transpile opts jsonFile
89+ transpile opts baseOutpath jsonFile
90+ else transpile opts baseOutpath jsonFile
8591
86−transpile :: [String] -> FilePath -> IO ()
87−transpile opts jsonFile = do
92+transpile :: [String] -> FilePath -> FilePath -> IO ()
93+transpile opts baseOutpath jsonFile = do
8894 jsonText <- T.readFile jsonFile
8995 let module' = jsonToModule $ parseJson jsonText
9096 ((interface, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToCpp module' Nothing)
9197 let mn = moduleNameToCpp $ moduleName module'
9298 implementation = prettyPrintCpp asts
93− filepath = takeDirectory jsonFile
94− let baseOutpath = joinPath $ (init $ splitDirectories filepath) ++ [outdir]
9599 outpath = joinPath [baseOutpath, T.unpack mn]
96100 interfacePath = outpath </> interfaceFileName (T.unpack mn)
97101 implPath = outpath </> implFileName mn
@@ -100,18 +104,22 @@ transpile opts jsonFile = do
100104 T.writeFile interfacePath $ conv interface
101105 putStrLn implPath
102106 T.writeFile implPath $ conv (implHeader <> implementation <> implFooter)
103− let runtime = baseOutpath </> "purescript.h"
104− dep = baseOutpath </> "string_literal_dict.h"
105− runtimeExists <- doesFileExist runtime
106− when (not runtimeExists) $ do
107− T.writeFile runtime . conv $ T.decodeUtf8 $(embedFile "runtime/purescript.h")
108− T.writeFile dep . conv $ T.decodeUtf8 $(embedFile "runtime/string_literal_dict.h")
109107 where
110108 conv :: Text -> Text
111109 conv
112110 | "--ucns" `elem` opts = toUCNs
113111 | otherwise = id
114112
113+writeRuntimeFiles :: FilePath -> IO ()
114+writeRuntimeFiles baseOutpath = do
115+ createDirectoryIfMissing True baseOutpath
116+ let runtime = baseOutpath </> "purescript.h"
117+ dep = baseOutpath </> "string_literal_dict.h"
118+ runtimeExists <- doesFileExist runtime
119+ when (not runtimeExists) $ do
120+ T.writeFile runtime $ T.decodeUtf8 $(embedFile "runtime/purescript.h")
121+ T.writeFile dep $ T.decodeUtf8 $(embedFile "runtime/string_literal_dict.h")
122+
115123outdir :: FilePath
116124outdir = "src"
117125