Skip to content

Commit 7cb2c29

Browse files
kritzcreekkritzcreek
committed
[psc-ide] log version mismatches when reading externs files
1 parent a9c525c commit 7cb2c29

File tree

6 files changed

+37
-19
lines changed

6 files changed

+37
-19
lines changed

‎psc-ide-server/Main.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@ data Options = Options
7474

7575
main :: IO ()
7676
main = do
77-
opts'@(Options dir globs outputPath port noWatch debug logLevel) <- Opts.execParser opts
77+
opts'@(Options dir globs outputPath port noWatch polling debug logLevel) <- Opts.execParser opts
7878
when debug (putText "Parsed Options:" *> print opts')
7979
maybe (pure ()) setCurrentDirectory dir
8080
ideState <- newTVarIO emptyIdeState
@@ -106,14 +106,15 @@ main = do
106106
<*> Opts.switch (Opts.long "debug")
107107
<*> (parseLogLevel <$> Opts.strOption
108108
(Opts.long "log-level"
109-
<> Opts.value ""
110-
<> Opts.help "One of \"debug\", \"perf\" or \"all\""))
109+
`mappend` Opts.value ""
110+
`mappend` Opts.help "One of \"debug\", \"perf\", \"all\" or \"none\""))
111111
opts = Opts.info (version <*> Opts.helper <*> parser) mempty
112112
parseLogLevel s = case s of
113113
"debug" -> LogDebug
114114
"perf" -> LogPerf
115115
"all" -> LogAll
116-
_ -> LogNone
116+
"none" -> LogNone
117+
_ -> LogDefault
117118
version = Opts.abortOption
118119
(InfoMsg (showVersion Paths.version))
119120
(Opts.long "version" `mappend` Opts.help "Show the version number")

‎psc-ide-server/README.md‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,9 +22,11 @@ It supports the following options:
2222
- `--output-directory`: Specify where to look for compiled output inside your
2323
project directory. Defaults to `output/`, relative to either the current
2424
directory or the directory specified by `-d`.
25-
- `--debug`: Enables some logging meant for debugging
25+
<<<<<<< HEAD
2626
- `--polling`: Uses polling instead of file system events to watch the externs
2727
files. This flag is reversed on Windows and polling is the default.
28+
- `--debug`: DEPRECATED: use --log-level="debug"
29+
- `--log-level`: Can be set to one of "all", "none", "debug" and "perf"
2830
- `--no-watch`: Disables the filewatcher
2931
- `--version`: Output psc-ide version
3032

‎src/Language/PureScript/Ide/Externs.hs‎

Lines changed: 23 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,8 @@
1212
-- Handles externs files for psc-ide
1313
-----------------------------------------------------------------------------
1414

15-
{-# LANGUAGE OverloadedStrings #-}
16-
{-# LANGUAGE RecordWildCards #-}
15+
{-# LANGUAGE RecordWildCards #-}
16+
{-# LANGUAGE PackageImports #-}
1717

1818
module Language.PureScript.Ide.Externs
1919
( readExternFile
@@ -23,24 +23,38 @@ module Language.PureScript.Ide.Externs
2323

2424
import Protolude
2525

26-
import Control.Lens ((^.))
27-
import Data.Aeson (decodeStrict)
28-
import qualified Data.ByteString as BS
29-
import qualified Data.Map as Map
26+
import Control.Lens ((^.))
27+
import "monad-logger" Control.Monad.Logger
28+
import Data.Aeson (decodeStrict)
29+
import qualified Data.ByteString as BS
30+
import qualified Data.Map as Map
31+
import Data.Version (showVersion)
3032
import Language.PureScript.Ide.Error (PscIdeError (..))
3133
import Language.PureScript.Ide.Types
3234
import Language.PureScript.Ide.Util
3335

34-
import qualified Language.PureScript as P
36+
import qualified Language.PureScript as P
3537

36-
readExternFile :: (MonadIO m, MonadError PscIdeError m) =>
38+
readExternFile :: (MonadIO m, MonadError PscIdeError m, MonadLogger m) =>
3739
FilePath -> m P.ExternsFile
3840
readExternFile fp = do
3941
parseResult <- liftIO (decodeStrict <$> BS.readFile fp)
4042
case parseResult of
41-
Nothing -> throwError . GeneralError $ "Parsing the extern at: " <> toS fp <> " failed"
43+
Nothing ->
44+
throwError (GeneralError
45+
("Parsing the extern at: " <> toS fp <> " failed"))
46+
Just externs
47+
| P.efVersion externs /= version -> do
48+
let errMsg = "Version mismatch for the externs at: " <> toS fp
49+
<> " Expected: " <> version
50+
<> " Found: " <> P.efVersion externs
51+
logErrorN errMsg
52+
throwError (GeneralError errMsg)
4253
Just externs -> pure externs
4354

55+
where
56+
version = toS (showVersion P.version)
57+
4458
convertExterns :: P.ExternsFile -> (Module, [(P.ModuleName, P.DeclarationRef)])
4559
convertExterns ef =
4660
((P.efModuleName ef, decls), exportDecls)

‎src/Language/PureScript/Ide/Logging.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ runLogger logLevel' =
1919
runStdoutLoggingT . filterLogger (\_ logLevel ->
2020
case logLevel' of
2121
LogAll -> True
22+
LogDefault -> not (logLevel == LevelOther "perf" || logLevel == LevelDebug)
2223
LogNone -> False
2324
LogDebug -> not (logLevel == LevelOther "perf")
2425
LogPerf -> logLevel == LevelOther "perf")

‎src/Language/PureScript/Ide/Types.hs‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -12,9 +12,8 @@
1212
-- Type definitions for psc-ide
1313
-----------------------------------------------------------------------------
1414

15-
{-# LANGUAGE DeriveFoldable #-}
16-
{-# LANGUAGE OverloadedStrings #-}
17-
{-# LANGUAGE TemplateHaskell #-}
15+
{-# LANGUAGE DeriveFoldable #-}
16+
{-# LANGUAGE TemplateHaskell #-}
1817

1918
module Language.PureScript.Ide.Types where
2019

@@ -111,7 +110,7 @@ newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotation
111110
-- annotations found in a module
112111
deriving (Show, Eq, Ord, Functor, Foldable)
113112

114-
data IdeLogLevel = LogDebug | LogPerf | LogAll | LogNone
113+
data IdeLogLevel = LogDebug | LogPerf | LogAll | LogDefault | LogNone
115114
deriving (Show, Eq)
116115

117116
data Configuration =

‎src/Language/PureScript/Ide/Watcher.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ import Control.Concurrent.STM
2222
import Language.PureScript.Ide.Externs
2323
import Language.PureScript.Ide.State
2424
import Language.PureScript.Ide.Types
25+
import Language.PureScript.Ide.Util
2526
import System.FilePath
2627
import System.FSNotify
2728

@@ -31,7 +32,7 @@ reloadFile :: TVar IdeState -> Event -> IO ()
3132
reloadFile _ Removed{} = pure ()
3233
reloadFile ref ev = do
3334
let fp = eventPath ev
34-
ef' <- runExceptT (readExternFile fp)
35+
ef' <- runLogger LogDefault (runExceptT (readExternFile fp))
3536
case ef' of
3637
Left _ -> pure ()
3738
Right ef -> do

0 commit comments

Comments
 (0)