git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
[psc-ide] log handleCommand duration
9ded0a3Christoph Hegemann
psc-ide-server/Main.hs+5−2
compare with golang
unifiedsplit
@@ -30,6 +30,7 @@ import qualified Data.Text.IO as T
30import qualified Data.ByteString.Lazy.Char8 as BS8
30import qualified Data.ByteString.Lazy.Char8 as BS8
31import Data.Version (showVersion)
31import Data.Version (showVersion)
32import Language.PureScript.Ide
32import Language.PureScript.Ide
33+import Language.PureScript.Ide.Command
33import Language.PureScript.Ide.Util
34import Language.PureScript.Ide.Util
34import Language.PureScript.Ide.Error
35import Language.PureScript.Ide.Error
35import Language.PureScript.Ide.Types
36import Language.PureScript.Ide.Types
@@ -40,12 +41,12 @@ import Network.Socket hiding (PortNumber, Type,
40 sClose)
41 sClose)
41import Options.Applicative (ParseError (..))
42import Options.Applicative (ParseError (..))
42import qualified Options.Applicative as Opts
43import qualified Options.Applicative as Opts
44+import System.Clock
43import System.Directory
45import System.Directory
44import System.Info as SysInfo
46import System.Info as SysInfo
45import System.FilePath
47import System.FilePath
46import System.IO hiding (putStrLn, print)
48import System.IO hiding (putStrLn, print)
47import System.IO.Error (isEOFError)
49import System.IO.Error (isEOFError)
48−
49import qualified Paths_purescript as Paths
50import qualified Paths_purescript as Paths
50
51
51listenOnLocalhost :: PortNumber -> IO Socket
52listenOnLocalhost :: PortNumber -> IO Socket
@@ -127,7 +128,10 @@ startServer port env = withSocketsDo $ do
127 Right (cmd, h) -> do
128 Right (cmd, h) -> do
128 case decodeT cmd of
129 case decodeT cmd of
129 Just cmd' -> do
130 Just cmd' -> do
131+ start <- liftIO (getTime Monotonic)
130 result <- runExceptT (handleCommand cmd')
132 result <- runExceptT (handleCommand cmd')
133+ end <- liftIO (getTime Monotonic)
134+ $(logDebug) ("Command " <> commandName cmd' <> " took " <> (displayTimeSpec (diffTimeSpec start end)))
131 -- $(logDebug) ("Answer was: " <> T.pack (show result))
135 -- $(logDebug) ("Answer was: " <> T.pack (show result))
132 liftIO (hFlush stdout)
136 liftIO (hFlush stdout)
133 case result of
137 case result of
@@ -140,7 +144,6 @@ startServer port env = withSocketsDo $ do
140 hFlush stdout
144 hFlush stdout
141 liftIO (hClose h)
145 liftIO (hClose h)
142
146
143−
144acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)
147acceptCommand :: (MonadIO m, MonadLogger m, MonadError Text m)
145 => Socket -> m (Text, Handle)
148 => Socket -> m (Text, Handle)
146acceptCommand sock = do
149acceptCommand sock = do
purescript.cabal+1
@@ -473,6 +473,7 @@ executable psc-ide-server
473 build-depends: base >=4 && <5,
473 build-depends: base >=4 && <5,
474 aeson >= 0.8 && < 1.0,
474 aeson >= 0.8 && < 1.0,
475 bytestring -any,
475 bytestring -any,
476+ clock -any,
476 purescript -any,
477 purescript -any,
477 base-compat >=0.6.0,
478 base-compat >=0.6.0,
478 directory -any,
479 directory -any,
src/Language/PureScript/Ide/Command.hs+15
@@ -61,6 +61,21 @@ data Command
61 | Reset
61 | Reset
62 | Quit
62 | Quit
63
63
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+
64data ImportCommand
79data ImportCommand
65 = AddImplicitImport P.ModuleName
80 = AddImplicitImport P.ModuleName
66 | AddImportForIdentifier Text
81 | AddImportForIdentifier Text
src/Language/PureScript/Ide/State.hs+4−5
@@ -32,7 +32,6 @@ module Language.PureScript.Ide.State
32 , resolveOperatorsForModule
32 , resolveOperatorsForModule
33 ) where
33 ) where
34
34
35−import qualified Prelude
36import Protolude
35import Protolude
37
36
38import Control.Concurrent.STM
37import Control.Concurrent.STM
@@ -183,8 +182,8 @@ populateStage2 = do
183 start <- getTime Monotonic
182 start <- getTime Monotonic
184 atomically (populateStage2STM st)
183 atomically (populateStage2STM st)
185 end <- getTime Monotonic
184 end <- getTime Monotonic
186− pure (Prelude.show (diffTimeSpec start end))
185+ pure (diffTimeSpec start end)
187− $(logDebug) $ "Finished populating Stage2 in " <> toS duration
186+ $(logDebug) $ "Finished populating Stage2 in " <> displayTimeSpec duration
188
187
189-- | STM version of populateStage2
188-- | STM version of populateStage2
190populateStage2STM :: TVar IdeState -> STM ()
189populateStage2STM :: TVar IdeState -> STM ()
@@ -201,11 +200,11 @@ populateStage3 = do
201 start <- getTime Monotonic
200 start <- getTime Monotonic
202 results <- atomically (populateStage3STM st)
201 results <- atomically (populateStage3STM st)
203 end <- getTime Monotonic
202 end <- getTime Monotonic
204− pure (Prelude.show (diffTimeSpec start end), results)
203+ pure (diffTimeSpec start end, results)
205 traverse_
204 traverse_
206 (logWarnN . prettyPrintReexportResult (runModuleNameT . fst))
205 (logWarnN . prettyPrintReexportResult (runModuleNameT . fst))
207 (filter reexportHasFailures results)
206 (filter reexportHasFailures results)
208− $(logDebug) $ "Finished populating Stage3 in " <> toS duration
207+ $(logDebug) $ "Finished populating Stage3 in " <> displayTimeSpec duration
209
208
210-- | STM version of populateStage3
209-- | STM version of populateStage3
211populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]
210populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]
src/Language/PureScript/Ide/Util.hs+10−2
@@ -26,9 +26,13 @@ module Language.PureScript.Ide.Util
26 , withEmptyAnn
26 , withEmptyAnn
27 , valueOperatorAliasT
27 , valueOperatorAliasT
28 , typeOperatorAliasT
28 , typeOperatorAliasT
29+ , displayTimeSpec
29 , module Language.PureScript.Ide.Conversions
30 , module Language.PureScript.Ide.Conversions
30 ) where
31 ) where
31
32
33+import Protolude hiding (decodeUtf8,
34+ encodeUtf8)
35+
32import Control.Lens ((^.))
36import Control.Lens ((^.))
33import Data.Aeson
37import Data.Aeson
34import qualified Data.Text as T
38import qualified Data.Text as T
@@ -36,8 +40,8 @@ import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
36import qualified Language.PureScript as P
40import qualified Language.PureScript as P
37import Language.PureScript.Ide.Conversions
41import Language.PureScript.Ide.Conversions
38import Language.PureScript.Ide.Types
42import Language.PureScript.Ide.Types
39−import Protolude hiding (decodeUtf8,
43+import System.Clock
40− encodeUtf8)
44+import Text.Printf
41
45
42identifierFromIdeDeclaration :: IdeDeclaration -> Text
46identifierFromIdeDeclaration :: IdeDeclaration -> Text
43identifierFromIdeDeclaration d = case d of
47identifierFromIdeDeclaration d = case d of
@@ -111,3 +115,7 @@ unwrapPositioned x = x
111unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef
115unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef
112unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = unwrapPositionedRef x
116unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = unwrapPositionedRef x
113unwrapPositionedRef x = x
117unwrapPositionedRef x = x
118+
119+displayTimeSpec :: TimeSpec -> Text
120+displayTimeSpec ts =
121+ T.pack (printf "%0.2f" (fromIntegral (toNanoSecs ts) / 1000000 :: Double)) <> "ms"