git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
[psc-ide] log handleCommand duration
commit9ded0a340af796ae1ec19e4b393209459b8ce467 authorChristoph Hegemann <christoph.hegemann1337@gmail.com> dateFri 2 Dec 2016, 22:11 (10 years ago) parent5f0dd05
5 files changed+35−9
compare with golang
unifiedsplit
psc-ide-server/Main.hs+5−2 purescript.cabal+1 src/Language/PureScript/Ide/Command.hs+15 src/Language/PureScript/Ide/State.hs+4−5 src/Language/PureScript/Ide/Util.hs+10−2
psc-ide-server/Main.hs+5−2
@@ -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
@@ -40,12 +41,12 @@ import Network.Socket hiding (PortNumber, Type,
4041 sClose)
4142import Options.Applicative (ParseError (..))
4243import qualified Options.Applicative as Opts
44+import System.Clock
4345import System.Directory
4446import System.Info as SysInfo
4547import System.FilePath
4648import System.IO hiding (putStrLn, print)
4749import System.IO.Error (isEOFError)
48−
4950import qualified Paths_purescript as Paths
5051
5152listenOnLocalhost :: PortNumber -> IO Socket
@@ -127,7 +128,10 @@ startServer port env = withSocketsDo $ do
127128 Right (cmd, h) -> do
128129 case decodeT cmd of
129130 Just cmd' -> do
131+ start <- liftIO (getTime Monotonic)
130132 result <- runExceptT (handleCommand cmd')
133+ end <- liftIO (getTime Monotonic)
134+ $(logDebug) ("Command " <> commandName cmd' <> " took " <> (displayTimeSpec (diffTimeSpec start end)))
131135 -- $(logDebug) ("Answer was: " <> T.pack (show result))
132136 liftIO (hFlush stdout)
133137 case result of
@@ -140,7 +144,6 @@ startServer port env = withSocketsDo $ do
140144 hFlush stdout
141145 liftIO (hClose h)
142146
143−
144147acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)
145148 => Socket -> m (Text, Handle)
146149acceptCommand sock = do
purescript.cabal+1
@@ -473,6 +473,7 @@ executable psc-ide-server
473473 build-depends: base >=4 && <5,
474474 aeson >= 0.8 && < 1.0,
475475 bytestring -any,
476+ clock -any,
476477 purescript -any,
477478 base-compat >=0.6.0,
478479 directory -any,
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/State.hs+4−5
@@ -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
@@ -183,8 +182,8 @@ populateStage2 = do
183182 start <- getTime Monotonic
184183 atomically (populateStage2STM st)
185184 end <- getTime Monotonic
186− pure (Prelude.show (diffTimeSpec start end))
187− $(logDebug) $ "Finished populating Stage2 in " <> toS duration
185+ pure (diffTimeSpec start end)
186+ $(logDebug) $ "Finished populating Stage2 in " <> displayTimeSpec duration
188187
189188-- | STM version of populateStage2
190189populateStage2STM :: TVar IdeState -> STM ()
@@ -201,11 +200,11 @@ populateStage3 = do
201200 start <- getTime Monotonic
202201 results <- atomically (populateStage3STM st)
203202 end <- getTime Monotonic
204− pure (Prelude.show (diffTimeSpec start end), results)
203+ pure (diffTimeSpec start end, results)
205204 traverse_
206205 (logWarnN . prettyPrintReexportResult (runModuleNameT . fst))
207206 (filter reexportHasFailures results)
208− $(logDebug) $ "Finished populating Stage3 in " <> toS duration
207+ $(logDebug) $ "Finished populating Stage3 in " <> displayTimeSpec duration
209208
210209-- | STM version of populateStage3
211210populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]
src/Language/PureScript/Ide/Util.hs+10−2
@@ -26,9 +26,13 @@ module Language.PureScript.Ide.Util
2626 , withEmptyAnn
2727 , valueOperatorAliasT
2828 , typeOperatorAliasT
29+ , displayTimeSpec
2930 , module Language.PureScript.Ide.Conversions
3031 ) where
3132
33+import Protolude hiding (decodeUtf8,
34+ encodeUtf8)
35+
3236import Control.Lens ((^.))
3337import Data.Aeson
3438import qualified Data.Text as T
@@ -36,8 +40,8 @@ import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
3640import qualified Language.PureScript as P
3741import Language.PureScript.Ide.Conversions
3842import Language.PureScript.Ide.Types
39−import Protolude hiding (decodeUtf8,
40− encodeUtf8)
43+import System.Clock
44+import Text.Printf
4145
4246identifierFromIdeDeclaration :: IdeDeclaration -> Text
4347identifierFromIdeDeclaration d = case d of
@@ -111,3 +115,7 @@ unwrapPositioned x = x
111115unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef
112116unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = unwrapPositionedRef x
113117unwrapPositionedRef x = x
118+
119+displayTimeSpec :: TimeSpec -> Text
120+displayTimeSpec ts =
121+ T.pack (printf "%0.2f" (fromIntegral (toNanoSecs ts) / 1000000 :: Double)) <> "ms"