@@ -36,7 +36,7 @@ import Data.Version (showVersion)
36import qualified Data.Map as M
36import qualified Data.Map as M
37import qualified Data.ByteString.Char8 as B
37import qualified Data.ByteString.Char8 as B
39−import System.Directory (doesDirectoryExist, doesFileExist, getModificationTime, createDirectoryIfMissing)
39+import System.Directory (copyFile, doesDirectoryExist, doesFileExist, getModificationTime, createDirectoryIfMissing)
40import System.FilePath ((</>), takeDirectory, addExtension, dropExtension)
40import System.FilePath ((</>), takeDirectory, addExtension, dropExtension)
41import System.IO.Error (tryIOError)
41import System.IO.Error (tryIOError)
42import System.IO.UTF8
42import System.IO.UTF8
@@ -54,11 +54,6 @@ makeIO f io = do
54 e <- liftIO $ tryIOError io
54 e <- liftIO $ tryIOError io
55 either (throwError . P.singleError . f) return e
55 either (throwError . P.singleError . f) return e
57−-- Traverse (Either e) instance (base 4.7)
58−traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
59−traverseEither _ (Left x) = pure (Left x)
60−traverseEither f (Right y) = Right <$> f y
62buildMakeActions :: FilePath
57buildMakeActions :: FilePath
63 -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
58 -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
@@ -77,17 +72,23 @@ buildMakeActions outputDir filePathMap usePrefix =
77 getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
72 getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
78 getInputTimestamp mn = do
73 getInputTimestamp mn = do
79 let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
74 let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
75+ let filePath = either (const []) takeDirectory path
76+ fileBase = filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)
77+ sourceFFI = addExtension fileBase sourceExt
78+ headerFFI = addExtension fileBase headerExt
80− traverseEither getTimestamp path
79+ e1 <- traverse getTimestamp path
80+ sffi <- getTimestamp sourceFFI
81+ hffi <- getTimestamp headerFFI
82+ return $ fmap (max (max sffi hffi)) e1
82 getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
84 getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
83 getOutputTimestamp mn = do
85 getOutputTimestamp mn = do
85 let filePath = dotsTo '/' $ P.runModuleName mn
86 let filePath = dotsTo '/' $ P.runModuleName mn
86 fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)
87 fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)
87− srcFile = addExtension fileBase "cc"
88+ sourceFile = addExtension fileBase sourceExt
88−-- headerFile = addExtension fileBase "hh"
89+ headerFile = addExtension fileBase headerExt
89 externsFile = outputDir </> filePath </> "externs.purs"
90 externsFile = outputDir </> filePath </> "externs.purs"
90− min <$> getTimestamp srcFile <*> getTimestamp externsFile
91+ foldl min <$> getTimestamp externsFile <*> mapM getTimestamp [sourceFile, headerFile]
92 readExterns :: P.ModuleName -> Make (FilePath, P.Externs)
93 readExterns :: P.ModuleName -> Make (FilePath, P.Externs)
93 readExterns mn = do
94 readExterns mn = do
@@ -99,8 +100,8 @@ buildMakeActions outputDir filePathMap usePrefix =
99 let mn = CF.moduleName m
100 let mn = CF.moduleName m
100 let filePath = dotsTo '/' $ P.runModuleName mn
101 let filePath = dotsTo '/' $ P.runModuleName mn
101 fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)
102 fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)
102− srcFile = addExtension fileBase "cc"
103+ sourceFile = addExtension fileBase sourceExt
103− headerFile = addExtension fileBase "hh"
104+ headerFile = addExtension fileBase headerExt
104 externsFile = outputDir </> filePath </> "externs.purs"
105 externsFile = outputDir </> filePath </> "externs.purs"
105 prefix = ["Generated by pcc version " ++ showVersion Paths.version | usePrefix]
106 prefix = ["Generated by pcc version " ++ showVersion Paths.version | usePrefix]
106 cpps <- CPP.moduleToCpp env m
107 cpps <- CPP.moduleToCpp env m
@@ -111,7 +112,7 @@ buildMakeActions outputDir filePathMap usePrefix =
111 hdr = unlines $ map ("// " ++) prefix ++ [phdrs]
112 hdr = unlines $ map ("// " ++) prefix ++ [phdrs]
113 lift $ do
114 lift $ do
114− writeTextFile srcFile src
115+ writeTextFile sourceFile src
115 writeTextFile headerFile hdr
116 writeTextFile headerFile hdr
116 writeTextFile externsFile exts
117 writeTextFile externsFile exts
@@ -123,18 +124,17 @@ buildMakeActions outputDir filePathMap usePrefix =
123 writeTextFile (supportDir </> "purescript_memory.hh") $ B.unpack $(embedFile "pcc/include/purescript_memory.hh")
124 writeTextFile (supportDir </> "purescript_memory.hh") $ B.unpack $(embedFile "pcc/include/purescript_memory.hh")
125 let inputPath = dropExtension $ getInputFile mn
126 let inputPath = dropExtension $ getInputFile mn
126− hfile = addExtension inputPath "hh"
127+ hfile = addExtension inputPath headerExt
127− sfile = addExtension inputPath "cc"
128+ sfile = addExtension inputPath sourceExt
128 hfileExists <- textFileExists hfile
129 hfileExists <- textFileExists hfile
129 when (hfileExists || requiresForeign m) $ do
130 when (hfileExists || requiresForeign m) $ do
131+ let dstFile = addExtension (fileBase ++ ffiMangle) headerExt
130− text <- if hfileExists
132+ if hfileExists
131− then readTextFile hfile
133+ then copyTextFile dstFile hfile
132− else pure []
134+ else writeTextFile dstFile []
133− writeTextFile (addExtension (fileBase ++ "_ffi") "hh") text
134 sfileExists <- textFileExists sfile
135 sfileExists <- textFileExists sfile
135 when (sfileExists) $ do
136 when (sfileExists) $ do
136− text' <- readTextFile sfile
137− writeTextFile (addExtension (fileBase ++ "_ffi") "cc") text'
137+ copyTextFile (addExtension (fileBase ++ ffiMangle) sourceExt) sfile
139 requiresForeign :: CF.Module a -> Bool
139 requiresForeign :: CF.Module a -> Bool
140 requiresForeign = not . null . CF.moduleForeign
140 requiresForeign = not . null . CF.moduleForeign
@@ -155,6 +155,11 @@ buildMakeActions outputDir filePathMap usePrefix =
155 readTextFile :: FilePath -> Make String
155 readTextFile :: FilePath -> Make String
156 readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path
156 readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path
158+ copyTextFile :: FilePath -> FilePath -> Make ()
159+ copyTextFile to from = makeIO (const (ErrorMessage [] $ CannotWriteFile to)) $ do
160+ createDirectoryIfMissing True (takeDirectory to)
158 writeTextFile :: FilePath -> String -> Make ()
163 writeTextFile :: FilePath -> String -> Make ()
159 writeTextFile path text = makeIO (const (ErrorMessage [] $ CannotWriteFile path)) $ do
164 writeTextFile path text = makeIO (const (ErrorMessage [] $ CannotWriteFile path)) $ do
160 createDirectoryIfMissing True (takeDirectory path)
165 createDirectoryIfMissing True (takeDirectory path)
@@ -170,3 +175,12 @@ buildMakeActions outputDir filePathMap usePrefix =
171dotsTo :: Char -> String -> String
176dotsTo :: Char -> String -> String
172dotsTo chr = map (\c -> if c == '.' then chr else c)
177dotsTo chr = map (\c -> if c == '.' then chr else c)