@@ -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, isPrefixOf, partition)
1414import Data.Maybe
1515import Data.Monoid ((<>))
1616import Data.Version
@@ -19,10 +19,8 @@ import Control.Monad.Supply.Class
1919import Text.Printf
2020
2121import System.Environment
22−import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory, getModificationTime)
22+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getModificationTime)
2323import System.FilePath ((</>), joinPath, splitDirectories, takeDirectory)
24−import System.FilePath.Find
25−import System.Process
2624
2725import Data.Text (Text)
2826import qualified Data.Text as T
@@ -31,8 +29,6 @@ import qualified Data.Text.Lazy as L
3129import qualified Data.Text.Lazy.Encoding as L
3230import qualified Data.ByteString as B
3331
34−import Development.GitRev
35−
3632import Language.PureScript.AST.Literals
3733import Language.PureScript.CoreFn
3834import Language.PureScript.CoreFn.FromJSON
@@ -43,8 +39,6 @@ import CodeGen.IL.Printer
4339
4440import Tests
4541
46−data Command = Build | Run (Maybe String)
47−
4842parseJson :: Text -> Value
4943parseJson text
5044 | Just fileJson <- decode . L.encodeUtf8 $ L.fromStrict text = fileJson
@@ -54,98 +48,40 @@ jsonToModule :: Value -> Module Ann
5448jsonToModule value =
5549 case parse moduleFromJSON value of
5650 Success (_, r) -> r
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')
51+ _ -> error "failed"
7752
7853main :: IO ()
7954main = do
8055 args <- getArgs
81− -- let (opts, files) = partition (isPrefixOf "--") args
82− let (opts, moduleName, files) = splitArgs args
83− opts' = (map . map) toLower opts
84− if "--tests" `elem` opts'
85− then runTests
56+ if null args
57+ then return ()
8658 else do
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 ""
59+ let (opts, files) = partition (isPrefixOf "--") args
60+ opts' = (map . map) toLower opts
61+ if "--tests" `elem` opts'
62+ then runTests
9663 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 ()
108− where
109− processFiles :: [String] -> [FilePath] -> IO ()
110− processFiles opts [file] = do
111− isDir <- doesDirectoryExist file
112− if isDir then do
113− files <- find always (fileName ==? corefn) file
114− if null files
115− then errorNoCorefnFiles
116− else generateFiles opts files
117− else generateFiles opts [file]
118− processFiles opts files = do
119− generateFiles opts files
120− basePath :: [FilePath] -> FilePath
121− basePath files =
122− let filepath = takeDirectory (head files) in
123− joinPath $ (init $ splitDirectories filepath)
124− generateFiles :: [String] -> [FilePath] -> IO ()
125− generateFiles opts files = do
126− let baseOutpath = basePath files
127− writeSupportFiles baseOutpath
128− Par.mapM (generateCode opts baseOutpath) files
129− 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 ()
64+ when ("--makefile" `elem` opts') $
65+ B.writeFile "Makefile" $(embedFile "support/Makefile")
66+ when ("--help" `elem` opts') $
67+ putStrLn help
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 ()
74+ return ()
13975
14076generateCode :: [String] -> FilePath -> FilePath -> IO ()
14177generateCode opts baseOutpath jsonFile = do
14278 jsonModTime <- getModificationTime jsonFile
14379 let filepath = takeDirectory jsonFile
14480 dirparts = splitDirectories $ filepath
145− mname = last dirparts
81+ mname = (\c -> if c == '.' then '_' else c) <$> last dirparts
14682 basedir = joinPath $ init dirparts
147− mname' = T.pack mname
148− possibleFileName = basedir </> (T.unpack mname') </> implFileName mname'
83+ mname' = moduleNameToIL' $ T.pack mname
84+ possibleFileName = basedir </> outdir </> (T.unpack mname') </> implFileName mname'
14985 exists <- doesFileExist possibleFileName
15086 if exists
15187 then do
@@ -157,10 +93,9 @@ generateCode opts baseOutpath jsonFile = do
15793transpile :: [String] -> FilePath -> FilePath -> IO ()
15894transpile opts baseOutpath jsonFile = do
15995 jsonText <- T.decodeUtf8 <$> B.readFile jsonFile
160− project <- projectEnv
16196 let module' = jsonToModule $ parseJson jsonText
162− ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' project)
163− let mn = moduleNameToIL' $ moduleName module'
97+ ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' Nothing)
98+ let mn = moduleNameToIL $ moduleName module'
16499 implementation = prettyPrintIL asts
165100 outpath = joinPath [baseOutpath, T.unpack mn]
166101 implPath = outpath </> implFileName mn
@@ -168,83 +103,28 @@ transpile opts baseOutpath jsonFile = do
168103 putStrLn implPath
169104 B.writeFile implPath $ T.encodeUtf8 (implHeader <> implementation <> implFooter)
170105
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
106+writeRuntimeFiles :: FilePath -> IO ()
107+writeRuntimeFiles baseOutpath = do
108+ createDirectoryIfMissing True $ baseOutpath </> "purescript"
109+ let runtimeSource = baseOutpath </> "purescript" </> "purescript.go"
110+ runtimeExists <- doesFileExist runtimeSource
111+ when (not runtimeExists) $ do
112+ B.writeFile runtimeSource $(embedFile "runtime/purescript.go")
204113
205−implFileName :: Text -> FilePath
206−implFileName mn = ((\c -> if c == '.' then '_' else c) <$> T.unpack mn) <> ".go"
114+outdir :: FilePath
115+outdir = "src"
207116
208−projectEnv :: IO Text
209−projectEnv = do
210− T.pack . fromMaybe defaultProject <$> lookupEnv goproject
117+implFileName :: Text -> FilePath
118+implFileName mn = T.unpack $ mn <> ".go"
211119
212120help :: String
213121help = "Usage: psgo OPTIONS COREFN-FILES\n\
214− \ PureScript to native (via go) compiler\n\n\
122+ \ PureScript-to-go compiler\n\n\
215123 \Available options:\n\
216124 \ --help Show this help text\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\
125+ \ --makefile Generate a GNU Makefile which can be used for compiling\n\
126+ \ a PureScript program and libraries to a native binary via\n\
127+ \ purs corefn output and C++\n\n\
221128 \ --tests Run test cases (under construction)\n\n\
222129 \See also:\n\
223130 \ purs compile --help\n"
224−
225−corefn :: String
226−corefn = "corefn.json"
227−
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"