@@ -10,7 +10,7 @@ import Data.Aeson
1010import Data.Aeson.Types
1111import Data.Char
1212import Data.FileEmbed (embedFile)
13−import Data.List (delete, isPrefixOf, partition)
13+import Data.List (delete, intercalate, isPrefixOf, nub, partition, (\\))
1414import Data.Maybe
1515import Data.Monoid ((<>))
1616import Data.Version
@@ -22,6 +22,7 @@ import System.Environment
2222import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory, getModificationTime)
2323import System.FilePath ((</>), joinPath, splitDirectories, takeDirectory)
2424import System.FilePath.Find
25+import System.Process
2526
2627import Data.Text (Text)
2728import qualified Data.Text as T
@@ -30,6 +31,8 @@ import qualified Data.Text.Lazy as L
3031import qualified Data.Text.Lazy.Encoding as L
3132import qualified Data.ByteString as B
3233
34+import Development.GitRev
35+
3336import Language.PureScript.AST.Literals
3437import Language.PureScript.CoreFn
3538import Language.PureScript.CoreFn.FromJSON
@@ -40,6 +43,8 @@ import CodeGen.IL.Printer
4043
4144import Tests
4245
46+data Command = Build | Run (Maybe String)
47+
4348parseJson :: Text -> Value
4449parseJson text
4550 | Just fileJson <- decode . L.encodeUtf8 $ L.fromStrict text = fileJson
@@ -49,63 +54,98 @@ jsonToModule :: Value -> Module Ann
4954jsonToModule value =
5055 case parse moduleFromJSON value of
5156 Success (_, r) -> r
52− _ -> 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')
5377
5478main :: IO ()
5579main = do
5680 args <- getArgs
57− let (opts, files) = partition (isPrefixOf "--") args
81+ -- let (opts, files) = partition (isPrefixOf "--") args
82+ let (opts, moduleName, files) = splitArgs args
5883 opts' = (map . map) toLower opts
5984 if "--tests" `elem` opts'
6085 then runTests
6186 else do
62− when ("--makefile" `elem` opts') $
63− B.writeFile "Makefile" $(embedFile "support/Makefile")
64− when ("--help" `elem` opts') $
65− putStrLn help
66− if null files then do
67− currentDir <- getCurrentDirectory
68− processFiles opts' [currentDir]
69− else do
70− processFiles opts' files
71− return ()
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 ""
96+ else do
97+ if null files
98+ then do
99+ currentDir <- getCurrentDirectory
100+ processFiles opts' [currentDir]
101+ else
102+ processFiles opts' files
103+ if "--run" `elem` opts
104+ then runBuildTool $ Run moduleName
105+ else when ("--no-build" `notElem` opts) $
106+ runBuildTool Build
107+ return ()
72108 where
73109 processFiles :: [String] -> [FilePath] -> IO ()
74110 processFiles opts [file] = do
75111 isDir <- doesDirectoryExist file
76112 if isDir then do
77113 files <- find always (fileName ==? corefn) file
78− if null files then do
79− noneFound
80− else do
81− generateFiles opts files
82− else do
83− generateFiles opts [file]
114+ if null files
115+ then errorNoCorefnFiles
116+ else generateFiles opts files
117+ else generateFiles opts [file]
84118 processFiles opts files = do
85− let baseOutpath = basePath files
86− writeRuntimeFiles baseOutpath
87− Par.mapM (generateCode opts baseOutpath) files
88− return ()
119+ generateFiles opts files
89120 basePath :: [FilePath] -> FilePath
90121 basePath files =
91122 let filepath = takeDirectory (head files) in
92− joinPath $ (init $ splitDirectories filepath) ++ [outdir]
123+ joinPath $ (init $ splitDirectories filepath)
93124 generateFiles :: [String] -> [FilePath] -> IO ()
94125 generateFiles opts files = do
95126 let baseOutpath = basePath files
96− writeRuntimeFiles baseOutpath
127+ writeSupportFiles baseOutpath
97128 Par.mapM (generateCode opts baseOutpath) files
98129 return ()
130+ runBuildTool :: Command -> IO ()
131+ runBuildTool cmd = do
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]
138+ return ()
99139
100140generateCode :: [String] -> FilePath -> FilePath -> IO ()
101141generateCode opts baseOutpath jsonFile = do
102142 jsonModTime <- getModificationTime jsonFile
103143 let filepath = takeDirectory jsonFile
104144 dirparts = splitDirectories $ filepath
105− mname = (\c -> if c == '.' then '_' else c) <$> last dirparts
145+ mname = last dirparts
106146 basedir = joinPath $ init dirparts
107− mname' = moduleNameToIL' $ T.pack mname
108− possibleFileName = basedir </> outdir </> (T.unpack mname') </> implFileName mname'
147+ mname' = T.pack mname
148+ possibleFileName = basedir </> (T.unpack mname') </> implFileName mname'
109149 exists <- doesFileExist possibleFileName
110150 if exists
111151 then do
@@ -117,9 +157,10 @@ generateCode opts baseOutpath jsonFile = do
117157transpile :: [String] -> FilePath -> FilePath -> IO ()
118158transpile opts baseOutpath jsonFile = do
119159 jsonText <- T.decodeUtf8 <$> B.readFile jsonFile
160+ project <- projectEnv
120161 let module' = jsonToModule $ parseJson jsonText
121− ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' Nothing)
122− let mn = moduleNameToIL $ moduleName module'
162+ ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' project)
163+ let mn = moduleNameToIL' $ moduleName module'
123164 implementation = prettyPrintIL asts
124165 outpath = joinPath [baseOutpath, T.unpack mn]
125166 implPath = outpath </> implFileName mn
@@ -127,28 +168,56 @@ transpile opts baseOutpath jsonFile = do
127168 putStrLn implPath
128169 B.writeFile implPath $ T.encodeUtf8 (implHeader <> implementation <> implFooter)
129170
130−writeRuntimeFiles :: FilePath -> IO ()
131−writeRuntimeFiles baseOutpath = do
132− createDirectoryIfMissing True $ baseOutpath </> "purescript"
133− let runtimeSource = baseOutpath </> "purescript" </> "purescript.go"
134− runtimeExists <- doesFileExist runtimeSource
135− when (not runtimeExists) $ do
136− B.writeFile runtimeSource $(embedFile "runtime/purescript.go")
137−
138−outdir :: FilePath
139−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
140204
141205implFileName :: Text -> FilePath
142−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
143211
144212help :: String
145213help = "Usage: psgo OPTIONS COREFN-FILES\n\
146− \ PureScript-to-go compiler\n\n\
214+ \ PureScript to native (via go) compiler\n\n\
147215 \Available options:\n\
148216 \ --help Show this help text\n\n\
149− \ --makefile Generate a GNU Makefile which can be used for compiling\n\
150− \ a PureScript program and libraries to a native binary via\n\
151− \ purs corefn output and C++\n\n\
217+ \ --version Show the version number\n\n\
218+ \ --run Run the generated go code directly, without building an\n\
219+ \ executable\n\
220+ \ --no-build Generate go source files, but do not build an executable\n\
152221 \ --tests Run test cases (under construction)\n\n\
153222 \See also:\n\
154223 \ purs compile --help\n"
@@ -156,6 +225,26 @@ help = "Usage: psgo OPTIONS COREFN-FILES\n\
156225corefn :: String
157226corefn = "corefn.json"
158227
159−noneFound :: IO ()
160−noneFound = do
161− putStrLn $ "No compiled purescript files (" <> corefn <> ") found"
228+goSrc :: String
229+goSrc = ".go"
230+
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+
246+errorNoCorefnFiles :: IO ()
247+errorNoCorefnFiles = do
248+ ioError . userError $ "no compiled purescript '" <> corefn <> "' files found –\n" <>
249+ " make sure to use the '--codegen corefn' option with your purs\n" <>
250+ " project build tool"