@@ -69,62 +69,25 @@ import Text.Parsec (ParseError)
69modulesDir :: FilePath
69modulesDir :: FilePath
70modulesDir = ".test_modules" </> "node_modules"
70modulesDir = ".test_modules" </> "node_modules"
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)
75−runTest :: Test a -> IO (Either P.MultipleErrors a)
76−runTest = runExceptT . fmap fst . runWriterT . flip runReaderT P.defaultOptions . unTest
78−makeActions :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> P.MakeActions Test
72+makeActions :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> P.MakeActions P.Make
79−makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
73+makeActions foreigns = (P.buildMakeActions modulesDir (error "makeActions: input file map was read.") foreigns False)
74+ { P.getInputTimestamp = getInputTimestamp
75+ , P.getOutputTimestamp = getOutputTimestamp
81− getInputTimestamp :: P.ModuleName -> Test (Either P.RebuildPolicy (Maybe UTCTime))
78+ getInputTimestamp :: P.ModuleName -> P.Make (Either P.RebuildPolicy (Maybe UTCTime))
82 getInputTimestamp mn
79 getInputTimestamp mn
83 | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)
80 | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)
84 | otherwise = return (Left P.RebuildAlways)
81 | otherwise = return (Left P.RebuildAlways)
86 isSupportModule = flip elem supportModules
83 isSupportModule = flip elem supportModules
88− getOutputTimestamp :: P.ModuleName -> Test (Maybe UTCTime)
85+ getOutputTimestamp :: P.ModuleName -> P.Make (Maybe UTCTime)
89 getOutputTimestamp mn = do
86 getOutputTimestamp mn = do
90 let filePath = modulesDir </> P.runModuleName mn
87 let filePath = modulesDir </> P.runModuleName mn
91 exists <- liftIO $ doesDirectoryExist filePath
88 exists <- liftIO $ doesDirectoryExist filePath
92 return (if exists then Just (error "getOutputTimestamp: read timestamp") else Nothing)
89 return (if exists then Just (error "getOutputTimestamp: read timestamp") else Nothing)
94− readExterns :: P.ModuleName -> Test (FilePath, String)
96− let filePath = modulesDir </> P.runModuleName mn </> "externs.purs"
97− (filePath, ) <$> readTextFile filePath
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"
113− writeTextFile jsFile pjs
114− maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns
115− writeTextFile externsFile exts
117− readTextFile :: FilePath -> Test String
118− readTextFile path = liftIO $ readFile path
120− writeTextFile :: FilePath -> String -> Test ()
121− writeTextFile path text = liftIO $ do
122− createDirectoryIfMissing True (takeDirectory path)
125− progress :: P.ProgressMessage -> Test ()
126− progress = liftIO . putStrLn . P.renderProgressMessage
128readInput :: [FilePath] -> IO [(FilePath, String)]
91readInput :: [FilePath] -> IO [(FilePath, String)]
129readInput inputFiles = forM inputFiles $ \inputFile -> do
92readInput inputFiles = forM inputFiles $ \inputFile -> do
130 text <- readFile inputFile
93 text <- readFile inputFile
@@ -132,6 +95,9 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do
133type TestM = WriterT [(FilePath, String)] IO
96type TestM = WriterT [(FilePath, String)] IO
98+runTest :: P.Make a -> IO (Either P.MultipleErrors a)
99+runTest = fmap (fmap fst) . P.runMake P.defaultOptions
135compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment)
101compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment)
136compile inputFiles foreigns = runTest $ do
102compile inputFiles foreigns = runTest $ do
137 fs <- liftIO $ readInput inputFiles
103 fs <- liftIO $ readInput inputFiles