git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #2467 from kRITZCREEK/psc-ide-diagnostics

[psc-ide] Better logging and diagnostics

commit9528dd59fcdd6f5f3dbaf5585c3edceb695f058b authorChristoph Hegemann <kRITZCREEK@users.noreply.github.com> dateWed 7 Dec 2016, 05:12 (10 years ago) parentad6fd477cb2c29
12 files changed+122−48
compare with golang
unifiedsplit
psc-ide-server/Main.hs+21−9 psc-ide-server/README.md+3−1 purescript.cabal+2−1 src/Language/PureScript/Ide.hs+2−4 src/Language/PureScript/Ide/Command.hs+15 src/Language/PureScript/Ide/Externs.hs+24−11 src/Language/PureScript/Ide/Logging.hs+37 src/Language/PureScript/Ide/SourceFile.hs+1−1 src/Language/PureScript/Ide/State.hs+4−14 src/Language/PureScript/Ide/Types.hs+6−4 src/Language/PureScript/Ide/Util.hs+5−2 src/Language/PureScript/Ide/Watcher.hs+2−1
psc-ide-server/Main.hs+21−9
@@ -30,6 +30,7 @@ import qualified Data.Text.IO as T
3030import qualified Data.ByteString.Lazy.Char8 as BS8
3131import Data.Version (showVersion)
3232import Language.PureScript.Ide
33+import Language.PureScript.Ide.Command
3334import Language.PureScript.Ide.Util
3435import Language.PureScript.Ide.Error
3536import Language.PureScript.Ide.Types
@@ -45,7 +46,6 @@ import System.Info as SysInfo
4546import System.FilePath
4647import System.IO hiding (putStrLn, print)
4748import System.IO.Error (isEOFError)
48−
4949import qualified Paths_purescript as Paths
5050
5151listenOnLocalhost :: PortNumber -> IO Socket
@@ -69,11 +69,12 @@ data Options = Options
6969 , optionsNoWatch :: Bool
7070 , optionsPolling :: Bool
7171 , optionsDebug :: Bool
72+ , optionsLoglevel :: IdeLogLevel
7273 } deriving (Show)
7374
7475main :: IO ()
7576main = do
76− opts'@(Options dir globs outputPath port noWatch polling debug) <- Opts.execParser opts
77+ opts'@(Options dir globs outputPath port noWatch polling debug logLevel) <- Opts.execParser opts
7778 when debug (putText "Parsed Options:" *> print opts')
7879 maybe (pure ()) setCurrentDirectory dir
7980 ideState <- newTVarIO emptyIdeState
@@ -88,8 +89,8 @@ main = do
8889
8990 unless noWatch $
9091 void (forkFinally (watcher polling ideState fullOutputPath) print)
91−
92− let conf = Configuration {confDebug = debug, confOutputPath = outputPath, confGlobs = globs}
92+ -- TODO: deprecate and get rid of `debug`
93+ let conf = Configuration {confLogLevel = if debug then LogDebug else logLevel, confOutputPath = outputPath, confGlobs = globs}
9394 env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}
9495 startServer port env
9596 where
@@ -103,7 +104,17 @@ main = do
103104 <*> Opts.switch (Opts.long "no-watch")
104105 <*> flipIfWindows (Opts.switch (Opts.long "polling"))
105106 <*> Opts.switch (Opts.long "debug")
107+ <*> (parseLogLevel <$> Opts.strOption
108+ (Opts.long "log-level"
109+ `mappend` Opts.value ""
110+ `mappend` Opts.help "One of \"debug\", \"perf\", \"all\" or \"none\""))
106111 opts = Opts.info (version <*> Opts.helper <*> parser) mempty
112+ parseLogLevel s = case s of
113+ "debug" -> LogDebug
114+ "perf" -> LogPerf
115+ "all" -> LogAll
116+ "none" -> LogNone
117+ _ -> LogDefault
107118 version = Opts.abortOption
108119 (InfoMsg (showVersion Paths.version))
109120 (Opts.long "version" `mappend` Opts.help "Show the version number")
@@ -115,10 +126,8 @@ main = do
115126startServer :: PortNumber -> IdeEnvironment -> IO ()
116127startServer port env = withSocketsDo $ do
117128 sock <- listenOnLocalhost port
118− runLogger (runReaderT (forever (loop sock)) env)
129+ runLogger (confLogLevel (ideConfiguration env)) (runReaderT (forever (loop sock)) env)
119130 where
120− runLogger = runStdoutLoggingT . filterLogger (\_ _ -> confDebug (ideConfiguration env))
121−
122131 loop :: (Ide m, MonadLogger m) => Socket -> m ()
123132 loop sock = do
124133 accepted <- runExceptT $ acceptCommand sock
@@ -127,7 +136,11 @@ startServer port env = withSocketsDo $ do
127136 Right (cmd, h) -> do
128137 case decodeT cmd of
129138 Just cmd' -> do
130− result <- runExceptT (handleCommand cmd')
139+ let message duration =
140+ "Command " <> commandName cmd'
141+ <> " took "
142+ <> displayTimeSpec duration
143+ result <- logPerf message (runExceptT (handleCommand cmd'))
131144 -- $(logDebug) ("Answer was: " <> T.pack (show result))
132145 liftIO (hFlush stdout)
133146 case result of
@@ -140,7 +153,6 @@ startServer port env = withSocketsDo $ do
140153 hFlush stdout
141154 liftIO (hClose h)
142155
143−
144156acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)
145157 => Socket -> m (Text, Handle)
146158acceptCommand sock = do
psc-ide-server/README.md+3−1
@@ -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
purescript.cabal+2−1
@@ -271,8 +271,9 @@ library
271271 Language.PureScript.Ide.Conversions
272272 Language.PureScript.Ide.Externs
273273 Language.PureScript.Ide.Error
274− Language.PureScript.Ide.Imports
275274 Language.PureScript.Ide.Filter
275+ Language.PureScript.Ide.Imports
276+ Language.PureScript.Ide.Logging
276277 Language.PureScript.Ide.Matcher
277278 Language.PureScript.Ide.Pursuit
278279 Language.PureScript.Ide.Rebuild
src/Language/PureScript/Ide.hs+2−4
@@ -186,11 +186,9 @@ loadModules moduleNames = do
186186 -- Finally we kick off the worker with @async@ and return the number of
187187 -- successfully parsed modules.
188188 env <- ask
189− let runLogger =
190− runStdoutLoggingT
191− . filterLogger (\_ _ -> confDebug (ideConfiguration env))
189+ let ll = confLogLevel (ideConfiguration env)
192190 -- populateStage2 and 3 return Unit for now, so it's fine to discard this
193191 -- result. We might want to block on this in a benchmarking situation.
194− _ <- liftIO (async (runLogger (runReaderT (populateStage2 *> populateStage3) env)))
192+ _ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))
195193 pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "
196194 <> show (length allModules) <> " source files."))
src/Language/PureScript/Ide/Command.hs+15
@@ -61,6 +61,21 @@ data Command
6161 | Reset
6262 | Quit
6363
64+commandName :: Command -> Text
65+commandName c = case c of
66+ Load{} -> "Load"
67+ Type{} -> "Type"
68+ Complete{} -> "Complete"
69+ Pursuit{} -> "Pursuit"
70+ CaseSplit{} -> "CaseSplit"
71+ AddClause{} -> "AddClause"
72+ Import{} -> "Import"
73+ List{} -> "List"
74+ Rebuild{} -> "Rebuild"
75+ Cwd{} -> "Cwd"
76+ Reset{} -> "Reset"
77+ Quit{} -> "Quit"
78+
6479data ImportCommand
6580 = AddImplicitImport P.ModuleName
6681 | AddImportForIdentifier Text
src/Language/PureScript/Ide/Externs.hs+24−11
@@ -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
1818module Language.PureScript.Ide.Externs
1919 ( readExternFile
@@ -23,25 +23,38 @@ module Language.PureScript.Ide.Externs
2323
2424import Protolude
2525
26−import Control.Lens ((^.))
27−import Data.Aeson (decodeStrict)
28−import qualified Data.ByteString as BS
29−import Data.List (nub)
30−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)
3132import Language.PureScript.Ide.Error (PscIdeError (..))
3233import Language.PureScript.Ide.Types
3334import Language.PureScript.Ide.Util
3435
35−import qualified Language.PureScript as P
36+import qualified Language.PureScript as P
3637
37−readExternFile :: (MonadIO m, MonadError PscIdeError m) =>
38+readExternFile :: (MonadIO m, MonadError PscIdeError m, MonadLogger m) =>
3839 FilePath -> m P.ExternsFile
3940readExternFile fp = do
4041 parseResult <- liftIO (decodeStrict <$> BS.readFile fp)
4142 case parseResult of
42− 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)
4353 Just externs -> pure externs
4454
55+ where
56+ version = toS (showVersion P.version)
57+
4558convertExterns :: P.ExternsFile -> (Module, [(P.ModuleName, P.DeclarationRef)])
4659convertExterns ef =
4760 ((P.efModuleName ef, decls), exportDecls)
@@ -55,7 +68,7 @@ convertExterns ef =
5568 declarations = mapMaybe convertDecl (P.efDeclarations ef)
5669
5770 typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration declarations)
58− cleanDeclarations = nub $ appEndo typeClassFilter declarations
71+ cleanDeclarations = ordNub (appEndo typeClassFilter declarations)
5972
6073removeTypeDeclarationsForClass :: IdeDeclaration -> Endo [IdeDeclaration]
6174removeTypeDeclarationsForClass (IdeDeclTypeClass n) = Endo (filter notDuplicate)
src/Language/PureScript/Ide/Logging.hsnew file+37
@@ -0,0 +1,37 @@
1+{-# LANGUAGE PackageImports #-}
2+
3+module Language.PureScript.Ide.Logging
4+ ( runLogger
5+ , logPerf
6+ , displayTimeSpec
7+ ) where
8+
9+import Protolude
10+
11+import "monad-logger" Control.Monad.Logger
12+import qualified Data.Text as T
13+import Language.PureScript.Ide.Types
14+import System.Clock
15+import Text.Printf
16+
17+runLogger :: MonadIO m => IdeLogLevel -> LoggingT m a -> m a
18+runLogger logLevel' =
19+ runStdoutLoggingT . filterLogger (\_ logLevel ->
20+ case logLevel' of
21+ LogAll -> True
22+ LogDefault -> not (logLevel == LevelOther "perf" || logLevel == LevelDebug)
23+ LogNone -> False
24+ LogDebug -> not (logLevel == LevelOther "perf")
25+ LogPerf -> logLevel == LevelOther "perf")
26+
27+logPerf :: (MonadIO m, MonadLogger m) => (TimeSpec -> Text) -> m t -> m t
28+logPerf format f = do
29+ start <- liftIO (getTime Monotonic)
30+ result <- f
31+ end <- liftIO (getTime Monotonic)
32+ logOtherN (LevelOther "perf") (format (diffTimeSpec start end))
33+ pure result
34+
35+displayTimeSpec :: TimeSpec -> Text
36+displayTimeSpec ts =
37+ T.pack (printf "%0.2f" (fromIntegral (toNanoSecs ts) / 1000000 :: Double)) <> "ms"
src/Language/PureScript/Ide/SourceFile.hs+1−1
@@ -116,7 +116,7 @@ extractSpans ss d = case d of
116116 _ -> []
117117 where
118118 -- We need this special case to be able to also get the position info for
119− -- typeclass member functions. Typedeclaratations would clash with value
119+ -- typeclass member functions. Typedeclarations would clash with value
120120 -- declarations for non-typeclass members, which is why we can't handle them
121121 -- in extractSpans.
122122 extractSpans' ssP dP = case dP of
src/Language/PureScript/Ide/State.hs+4−14
@@ -32,7 +32,6 @@ module Language.PureScript.Ide.State
3232 , resolveOperatorsForModule
3333 ) where
3434
35−import qualified Prelude
3635import Protolude
3736
3837import Control.Concurrent.STM
@@ -46,7 +45,6 @@ import Language.PureScript.Ide.Reexports
4645import Language.PureScript.Ide.SourceFile
4746import Language.PureScript.Ide.Types
4847import Language.PureScript.Ide.Util
49−import System.Clock
5048
5149-- | Resets all State inside psc-ide
5250resetIdeState :: Ide m => m ()
@@ -179,12 +177,8 @@ cachedRebuild = s3CachedRebuild <$> getStage3
179177populateStage2 :: (Ide m, MonadLogger m) => m ()
180178populateStage2 = do
181179 st <- ideStateVar <$> ask
182− duration <- liftIO $ do
183− start <- getTime Monotonic
184− atomically (populateStage2STM st)
185− end <- getTime Monotonic
186− pure (Prelude.show (diffTimeSpec start end))
187− $(logDebug) $ "Finished populating Stage2 in " <> toS duration
180+ let message duration = "Finished populating Stage2 in " <> displayTimeSpec duration
181+ logPerf message (liftIO (atomically (populateStage2STM st)))
188182
189183-- | STM version of populateStage2
190184populateStage2STM :: TVar IdeState -> STM ()
@@ -197,15 +191,11 @@ populateStage2STM ref = do
197191populateStage3 :: (Ide m, MonadLogger m) => m ()
198192populateStage3 = do
199193 st <- ideStateVar <$> ask
200− (duration, results) <- liftIO $ do
201− start <- getTime Monotonic
202− results <- atomically (populateStage3STM st)
203− end <- getTime Monotonic
204− pure (Prelude.show (diffTimeSpec start end), results)
194+ let message duration = "Finished populating Stage3 in " <> displayTimeSpec duration
195+ results <- logPerf message (liftIO (atomically (populateStage3STM st)))
205196 traverse_
206197 (logWarnN . prettyPrintReexportResult (runModuleNameT . fst))
207198 (filter reexportHasFailures results)
208− $(logDebug) $ "Finished populating Stage3 in " <> toS duration
209199
210200-- | STM version of populateStage3
211201populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]
src/Language/PureScript/Ide/Types.hs+6−4
@@ -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
1918module Language.PureScript.Ide.Types where
2019
@@ -111,10 +110,13 @@ newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotation
111110 -- annotations found in a module
112111 deriving (Show, Eq, Ord, Functor, Foldable)
113112
113+data IdeLogLevel = LogDebug | LogPerf | LogAll | LogDefault | LogNone
114+ deriving (Show, Eq)
115+
114116data Configuration =
115117 Configuration
116118 { confOutputPath :: FilePath
117− , confDebug :: Bool
119+ , confLogLevel :: IdeLogLevel
118120 , confGlobs :: [FilePath]
119121 }
120122
src/Language/PureScript/Ide/Util.hs+5−2
@@ -27,17 +27,20 @@ module Language.PureScript.Ide.Util
2727 , valueOperatorAliasT
2828 , typeOperatorAliasT
2929 , module Language.PureScript.Ide.Conversions
30+ , module Language.PureScript.Ide.Logging
3031 ) where
3132
33+import Protolude hiding (decodeUtf8,
34+ encodeUtf8)
35+
3236import Control.Lens ((^.))
3337import Data.Aeson
3438import qualified Data.Text as T
3539import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
3640import qualified Language.PureScript as P
3741import Language.PureScript.Ide.Conversions
42+import Language.PureScript.Ide.Logging
3843import Language.PureScript.Ide.Types
39−import Protolude hiding (decodeUtf8,
40− encodeUtf8)
4144
4245identifierFromIdeDeclaration :: IdeDeclaration -> Text
4346identifierFromIdeDeclaration d = case d of
src/Language/PureScript/Ide/Watcher.hs+2−1
@@ -22,6 +22,7 @@ import Control.Concurrent.STM
2222import Language.PureScript.Ide.Externs
2323import Language.PureScript.Ide.State
2424import Language.PureScript.Ide.Types
25+import Language.PureScript.Ide.Util
2526import System.FilePath
2627import System.FSNotify
2728
@@ -31,7 +32,7 @@ reloadFile :: TVar IdeState -> Event -> IO ()
3132reloadFile _ Removed{} = pure ()
3233reloadFile 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