@@ -69,62 +69,25 @@ import Text.Parsec (ParseError)
6969modulesDir :: FilePath
7070modulesDir = ".test_modules" </> "node_modules"
7171
72−newtype Test a = Test { unTest :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
73− deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)
74−
75−runTest :: Test a -> IO (Either P.MultipleErrors a)
76−runTest = runExceptT . fmap fst . runWriterT . flip runReaderT P.defaultOptions . unTest
77−
78−makeActions :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> P.MakeActions Test
79−makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
72+makeActions :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> P.MakeActions P.Make
73+makeActions foreigns = (P.buildMakeActions modulesDir (error "makeActions: input file map was read.") foreigns False)
74+ { P.getInputTimestamp = getInputTimestamp
75+ , P.getOutputTimestamp = getOutputTimestamp
76+ }
8077 where
81− getInputTimestamp :: P.ModuleName -> Test (Either P.RebuildPolicy (Maybe UTCTime))
78+ getInputTimestamp :: P.ModuleName -> P.Make (Either P.RebuildPolicy (Maybe UTCTime))
8279 getInputTimestamp mn
8380 | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)
8481 | otherwise = return (Left P.RebuildAlways)
8582 where
8683 isSupportModule = flip elem supportModules
8784
88− getOutputTimestamp :: P.ModuleName -> Test (Maybe UTCTime)
85+ getOutputTimestamp :: P.ModuleName -> P.Make (Maybe UTCTime)
8986 getOutputTimestamp mn = do
9087 let filePath = modulesDir </> P.runModuleName mn
9188 exists <- liftIO $ doesDirectoryExist filePath
9289 return (if exists then Just (error "getOutputTimestamp: read timestamp") else Nothing)
9390
94− readExterns :: P.ModuleName -> Test (FilePath, String)
95− readExterns mn = do
96− let filePath = modulesDir </> P.runModuleName mn </> "externs.purs"
97− (filePath, ) <$> readTextFile filePath
98−
99− codegen :: CF.Module CF.Ann -> P.Environment -> P.Externs -> P.SupplyT Test ()
100− codegen m _ exts = do
101− let mn = CF.moduleName m
102− foreignInclude <- case (CF.moduleName m `M.lookup` foreigns, CF.moduleForeign m) of
103− (Just _, []) -> error "Unnecessary foreign module"
104− (Just path, _) -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
105− (Nothing, []) -> return Nothing
106− (Nothing, _) -> error "Missing foreign module"
107− pjs <- P.prettyPrintJS <$> J.moduleToJs m foreignInclude
108− let filePath = P.runModuleName $ CF.moduleName m
109− jsFile = modulesDir </> filePath </> "index.js"
110− externsFile = modulesDir </> filePath </> "externs.purs"
111− foreignFile = modulesDir </> filePath </> "foreign.js"
112− lift $ do
113− writeTextFile jsFile pjs
114− maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns
115− writeTextFile externsFile exts
116−
117− readTextFile :: FilePath -> Test String
118− readTextFile path = liftIO $ readFile path
119−
120− writeTextFile :: FilePath -> String -> Test ()
121− writeTextFile path text = liftIO $ do
122− createDirectoryIfMissing True (takeDirectory path)
123− writeFile path text
124−
125− progress :: P.ProgressMessage -> Test ()
126− progress = liftIO . putStrLn . P.renderProgressMessage
127−
12891readInput :: [FilePath] -> IO [(FilePath, String)]
12992readInput inputFiles = forM inputFiles $ \inputFile -> do
13093 text <- readFile inputFile
@@ -132,6 +95,9 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do
13295
13396type TestM = WriterT [(FilePath, String)] IO
13497
98+runTest :: P.Make a -> IO (Either P.MultipleErrors a)
99+runTest = fmap (fmap fst) . P.runMake P.defaultOptions
100+
135101compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment)
136102compile inputFiles foreigns = runTest $ do
137103 fs <- liftIO $ readInput inputFiles