Ghcide benchmark

Benchmark.hs

-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE PatternSynonyms #-}

module Benchmark(main) where

import Control.Applicative.Combinators
import Control.Monad
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Capabilities
import Control.Monad.IO.Class
import System.Time.Extra
import Data.Maybe

main :: IO ()
main = do
  print "starting test"
  let dir = "C:/Neil/shake"
  let cmd = unwords ["C:/Neil/ghcide/obj/ghcide", "--lsp", "--test", "--cwd", dir, "+RTS", "-N4"]
  let lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities $ Just True }
    -- If you uncomment this you can see all logging
      -- which can be quite useful for debugging.
      -- { logStdErr = True, logColor = False }
      -- If you really want to, you can also see all messages
      -- { logMessages = True, logColor = False }
      conf = defaultConfig -- { logStdErr = True, logMessages = True}
  runSessionWithConfig conf cmd lspTestCaps dir $ do
      doc <- openDoc "src/Test.hs" "haskell"
      void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
      liftIO $ putStrLn "Running getHover tests"
      (t, _) <- duration2 $ replicateM_ 100 $ do
        (t, res) <- duration2 $ getHover doc $ Position 127 43
        when (isNothing res) $ fail "DIDN'T WORK"
        liftIO $ putStrLn $ showDuration t
      liftIO $ putStrLn $ "TOTAL = " ++ showDuration t
      void $ getCodeLenses doc


duration2 :: MonadIO m => m a -> m (Seconds, a)
duration2 x = do
  start <- liftIO offsetTime
  res <- x
  end <- liftIO start
  return (end, res)

test.bat

mkdir obj
REM  -prof -fprof-auto -fprof-cafs
ghc -o obj/ghcide -O2 -outputdir obj -XBangPatterns -XDeriveFunctor -XDeriveGeneric -XGeneralizedNewtypeDeriving -XLambdaCase -XNamedFieldPuns -XOverloadedStrings -XRecordWildCards -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XViewPatterns -package=ghc -ignore-package=ghc-lib-parser -DGHC_STABLE -Iinclude -idist/build/autogen -isrc -iexe -iC:/Neil/shake/src -iC:/Neil/shake/dist/build/autogen Main -threaded
ghc -o obj/benchmark -outputdir obj -main-is Benchmark Benchmark