@@ -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
@@ -31,6 +31,8 @@ import qualified Data.Text.Lazy as L
3131import qualified Data.Text.Lazy.Encoding as L
3232import qualified Data.ByteString as B
3333
34+import Development.GitRev
35+
3436import Language.PureScript.AST.Literals
3537import Language.PureScript.CoreFn
3638import Language.PureScript.CoreFn.FromJSON
@@ -41,7 +43,7 @@ import CodeGen.IL.Printer
4143
4244import Tests
4345
44−data Command = Build | Run
46+data Command = Build | Run (Maybe String)
4547
4648parseJson :: Text -> Value
4749parseJson text
@@ -52,18 +54,45 @@ jsonToModule :: Value -> Module Ann
5254jsonToModule value =
5355 case parse moduleFromJSON value of
5456 Success (_, r) -> r
55− _ -> 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')
5677
5778main :: IO ()
5879main = do
5980 args <- getArgs
60− let (opts, files) = partition (isPrefixOf "--") args
81+ -- let (opts, files) = partition (isPrefixOf "--") args
82+ let (opts, moduleName, files) = splitArgs args
6183 opts' = (map . map) toLower opts
6284 if "--tests" `elem` opts'
6385 then runTests
6486 else do
65− if "--help" `elem` opts'
66− then putStrLn help
87+ if "--help" `elem` opts' || "--version" `elem` opts'
88+ then do
89+ when ("--help" `elem` opts') $ do
90+ putStrLn help
91+ when ("--version" `elem` opts') $ do
92+ let branch = $(gitBranch)
93+ details | branch == "golang" = "master, commit " ++ $(gitHash)
94+ | otherwise = branch
95+ putStrLn $ details ++ if $(gitDirty) then " (DIRTY)" else ""
6796 else do
6897 if null files
6998 then do
@@ -72,7 +101,7 @@ main = do
72101 else
73102 processFiles opts' files
74103 if "--run" `elem` opts
75− then runBuildTool Run
104+ then runBuildTool $ Run moduleName
76105 else when ("--no-build" `notElem` opts) $
77106 runBuildTool Build
78107 return ()
@@ -91,45 +120,32 @@ main = do
91120 basePath :: [FilePath] -> FilePath
92121 basePath files =
93122 let filepath = takeDirectory (head files) in
94− joinPath $ (init $ splitDirectories filepath) ++ [outdir]
123+ joinPath $ (init $ splitDirectories filepath)
95124 generateFiles :: [String] -> [FilePath] -> IO ()
96125 generateFiles opts files = do
97126 let baseOutpath = basePath files
98− writeRuntimeFiles baseOutpath
127+ writeSupportFiles baseOutpath
99128 Par.mapM (generateCode opts baseOutpath) files
100129 return ()
101130 runBuildTool :: Command -> IO ()
102131 runBuildTool cmd = do
103− let command = case cmd of
104− Build -> "build"
105− Run -> "run"
106− currentDir <- getCurrentDirectory
107− files <- find always (extension ==? goSrc) currentDir
108− let fileDirs = nub $ joinPath . init <$> filter isSrc (getDir <$> files)
109− currentEnv <- getEnvironment
110− let pathDirs = maybe id (:) (lookup "GOPATH" currentEnv) $ fileDirs
111− searchPath = intercalate [searchPathSeparator] pathDirs
112− env = ("GOPATH", searchPath) : currentEnv
113− (_, _, _, p) <- createProcess (proc "go" [command, "Main"]){ env = Just env }
114− 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]
115138 return ()
116− where
117− getDir :: FilePath -> [FilePath]
118− getDir file =
119− let filepath = takeDirectory file in
120− init $ splitDirectories filepath
121− isSrc :: [FilePath] -> Bool
122− isSrc components = (last components) == "src"
123139
124140generateCode :: [String] -> FilePath -> FilePath -> IO ()
125141generateCode opts baseOutpath jsonFile = do
126142 jsonModTime <- getModificationTime jsonFile
127143 let filepath = takeDirectory jsonFile
128144 dirparts = splitDirectories $ filepath
129− mname = (\c -> if c == '.' then '_' else c) <$> last dirparts
145+ mname = last dirparts
130146 basedir = joinPath $ init dirparts
131− mname' = moduleNameToIL' $ T.pack mname
132− possibleFileName = basedir </> outdir </> (T.unpack mname') </> implFileName mname'
147+ mname' = T.pack mname
148+ possibleFileName = basedir </> (T.unpack mname') </> implFileName mname'
133149 exists <- doesFileExist possibleFileName
134150 if exists
135151 then do
@@ -141,9 +157,10 @@ generateCode opts baseOutpath jsonFile = do
141157transpile :: [String] -> FilePath -> FilePath -> IO ()
142158transpile opts baseOutpath jsonFile = do
143159 jsonText <- T.decodeUtf8 <$> B.readFile jsonFile
160+ project <- projectEnv
144161 let module' = jsonToModule $ parseJson jsonText
145− ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' Nothing)
146− let mn = moduleNameToIL $ moduleName module'
162+ ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' project)
163+ let mn = moduleNameToIL' $ moduleName module'
147164 implementation = prettyPrintIL asts
148165 outpath = joinPath [baseOutpath, T.unpack mn]
149166 implPath = outpath </> implFileName mn
@@ -151,25 +168,53 @@ transpile opts baseOutpath jsonFile = do
151168 putStrLn implPath
152169 B.writeFile implPath $ T.encodeUtf8 (implHeader <> implementation <> implFooter)
153170
154−writeRuntimeFiles :: FilePath -> IO ()
155−writeRuntimeFiles baseOutpath = do
156− createDirectoryIfMissing True $ baseOutpath </> "purescript"
157− let runtimeSource = baseOutpath </> "purescript" </> "purescript.go"
158− runtimeExists <- doesFileExist runtimeSource
159− when (not runtimeExists) $ do
160− B.writeFile runtimeSource $(embedFile "runtime/purescript.go")
161−
162−outdir :: FilePath
163−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
164204
165205implFileName :: Text -> FilePath
166−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
167211
168212help :: String
169213help = "Usage: psgo OPTIONS COREFN-FILES\n\
170214 \ PureScript to native (via go) compiler\n\n\
171215 \Available options:\n\
172216 \ --help Show this help text\n\n\
217+ \ --version Show the version number\n\n\
173218 \ --run Run the generated go code directly, without building an\n\
174219 \ executable\n\
175220 \ --no-build Generate go source files, but do not build an executable\n\
@@ -183,6 +228,21 @@ corefn = "corefn.json"
183228goSrc :: String
184229goSrc = ".go"
185230
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+
186246errorNoCorefnFiles :: IO ()
187247errorNoCorefnFiles = do
188248 ioError . userError $ "no compiled purescript '" <> corefn <> "' files found –\n" <>