git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
[psc-ide] more finegrained logging
commita9c525c7f78351775283f14d4b2d91cfac740100 authorChristoph Hegemann <christoph.hegemann1337@gmail.com> dateMon 5 Dec 2016, 23:40 (10 years ago) parent9ded0a3
9 files changed+71−41
compare with golang
unifiedsplit
psc-ide-server/Main.hs+19−11 purescript.cabal+2−2 src/Language/PureScript/Ide.hs+2−4 src/Language/PureScript/Ide/Externs.hs+1−2 src/Language/PureScript/Ide/Logging.hs+36 src/Language/PureScript/Ide/SourceFile.hs+1−1 src/Language/PureScript/Ide/State.hs+4−13 src/Language/PureScript/Ide/Types.hs+4−1 src/Language/PureScript/Ide/Util.hs+2−7
psc-ide-server/Main.hs+19−11
@@ -41,7 +41,6 @@ import Network.Socket hiding (PortNumber, Type,
4141 sClose)
4242import Options.Applicative (ParseError (..))
4343import qualified Options.Applicative as Opts
44−import System.Clock
4544import System.Directory
4645import System.Info as SysInfo
4746import System.FilePath
@@ -70,11 +69,12 @@ data Options = Options
7069 , optionsNoWatch :: Bool
7170 , optionsPolling :: Bool
7271 , optionsDebug :: Bool
72+ , optionsLoglevel :: IdeLogLevel
7373 } deriving (Show)
7474
7575main :: IO ()
7676main = do
77− opts'@(Options dir globs outputPath port noWatch polling debug) <- Opts.execParser opts
77+ opts'@(Options dir globs outputPath port noWatch debug logLevel) <- Opts.execParser opts
7878 when debug (putText "Parsed Options:" *> print opts')
7979 maybe (pure ()) setCurrentDirectory dir
8080 ideState <- newTVarIO emptyIdeState
@@ -89,8 +89,8 @@ main = do
8989
9090 unless noWatch $
9191 void (forkFinally (watcher polling ideState fullOutputPath) print)
92−
93− 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}
9494 env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}
9595 startServer port env
9696 where
@@ -104,7 +104,16 @@ main = do
104104 <*> Opts.switch (Opts.long "no-watch")
105105 <*> flipIfWindows (Opts.switch (Opts.long "polling"))
106106 <*> Opts.switch (Opts.long "debug")
107+ <*> (parseLogLevel <$> Opts.strOption
108+ (Opts.long "log-level"
109+ <> Opts.value ""
110+ <> Opts.help "One of \"debug\", \"perf\" or \"all\""))
107111 opts = Opts.info (version <*> Opts.helper <*> parser) mempty
112+ parseLogLevel s = case s of
113+ "debug" -> LogDebug
114+ "perf" -> LogPerf
115+ "all" -> LogAll
116+ _ -> LogNone
108117 version = Opts.abortOption
109118 (InfoMsg (showVersion Paths.version))
110119 (Opts.long "version" `mappend` Opts.help "Show the version number")
@@ -116,10 +125,8 @@ main = do
116125startServer :: PortNumber -> IdeEnvironment -> IO ()
117126startServer port env = withSocketsDo $ do
118127 sock <- listenOnLocalhost port
119− runLogger (runReaderT (forever (loop sock)) env)
128+ runLogger (confLogLevel (ideConfiguration env)) (runReaderT (forever (loop sock)) env)
120129 where
121− runLogger = runStdoutLoggingT . filterLogger (\_ _ -> confDebug (ideConfiguration env))
122−
123130 loop :: (Ide m, MonadLogger m) => Socket -> m ()
124131 loop sock = do
125132 accepted <- runExceptT $ acceptCommand sock
@@ -128,10 +135,11 @@ startServer port env = withSocketsDo $ do
128135 Right (cmd, h) -> do
129136 case decodeT cmd of
130137 Just cmd' -> do
131− start <- liftIO (getTime Monotonic)
132− result <- runExceptT (handleCommand cmd')
133− end <- liftIO (getTime Monotonic)
134− $(logDebug) ("Command " <> commandName cmd' <> " took " <> (displayTimeSpec (diffTimeSpec start end)))
138+ let message duration =
139+ "Command " <> commandName cmd'
140+ <> " took "
141+ <> displayTimeSpec duration
142+ result <- logPerf message (runExceptT (handleCommand cmd'))
135143 -- $(logDebug) ("Answer was: " <> T.pack (show result))
136144 liftIO (hFlush stdout)
137145 case result of
purescript.cabal+2−2
@@ -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
@@ -473,7 +474,6 @@ executable psc-ide-server
473474 build-depends: base >=4 && <5,
474475 aeson >= 0.8 && < 1.0,
475476 bytestring -any,
476− clock -any,
477477 purescript -any,
478478 base-compat >=0.6.0,
479479 directory -any,
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/Externs.hs+1−2
@@ -26,7 +26,6 @@ import Protolude
2626import Control.Lens ((^.))
2727import Data.Aeson (decodeStrict)
2828import qualified Data.ByteString as BS
29−import Data.List (nub)
3029import qualified Data.Map as Map
3130import Language.PureScript.Ide.Error (PscIdeError (..))
3231import Language.PureScript.Ide.Types
@@ -55,7 +54,7 @@ convertExterns ef =
5554 declarations = mapMaybe convertDecl (P.efDeclarations ef)
5655
5756 typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration declarations)
58− cleanDeclarations = nub $ appEndo typeClassFilter declarations
57+ cleanDeclarations = ordNub (appEndo typeClassFilter declarations)
5958
6059removeTypeDeclarationsForClass :: IdeDeclaration -> Endo [IdeDeclaration]
6160removeTypeDeclarationsForClass (IdeDeclTypeClass n) = Endo (filter notDuplicate)
src/Language/PureScript/Ide/Logging.hsnew file+36
@@ -0,0 +1,36 @@
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+ LogNone -> False
23+ LogDebug -> not (logLevel == LevelOther "perf")
24+ LogPerf -> logLevel == LevelOther "perf")
25+
26+logPerf :: (MonadIO m, MonadLogger m) => (TimeSpec -> Text) -> m t -> m t
27+logPerf format f = do
28+ start <- liftIO (getTime Monotonic)
29+ result <- f
30+ end <- liftIO (getTime Monotonic)
31+ logOtherN (LevelOther "perf") (format (diffTimeSpec start end))
32+ pure result
33+
34+displayTimeSpec :: TimeSpec -> Text
35+displayTimeSpec ts =
36+ 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−13
@@ -45,7 +45,6 @@ import Language.PureScript.Ide.Reexports
4545import Language.PureScript.Ide.SourceFile
4646import Language.PureScript.Ide.Types
4747import Language.PureScript.Ide.Util
48−import System.Clock
4948
5049-- | Resets all State inside psc-ide
5150resetIdeState :: Ide m => m ()
@@ -178,12 +177,8 @@ cachedRebuild = s3CachedRebuild <$> getStage3
178177populateStage2 :: (Ide m, MonadLogger m) => m ()
179178populateStage2 = do
180179 st <- ideStateVar <$> ask
181− duration <- liftIO $ do
182− start <- getTime Monotonic
183− atomically (populateStage2STM st)
184− end <- getTime Monotonic
185− pure (diffTimeSpec start end)
186− $(logDebug) $ "Finished populating Stage2 in " <> displayTimeSpec duration
180+ let message duration = "Finished populating Stage2 in " <> displayTimeSpec duration
181+ logPerf message (liftIO (atomically (populateStage2STM st)))
187182
188183-- | STM version of populateStage2
189184populateStage2STM :: TVar IdeState -> STM ()
@@ -196,15 +191,11 @@ populateStage2STM ref = do
196191populateStage3 :: (Ide m, MonadLogger m) => m ()
197192populateStage3 = do
198193 st <- ideStateVar <$> ask
199− (duration, results) <- liftIO $ do
200− start <- getTime Monotonic
201− results <- atomically (populateStage3STM st)
202− end <- getTime Monotonic
203− pure (diffTimeSpec start end, results)
194+ let message duration = "Finished populating Stage3 in " <> displayTimeSpec duration
195+ results <- logPerf message (liftIO (atomically (populateStage3STM st)))
204196 traverse_
205197 (logWarnN . prettyPrintReexportResult (runModuleNameT . fst))
206198 (filter reexportHasFailures results)
207− $(logDebug) $ "Finished populating Stage3 in " <> displayTimeSpec duration
208199
209200-- | STM version of populateStage3
210201populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]
src/Language/PureScript/Ide/Types.hs+4−1
@@ -111,10 +111,13 @@ newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotation
111111 -- annotations found in a module
112112 deriving (Show, Eq, Ord, Functor, Foldable)
113113
114+data IdeLogLevel = LogDebug | LogPerf | LogAll | LogNone
115+ deriving (Show, Eq)
116+
114117data Configuration =
115118 Configuration
116119 { confOutputPath :: FilePath
117− , confDebug :: Bool
120+ , confLogLevel :: IdeLogLevel
118121 , confGlobs :: [FilePath]
119122 }
120123
src/Language/PureScript/Ide/Util.hs+2−7
@@ -26,8 +26,8 @@ module Language.PureScript.Ide.Util
2626 , withEmptyAnn
2727 , valueOperatorAliasT
2828 , typeOperatorAliasT
29− , displayTimeSpec
3029 , module Language.PureScript.Ide.Conversions
30+ , module Language.PureScript.Ide.Logging
3131 ) where
3232
3333import Protolude hiding (decodeUtf8,
@@ -39,9 +39,8 @@ import qualified Data.Text as T
3939import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
4040import qualified Language.PureScript as P
4141import Language.PureScript.Ide.Conversions
42+import Language.PureScript.Ide.Logging
4243import Language.PureScript.Ide.Types
43−import System.Clock
44−import Text.Printf
4544
4645identifierFromIdeDeclaration :: IdeDeclaration -> Text
4746identifierFromIdeDeclaration d = case d of
@@ -115,7 +114,3 @@ unwrapPositioned x = x
115114unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef
116115unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = unwrapPositionedRef x
117116unwrapPositionedRef x = x
118−
119−displayTimeSpec :: TimeSpec -> Text
120−displayTimeSpec ts =
121− T.pack (printf "%0.2f" (fromIntegral (toNanoSecs ts) / 1000000 :: Double)) <> "ms"