@@ -1,43 +1,64 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE PackageImports #-}
2{-# LANGUAGE PackageImports #-}
3+{-# LANGUAGE RecordWildCards #-}
4+{-# LANGUAGE TemplateHaskell #-}
5+{-# LANGUAGE TupleSections #-}
4−module Language.PureScript.Ide.Rebuild where
7+module Language.PureScript.Ide.Rebuild
6−import Prelude.Compat
9+ ) where
8−import Language.PureScript.Ide.Error
9−import Language.PureScript.Ide.State
10−import Language.PureScript.Ide.Types
12import Control.Monad.Error.Class
11import Control.Monad.Error.Class
13import Control.Monad.IO.Class
12import Control.Monad.IO.Class
14import "monad-logger" Control.Monad.Logger
13import "monad-logger" Control.Monad.Logger
15−import Control.Monad.Reader.Class
14+import Control.Monad.Reader
16import Control.Monad.Trans.Except
15import Control.Monad.Trans.Except
17import qualified Data.Map.Lazy as M
16import qualified Data.Map.Lazy as M
18import Data.Maybe (fromJust, mapMaybe)
17import Data.Maybe (fromJust, mapMaybe)
18+import Data.Monoid ((<>))
19import qualified Data.Set as S
19import qualified Data.Set as S
20import qualified Language.PureScript as P
20import qualified Language.PureScript as P
21import Language.PureScript.Errors.JSON
21import Language.PureScript.Errors.JSON
22+import Language.PureScript.Ide.Error
23+import Language.PureScript.Ide.State
24+import Language.PureScript.Ide.Types
25+import Language.PureScript.Ide.Util
22−import System.IO.UTF8 (readUTF8File)
27+import System.IO.UTF8 (readUTF8File)
29+-- | Given a filepath performs the following steps:
31+-- * Reads and parses a PureScript module from the filepath.
33+-- * Builds a dependency graph for the parsed module from the already loaded
36+-- * Attempts to find an FFI definition file for the module by looking
37+-- for a file with the same filepath except for a .js extension.
39+-- * Passes all the created artifacts to @rebuildModule@.
41+-- * If the rebuilding succeeds, returns a @RebuildSuccess@ with the generated
42+-- warnings, and if rebuilding fails, returns a @RebuildError@ with the
24rebuildFile
44rebuildFile
25 :: (PscIde m, MonadLogger m, MonadError PscIdeError m)
45 :: (PscIde m, MonadLogger m, MonadError PscIdeError m)
26 => FilePath
46 => FilePath
27 -> m Success
47 -> m Success
28rebuildFile path = do
48rebuildFile path = do
30− input <- liftIO $ readUTF8File path
50+ input <- liftIO (readUTF8File path)
32− m <- case map snd <$> P.parseModulesFromFiles id [(path, input)] of
52+ m <- case snd <$> P.parseModuleFromFile id (path, input) of
33− Left parseError ->
53+ Left parseError -> throwError
34− throwError . RebuildError . toJSONErrors False P.Error $ parseError
55+ . toJSONErrors False P.Error
56+ $ P.MultipleErrors [P.toPositionedError parseError]
35− Right [m] -> pure m
57+ Right m -> pure m
36− Right _ -> throwError . GeneralError $ "Please define exactly one module."
38 -- Externs files must be sorted ahead of time, so that they get applied
59 -- Externs files must be sorted ahead of time, so that they get applied
39 -- correctly to the 'Environment'.
60 -- correctly to the 'Environment'.
40− externs <- sortExterns m . M.delete (P.getModuleName m) =<< getExternFiles
61+ externs <- sortExterns m =<< getExternFiles
42 outputDirectory <- confOutputPath . envConfiguration <$> ask
63 outputDirectory <- confOutputPath . envConfiguration <$> ask
@@ -46,26 +67,85 @@ rebuildFile path = do
46 let filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)
67 let filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)
47 foreigns <- P.inferForeignModules (M.singleton (P.getModuleName m) (Right path))
68 foreigns <- P.inferForeignModules (M.singleton (P.getModuleName m) (Right path))
49− -- Silence progress update messages during the build
50− let actions = (P.buildMakeActions outputDirectory filePathMap foreigns False)
70+ let makeEnv = MakeActionsEnv outputDirectory filePathMap foreigns False
51− { P.progress = const (pure ()) }
53 -- Rebuild the single module using the cached externs
71 -- Rebuild the single module using the cached externs
54 (result, warnings) <- liftIO
72 (result, warnings) <- liftIO
55− . P.runMake P.defaultOptions
73+ . P.runMake P.defaultOptions
56− . P.rebuildModule actions externs
74+ . P.rebuildModule (buildMakeActions
57− $ m
75+ >>= shushProgress $ makeEnv) externs $ m
58 case result of
76 case result of
59− Left errors -> throwError . RebuildError $ toJSONErrors False P.Error errors
77+ Left errors -> throwError (RebuildError (toJSONErrors False P.Error errors))
79+ rebuildModuleOpen makeEnv externs m
60− Right _ -> pure . RebuildSuccess $ toJSONErrors False P.Warning warnings
80+ pure (RebuildSuccess (toJSONErrors False P.Warning warnings))
82+-- | Rebuilds a module but opens up its export list first and stores the result
83+-- inside the rebuild cache
85+ :: (PscIde m, MonadLogger m, MonadError PscIdeError m)
90+rebuildModuleOpen makeEnv externs m = do
91+ (openResult, _) <- liftIO
92+ . P.runMake P.defaultOptions
93+ . P.rebuildModule (buildMakeActions
96+ $ makeEnv) externs $ openModuleExports m
99+ throwError (GeneralError "Failed when rebuilding with open exports")
102+ ("Setting Rebuild cache: " <> runModuleNameT (P.efModuleName result))
103+ setCachedRebuild result
105+-- | Parameters we can access while building our @MakeActions@
106+data MakeActionsEnv =
108+ { maeOutputDirectory :: FilePath
109+ , maeFilePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
110+ , maeForeignPathMap :: M.Map P.ModuleName FilePath
111+ , maePrefixComment :: Bool
114+-- | Builds the default @MakeActions@ from a @MakeActionsEnv@
115+buildMakeActions :: MakeActionsEnv -> P.MakeActions P.Make
116+buildMakeActions MakeActionsEnv{..} =
123+-- | Shuts the compiler up about progress messages
124+shushProgress :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make
126+ ma { P.progress = \_ -> pure () }
128+-- | Stops any kind of codegen (also silences errors about missing or unused FFI
130+shushCodegen :: P.MakeActions P.Make -> MakeActionsEnv -> P.MakeActions P.Make
131+shushCodegen ma MakeActionsEnv{..} =
132+ ma { P.codegen = \_ _ _ -> pure () }
134+-- | Returns a topologically sorted list of dependent ExternsFiles for the given
135+-- module. Throws an error if there is a cyclic dependency within the
62sortExterns
137sortExterns
63 :: (PscIde m, MonadError PscIdeError m)
138 :: (PscIde m, MonadError PscIdeError m)
64 => P.Module
139 => P.Module
65 -> M.Map P.ModuleName P.ExternsFile
140 -> M.Map P.ModuleName P.ExternsFile
66 -> m [P.ExternsFile]
141 -> m [P.ExternsFile]
67sortExterns m ex = do
142sortExterns m ex = do
143+ sorted' <- runExceptT
68− sorted' <- runExceptT . P.sortModules . (:) m . map mkShallowModule . M.elems $ ex
146+ . map mkShallowModule
148+ . M.delete (P.getModuleName m) $ ex
69 case sorted' of
149 case sorted' of
70 Left _ -> throwError (GeneralError "There was a cycle in the dependencies")
150 Left _ -> throwError (GeneralError "There was a cycle in the dependencies")
71 Right (sorted, graph) -> do
151 Right (sorted, graph) -> do
@@ -80,3 +160,7 @@ sortExterns m ex = do
80 -- Sort a list so its elements appear in the same order as in another list.
160 -- Sort a list so its elements appear in the same order as in another list.
81 inOrderOf :: (Ord a) => [a] -> [a] -> [a]
161 inOrderOf :: (Ord a) => [a] -> [a] -> [a]
82 inOrderOf xs ys = let s = S.fromList xs in filter (`S.member` s) ys
162 inOrderOf xs ys = let s = S.fromList xs in filter (`S.member` s) ys
164+-- | Removes a modules export list.
165+openModuleExports :: P.Module -> P.Module
166+openModuleExports (P.Module ss cs mn decls _) = P.Module ss cs mn decls Nothing