@@ -10,7 +10,7 @@ import Data.Aeson
1010import Data.Aeson.Types
1111import Data.Char
1212import Data.FileEmbed (embedFile)
13−import Data.List (delete, intercalate, isPrefixOf, nub, partition)
13+import Data.List (delete, intercalate, isPrefixOf, nub, partition, (\\))
1414import Data.Maybe
1515import Data.Monoid ((<>))
1616import Data.Version
@@ -20,7 +20,7 @@ import Text.Printf
2020
2121import System.Environment
2222import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory, getModificationTime)
23−import System.FilePath ((</>), joinPath, searchPathSeparator, splitDirectories, takeDirectory)
23+import System.FilePath ((</>), joinPath, splitDirectories, takeDirectory)
2424import System.FilePath.Find
2525import System.Process
2626
@@ -43,7 +43,7 @@ import CodeGen.IL.Printer
4343
4444import Tests
4545
46−data Command = Build | Run
46+data Command = Build | Run (Maybe String)
4747
4848parseJson :: Text -> Value
4949parseJson text
@@ -54,12 +54,32 @@ jsonToModule :: Value -> Module Ann
5454jsonToModule value =
5555 case parse moduleFromJSON value of
5656 Success (_, r) -> r
57− _ -> error "failed"
57+ _ -> error "Failed parsing corefn. Psgo currently supports purescript <= 0.13.8"
58+
59+splitArgs :: [String] -> ([String], Maybe String, [String])
60+splitArgs args =
61+ let (opts, files) = partition (isPrefixOf "--") args
62+ opts' = (map . map) toLower opts
63+ (moduleName, files') =
64+ if null files
65+ then (Nothing, files)
66+ else
67+ if "--run" `elem` opts' && length (files) >= 1
68+ then do
69+ let file0 = head files
70+ files' = tail files
71+ case file0 of
72+ "Main.main" -> (Just "Main", files')
73+ "Test.Main.main" -> (Just "Test.Main", files')
74+ _ -> (Nothing, files)
75+ else (Nothing, files)
76+ in (opts, moduleName, files')
5877
5978main :: IO ()
6079main = do
6180 args <- getArgs
62− let (opts, files) = partition (isPrefixOf "--") args
81+ -- let (opts, files) = partition (isPrefixOf "--") args
82+ let (opts, moduleName, files) = splitArgs args
6383 opts' = (map . map) toLower opts
6484 if "--tests" `elem` opts'
6585 then runTests
@@ -81,7 +101,7 @@ main = do
81101 else
82102 processFiles opts' files
83103 if "--run" `elem` opts
84− then runBuildTool Run
104+ then runBuildTool $ Run moduleName
85105 else when ("--no-build" `notElem` opts) $
86106 runBuildTool Build
87107 return ()
@@ -100,45 +120,32 @@ main = do
100120 basePath :: [FilePath] -> FilePath
101121 basePath files =
102122 let filepath = takeDirectory (head files) in
103− joinPath $ (init $ splitDirectories filepath) ++ [outdir]
123+ joinPath $ (init $ splitDirectories filepath)
104124 generateFiles :: [String] -> [FilePath] -> IO ()
105125 generateFiles opts files = do
106126 let baseOutpath = basePath files
107− writeRuntimeFiles baseOutpath
127+ writeSupportFiles baseOutpath
108128 Par.mapM (generateCode opts baseOutpath) files
109129 return ()
110130 runBuildTool :: Command -> IO ()
111131 runBuildTool cmd = do
112− let command = case cmd of
113− Build -> "build"
114− Run -> "run"
115− currentDir <- getCurrentDirectory
116− files <- find always (extension ==? goSrc) currentDir
117− let fileDirs = nub $ joinPath . init <$> filter isSrc (getDir <$> files)
118− currentEnv <- getEnvironment
119− let pathDirs = maybe id (:) (lookup "GOPATH" currentEnv) $ fileDirs
120− searchPath = intercalate [searchPathSeparator] pathDirs
121− env = ("GOPATH", searchPath) : currentEnv
122− (_, _, _, p) <- createProcess (proc "go" [command, "Main"]){ env = Just env }
123− waitForProcess p
132+ project <- projectEnv
133+ case cmd of
134+ Build -> do
135+ callProcess "go" ["build", T.unpack project </> modPrefix' </> "Main"]
136+ Run moduleName -> do
137+ callProcess "go" ["run", T.unpack project </> modPrefix' </> fromMaybe "Main" moduleName]
124138 return ()
125− where
126− getDir :: FilePath -> [FilePath]
127− getDir file =
128− let filepath = takeDirectory file in
129− init $ splitDirectories filepath
130− isSrc :: [FilePath] -> Bool
131− isSrc components = (last components) == "src"
132139
133140generateCode :: [String] -> FilePath -> FilePath -> IO ()
134141generateCode opts baseOutpath jsonFile = do
135142 jsonModTime <- getModificationTime jsonFile
136143 let filepath = takeDirectory jsonFile
137144 dirparts = splitDirectories $ filepath
138− mname = (\c -> if c == '.' then '_' else c) <$> last dirparts
145+ mname = last dirparts
139146 basedir = joinPath $ init dirparts
140− mname' = moduleNameToIL' $ T.pack mname
141− possibleFileName = basedir </> outdir </> (T.unpack mname') </> implFileName mname'
147+ mname' = T.pack mname
148+ possibleFileName = basedir </> (T.unpack mname') </> implFileName mname'
142149 exists <- doesFileExist possibleFileName
143150 if exists
144151 then do
@@ -150,9 +157,10 @@ generateCode opts baseOutpath jsonFile = do
150157transpile :: [String] -> FilePath -> FilePath -> IO ()
151158transpile opts baseOutpath jsonFile = do
152159 jsonText <- T.decodeUtf8 <$> B.readFile jsonFile
160+ project <- projectEnv
153161 let module' = jsonToModule $ parseJson jsonText
154− ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' Nothing)
155− let mn = moduleNameToIL $ moduleName module'
162+ ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' project)
163+ let mn = moduleNameToIL' $ moduleName module'
156164 implementation = prettyPrintIL asts
157165 outpath = joinPath [baseOutpath, T.unpack mn]
158166 implPath = outpath </> implFileName mn
@@ -160,25 +168,53 @@ transpile opts baseOutpath jsonFile = do
160168 putStrLn implPath
161169 B.writeFile implPath $ T.encodeUtf8 (implHeader <> implementation <> implFooter)
162170
163−writeRuntimeFiles :: FilePath -> IO ()
164−writeRuntimeFiles baseOutpath = do
165− createDirectoryIfMissing True $ baseOutpath </> "purescript"
166− let runtimeSource = baseOutpath </> "purescript" </> "purescript.go"
167− runtimeExists <- doesFileExist runtimeSource
168− when (not runtimeExists) $ do
169− B.writeFile runtimeSource $(embedFile "runtime/purescript.go")
170−
171−outdir :: FilePath
172−outdir = "src"
171+writeSupportFiles :: FilePath -> IO ()
172+writeSupportFiles baseOutpath = do
173+ currentDir <- getCurrentDirectory
174+ let outputdir = T.pack $ baseOutpath \\ currentDir
175+ ffiOutpath = currentDir </> subdir
176+ createDirectoryIfMissing True baseOutpath
177+ createDirectoryIfMissing True ffiOutpath
178+ writeModuleFile outputdir currentDir $(embedFile "support/go.mod.working")
179+ writeModuleFile outputdir baseOutpath $(embedFile "support/go.mod.output")
180+ writeModuleFile outputdir ffiOutpath $(embedFile "support/go.mod.ffi-loader")
181+ writeLoaderFile ffiOutpath $(embedFile "support/ffi-loader.go")
182+ where
183+ writeModuleFile :: Text -> FilePath -> B.ByteString -> IO ()
184+ writeModuleFile outputdir path modText = do
185+ let goModSource = path </> "go.mod"
186+ goModSourceExists <- doesFileExist goModSource
187+ when (not goModSourceExists) $ do
188+ project <- projectEnv
189+ let project' = T.unpack project
190+ outputdir' = tail $ T.unpack outputdir
191+ modText' = T.replace "$PROJECT" project $ T.decodeUtf8 modText
192+ replaceLoader = project' </> ffiLoader' <> "=." </> subdir
193+ replaceOutput = project' </> modPrefix' <> "=." </> outputdir'
194+ B.writeFile goModSource $ T.encodeUtf8 modText'
195+ callProcess "go" ["mod", "edit", "-replace", replaceLoader]
196+ callProcess "go" ["mod", "edit", "-replace", replaceOutput]
197+ callProcess "go" ["clean", "-modcache"]
198+ writeLoaderFile :: FilePath -> B.ByteString -> IO ()
199+ writeLoaderFile ffiOutpath loaderText = do
200+ let loaderSource = ffiOutpath </> "ffi_loader.go"
201+ loaderSourceExists <- doesFileExist loaderSource
202+ when (not loaderSourceExists) $ do
203+ B.writeFile loaderSource loaderText
173204
174205implFileName :: Text -> FilePath
175−implFileName mn = T.unpack $ mn <> ".go"
206+implFileName mn = ((\c -> if c == '.' then '_' else c) <$> T.unpack mn) <> ".go"
207+
208+projectEnv :: IO Text
209+projectEnv = do
210+ T.pack . fromMaybe defaultProject <$> lookupEnv goproject
176211
177212help :: String
178213help = "Usage: psgo OPTIONS COREFN-FILES\n\
179214 \ PureScript to native (via go) compiler\n\n\
180215 \Available options:\n\
181216 \ --help Show this help text\n\n\
217+ \ --version Show the version number\n\n\
182218 \ --run Run the generated go code directly, without building an\n\
183219 \ executable\n\
184220 \ --no-build Generate go source files, but do not build an executable\n\
@@ -192,6 +228,21 @@ corefn = "corefn.json"
192228goSrc :: String
193229goSrc = ".go"
194230
231+goproject :: String
232+goproject = "GOPROJECT"
233+
234+defaultProject :: String
235+defaultProject = "project.localhost"
236+
237+modPrefix' :: String
238+modPrefix' = T.unpack modPrefix
239+
240+ffiLoader' :: String
241+ffiLoader' = T.unpack ffiLoader
242+
243+subdir :: String
244+subdir = T.unpack modLabel
245+
195246errorNoCorefnFiles :: IO ()
196247errorNoCorefnFiles = do
197248 ioError . userError $ "no compiled purescript '" <> corefn <> "' files found –\n" <>