Skip to content

Instantly share code, notes, and snippets.

@jneira
Created May 24, 2020 20:18
Show Gist options
  • Save jneira/3931346b8bf412a53341d884ab546f73 to your computer and use it in GitHub Desktop.
Save jneira/3931346b8bf412a53341d884ab546f73 to your computer and use it in GitHub Desktop.
haskell-lsp:Starting up server ...
2020-05-24 21:46:35.0251855 [ThreadId 4] - ---> {"jsonrpc":"2.0","id":0,"method":"initialize","params":{"processId":7000,"clientInfo":{"name":"vscode","version":"1.45.1"},"rootPath":"d:\\dev\\ws\\haskell\\hls","rootUri":"file:///d%3A/dev/ws/haskell/hls","capabilities":{"workspace":{"applyEdit":true,"workspaceEdit":{"documentChanges":true,"resourceOperations":["create","rename","delete"],"failureHandling":"textOnlyTransactional"},"didChangeConfiguration":{"dynamicRegistration":true},"didChangeWatchedFiles":{"dynamicRegistration":true},"symbol":{"dynamicRegistration":true,"symbolKind":{"valueSet":[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26]}},"executeCommand":{"dynamicRegistration":true},"configuration":true,"workspaceFolders":true},"textDocument":{"publishDiagnostics":{"relatedInformation":true,"versionSupport":false,"tagSupport":{"valueSet":[1,2]}},"synchronization":{"dynamicRegistration":true,"willSave":true,"willSaveWaitUntil":true,"didSave":true},"completion":{"dynamicRegistration":true,"contextSupport":true,"completionItem":{"snippetSupport":true,"commitCharactersSupport":true,"documentationFormat":["markdown","plaintext"],"deprecatedSupport":true,"preselectSupport":true,"tagSupport":{"valueSet":[1]}},"completionItemKind":{"valueSet":[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25]}},"hover":{"dynamicRegistration":true,"contentFormat":["markdown","plaintext"]},"signatureHelp":{"dynamicRegistration":true,"signatureInformation":{"documentationFormat":["markdown","plaintext"],"parameterInformation":{"labelOffsetSupport":true}},"contextSupport":true},"definition":{"dynamicRegistration":true,"linkSupport":true},"references":{"dynamicRegistration":true},"documentHighlight":{"dynamicRegistration":true},"documentSymbol":{"dynamicRegistration":true,"symbolKind":{"valueSet":[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26]},"hierarchicalDocumentSymbolSupport":true},"codeAction":{"dynamicRegistration":true,"isPreferredSupport":true,"codeActionLiteralSupport":{"codeActionKind":{"valueSet":["","quickfix","refactor","refactor.extract","refactor.inline","refactor.rewrite","source","source.organizeImports"]}}},"codeLens":{"dynamicRegistration":true},"formatting":{"dynamicRegistration":true},"rangeFormatting":{"dynamicRegistration":true},"onTypeFormatting":{"dynamicRegistration":true},"rename":{"dynamicRegistration":true,"prepareSupport":true},"documentLink":{"dynamicRegistration":true,"tooltipSupport":true},"typeDefinition":{"dynamicRegistration":true,"linkSupport":true},"implementation":{"dynamicRegistration":true,"linkSupport":true},"colorProvider":{"dynamicRegistration":true},"foldingRange":{"dynamicRegistration":true,"rangeLimit":5000,"lineFoldingOnly":true},"declaration":{"dynamicRegistration":true,"linkSupport":true},"selectionRange":{"dynamicRegistration":true},"callHierarchy":{"dynamicRegistration":true},"semanticTokens":{"dynamicRegistration":true,"tokenTypes":["comment","keyword","number","regexp","operator","namespace","type","struct","class","interface","enum","typeParameter","function","member","macro","variable","parameter","property","label"],"tokenModifiers":["declaration","documentation","static","abstract","deprecated","async","readonly"]}},"window":{"workDoneProgress":true}},"trace":"off","workspaceFolders":[{"uri":"file:///d%3A/dev/ws/haskell/hls","name":"hls"}]}}
2020-05-24 21:46:35.0251855 [ThreadId 4] - haskell-lsp:initializeRequestHandler: setting current dir to project root:d:\dev\ws\haskell\hls
2020-05-24 21:46:35.0475388 [ThreadId 6] - <--2--{"result":{"capabilities":{"typeDefinitionProvider":true,"foldingRangeProvider":false,"textDocumentSync":{"openClose":true,"change":2,"save":{}},"workspace":{"workspaceFolders":{"supported":true,"changeNotifications":true}},"implementationProvider":true,"documentRangeFormattingProvider":true,"documentHighlightProvider":true,"executeCommandProvider":{"commands":["2664:ghcide:typesignature.add","2664:pragmas:addPragma"]},"renameProvider":true,"colorProvider":false,"definitionProvider":true,"hoverProvider":true,"codeActionProvider":true,"completionProvider":{"triggerCharacters":["."],"resolveProvider":false},"codeLensProvider":{},"documentSymbolProvider":true,"documentFormattingProvider":true}},"jsonrpc":"2.0","id":0}
2020-05-24 21:46:35.0679062 [ThreadId 4] - ---> {"jsonrpc":"2.0","method":"initialized","params":{}}
2020-05-24 21:46:35.0759978 [ThreadId 4] - ---> {"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"languageServerHaskell":{"hlintOn":true,"maxNumberOfProblems":100,"diagnosticsOnChange":true,"liquidOn":false,"completionSnippetsOn":true,"formatOnImportOn":true,"formattingProvider":"floskell","showTypeForSelection":{"onHover":true,"command":{"location":"dropdown"}},"trace":{"server":"messages"},"logFile":"C:\\TEMP\\hls.log","hieVariant":"haskell-language-server","hieExecutablePath":"","enableHIE":true}}}}
2020-05-24 21:46:35.0759978 [ThreadId 4] - ---> {"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///d%3A/dev/ws/haskell/hls/exe/Main.hs","languageId":"haskell","version":1,"text":"-- Copyright (c) 2019 The DAML Authors. All rights reserved.\r\n-- SPDX-License-Identifier: Apache-2.0\r\n{-# LANGUAGE CPP #-} -- To get precise GHC version\r\n{-# LANGUAGE TemplateHaskell #-}\r\n{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above\r\n{-# LANGUAGE DeriveGeneric #-}\r\n{-# LANGUAGE OverloadedStrings #-}\r\n{-# LANGUAGE RecordWildCards #-}\r\n{-# LANGUAGE TupleSections #-}\r\n{-# LANGUAGE TypeFamilies #-}\r\n{-# LANGUAGE ViewPatterns #-}\r\n\r\nmodule Main(main) where\r\n\r\nimport Arguments\r\nimport Control.Concurrent.Async\r\nimport Control.Concurrent.Extra\r\nimport Control.Exception\r\nimport Control.Monad.Extra\r\nimport Control.Monad.IO.Class\r\nimport qualified Crypto.Hash.SHA1 as H\r\nimport Data.ByteString.Base16 (encode)\r\nimport qualified Data.ByteString.Char8 as B\r\nimport Data.Default\r\nimport Data.Either\r\nimport Data.Function\r\nimport qualified Data.HashMap.Strict as HM\r\nimport qualified Data.HashSet as HashSet\r\nimport Data.IORef\r\nimport Data.List.Extra\r\nimport qualified Data.Map.Strict as Map\r\nimport Data.Maybe\r\nimport qualified Data.Text as T\r\nimport qualified Data.Text.IO as T\r\nimport Data.Time.Clock (UTCTime)\r\n-- import Data.Version\r\n-- import Development.GitRev\r\nimport Development.IDE.Core.Debouncer\r\nimport Development.IDE.Core.FileStore\r\nimport Development.IDE.Core.OfInterest\r\nimport Development.IDE.Core.RuleTypes\r\nimport Development.IDE.Core.Rules\r\nimport Development.IDE.Core.Service\r\nimport Development.IDE.Core.Shake\r\nimport Development.IDE.GHC.Util\r\nimport Development.IDE.LSP.LanguageServer\r\nimport Development.IDE.LSP.Protocol\r\nimport Development.IDE.Plugin\r\nimport Development.IDE.Types.Diagnostics\r\nimport Development.IDE.Types.Location\r\nimport Development.IDE.Types.Logger\r\nimport Development.IDE.Types.Options\r\nimport Development.Shake (Action)\r\nimport DynFlags (gopt_set, gopt_unset,\r\n updOptLevel)\r\nimport DynFlags (PackageFlag(..), PackageArg(..))\r\nimport GHC hiding (def)\r\nimport GHC.Check ( VersionCheck(..), makeGhcVersionChecker )\r\n-- import GhcMonad\r\nimport HIE.Bios.Cradle\r\nimport HIE.Bios.Environment (addCmdOpts, makeDynFlagsAbsolute)\r\nimport HIE.Bios.Types\r\nimport HscTypes (HscEnv(..), ic_dflags)\r\nimport qualified Language.Haskell.LSP.Core as LSP\r\nimport Ide.Logger\r\nimport Ide.Plugin\r\nimport Ide.Plugin.Config\r\nimport Ide.Types (IdePlugins, ipMap)\r\nimport Language.Haskell.LSP.Messages\r\nimport Language.Haskell.LSP.Types (LspId(IdInt))\r\nimport Linker (initDynLinker)\r\nimport Module\r\nimport NameCache\r\nimport Packages\r\n-- import Paths_ghcide\r\nimport System.Directory\r\nimport qualified System.Directory.Extra as IO\r\n-- import System.Environment\r\nimport System.Exit\r\nimport System.FilePath\r\nimport System.IO\r\nimport System.Log.Logger as L\r\nimport System.Time.Extra\r\n\r\n-- ---------------------------------------------------------------------\r\n-- ghcide partialhandlers\r\nimport Development.IDE.Plugin.CodeAction as CodeAction\r\nimport Development.IDE.Plugin.Completions as Completions\r\nimport Development.IDE.LSP.HoverDefinition as HoverDefinition\r\n\r\n -- haskell-language-server plugins\r\nimport Ide.Plugin.Example as Example\r\nimport Ide.Plugin.Example2 as Example2\r\nimport Ide.Plugin.GhcIde as GhcIde\r\nimport Ide.Plugin.Floskell as Floskell\r\nimport Ide.Plugin.Ormolu as Ormolu\r\n#if AGPL\r\nimport Ide.Plugin.Brittany as Brittany\r\n#endif\r\nimport Ide.Plugin.Pragmas as Pragmas\r\n\r\n\r\n-- ---------------------------------------------------------------------\r\n\r\n\r\n\r\n-- | The plugins configured for use in this instance of the language\r\n-- server.\r\n-- These can be freely added or removed to tailor the available\r\n-- features of the server.\r\n\r\nidePlugins :: Bool -> IdePlugins\r\nidePlugins includeExamples = pluginDescToIdePlugins allPlugins\r\n where\r\n allPlugins = if includeExamples\r\n then basePlugins ++ examplePlugins\r\n else basePlugins\r\n basePlugins =\r\n [\r\n -- applyRefactDescriptor \"applyrefact\"\r\n -- , haddockDescriptor \"haddock\"\r\n -- , hareDescriptor \"hare\"\r\n -- , hsimportDescriptor \"hsimport\"\r\n -- , liquidDescriptor \"liquid\"\r\n -- , packageDescriptor \"package\"\r\n GhcIde.descriptor \"ghcide\"\r\n , Pragmas.descriptor \"pragmas\"\r\n , Floskell.descriptor \"floskell\"\r\n -- , genericDescriptor \"generic\"\r\n -- , ghcmodDescriptor \"ghcmod\"\r\n , Ormolu.descriptor \"ormolu\"\r\n#if AGPL\r\n , Brittany.descriptor \"brittany\"\r\n#endif\r\n ]\r\n examplePlugins =\r\n [Example.descriptor \"eg\"\r\n ,Example2.descriptor \"eg2\"\r\n -- ,hfaAlignDescriptor \"hfaa\"\r\n ]\r\n\r\nghcIdePlugins :: T.Text -> IdePlugins -> (Plugin Config, [T.Text])\r\nghcIdePlugins pid ps = (asGhcIdePlugin ps, allLspCmdIds' pid ps)\r\n\r\n-- ---------------------------------------------------------------------\r\n\r\n-- -- Set the GHC libdir to the nix libdir if it's present.\r\n-- getLibdir :: IO FilePath\r\n-- getLibdir = fromMaybe GHC.Paths.libdir <$> lookupEnv \"NIX_GHC_LIBDIR\"\r\n\r\nmain :: IO ()\r\nmain = do\r\n -- WARNING: If you write to stdout before runLanguageServer\r\n -- then the language server will not work\r\n args@Arguments{..} <- getArguments \"haskell-language-server\"\r\n\r\n if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess\r\n else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion\r\n\r\n LSP.setupLogger argsLogFile [\"hls\", \"hie-bios\"]\r\n $ if argsDebugOn then L.DEBUG else L.INFO\r\n\r\n -- lock to avoid overlapping output on stdout\r\n lock <- newLock\r\n let logger p = Logger $ \\pri msg -> when (pri >= p) $ withLock lock $\r\n T.putStrLn $ T.pack (\"[\" ++ upper (show pri) ++ \"] \") <> msg\r\n\r\n whenJust argsCwd IO.setCurrentDirectory\r\n\r\n dir <- IO.getCurrentDirectory\r\n\r\n pid <- getPid\r\n let\r\n idePlugins' = idePlugins argsExamplePlugin\r\n (ps, commandIds) = ghcIdePlugins pid idePlugins'\r\n plugins = Completions.plugin <> CodeAction.plugin <>\r\n Plugin mempty HoverDefinition.setHandlersDefinition <>\r\n ps\r\n options = def { LSP.executeCommandCommands = Just commandIds\r\n , LSP.completionTriggerCharacters = Just \".\"\r\n }\r\n if argLSP then do\r\n t <- offsetTime\r\n hPutStrLn stderr \"Starting (haskell-language-server)LSP server...\"\r\n hPutStrLn stderr $ \" with arguments: \" <> show args\r\n hPutStrLn stderr $ \" with plugins: \" <> show (Map.keys $ ipMap idePlugins')\r\n hPutStrLn stderr \"If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!\"\r\n runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \\getLspId event vfs caps -> do\r\n t <- t\r\n hPutStrLn stderr $ \"Started LSP server in \" ++ showDuration t\r\n let options = (defaultIdeOptions $ loadSession dir)\r\n { optReportProgress = clientSupportsProgress caps\r\n , optShakeProfiling = argsShakeProfiling\r\n , optTesting = argsTesting\r\n , optThreads = argsThreads\r\n , optInterfaceLoadingDiagnostics = argsTesting\r\n }\r\n debouncer <- newAsyncDebouncer\r\n fst <$> initialise caps (mainRule >> pluginRules plugins)\r\n getLspId event hlsLogger debouncer options vfs\r\n else do\r\n -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error\r\n hSetEncoding stdout utf8\r\n hSetEncoding stderr utf8\r\n\r\n putStrLn $ \"(haskell-language-server)Ghcide setup tester in \" ++ dir ++ \".\"\r\n putStrLn \"Report bugs at https://github.com/haskell/haskell-language-server/issues\"\r\n\r\n putStrLn $ \"\\nStep 1/6: Finding files to test in \" ++ dir\r\n files <- expandFiles (argFiles ++ [\".\" | null argFiles])\r\n -- LSP works with absolute file paths, so try and behave similarly\r\n files <- nubOrd <$> mapM IO.canonicalizePath files\r\n putStrLn $ \"Found \" ++ show (length files) ++ \" files\"\r\n\r\n putStrLn \"\\nStep 2/6: Looking for hie.yaml files that control setup\"\r\n cradles <- mapM findCradle files\r\n let ucradles = nubOrd cradles\r\n let n = length ucradles\r\n putStrLn $ \"Found \" ++ show n ++ \" cradle\" ++ ['s' | n /= 1]\r\n putStrLn \"\\nStep 3/6: Initializing the IDE\"\r\n vfs <- makeVFSHandle\r\n debouncer <- newAsyncDebouncer\r\n (ide, worker) <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) debouncer (defaultIdeOptions $ loadSession dir) vfs\r\n\r\n putStrLn \"\\nStep 4/6: Type checking the files\"\r\n setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath' files\r\n _ <- runActionSync \"TypecheckTest\" ide $ uses TypeCheck (map toNormalizedFilePath' files)\r\n cancel worker\r\n return ()\r\n\r\nexpandFiles :: [FilePath] -> IO [FilePath]\r\nexpandFiles = concatMapM $ \\x -> do\r\n b <- IO.doesFileExist x\r\n if b then return [x] else do\r\n let recurse \".\" = True\r\n recurse x | \".\" `isPrefixOf` takeFileName x = False -- skip .git etc\r\n recurse x = takeFileName x `notElem` [\"dist\",\"dist-newstyle\"] -- cabal directories\r\n files <- filter (\\x -> takeExtension x `elem` [\".hs\",\".lhs\"]) <$> IO.listFilesInside (return . recurse) x\r\n when (null files) $\r\n fail $ \"Couldn't find any .hs/.lhs files inside directory: \" ++ x\r\n return files\r\n\r\n-- Running this every hover is too expensive, 0.2s on GHC for example\r\n{-\r\nkick :: Action ()\r\nkick = do\r\n files <- getFilesOfInterest\r\n void $ uses TypeCheck $ HashSet.toList files\r\n -}\r\n\r\n-- | Print an LSP event.\r\nshowEvent :: Lock -> FromServerMessage -> IO ()\r\nshowEvent _ (EventFileDiagnostics _ []) = return ()\r\nshowEvent lock (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) =\r\n withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,ShowDiag,) diags\r\nshowEvent lock e = withLock lock $ print e\r\n\r\n\r\ncradleToSessionOpts :: Cradle a -> FilePath -> IO (Either [CradleError] ComponentOptions)\r\ncradleToSessionOpts cradle file = do\r\n let showLine s = putStrLn (\"> \" ++ s)\r\n cradleRes <- runCradle (cradleOptsProg cradle) showLine file\r\n opts <- case cradleRes of\r\n CradleSuccess r -> pure (Right r)\r\n CradleFail err -> return (Left [err])\r\n -- For the None cradle perhaps we still want to report an Info\r\n -- message about the fact that the file is being ignored.\r\n CradleNone -> return (Left [])\r\n pure opts\r\n\r\nemptyHscEnv :: IORef NameCache -> IO HscEnv\r\nemptyHscEnv nc = do\r\n libdir <- getLibdir\r\n env <- runGhc (Just libdir) getSession\r\n initDynLinker env\r\n pure $ setNameCache nc env\r\n\r\n-- Convert a target to a list of potential absolute paths.\r\n-- A TargetModule can be anywhere listed by the supplied include\r\n-- directories\r\n-- A target file is a relative path but with a specific prefix so just need\r\n-- to canonicalise it.\r\ntargetToFile :: [FilePath] -> TargetId -> IO [NormalizedFilePath]\r\ntargetToFile is (TargetModule mod) = do\r\n let fps = [i </> (moduleNameSlashes mod) -<.> ext | ext <- exts, i <- is ]\r\n exts = [\"hs\", \"hs-boot\", \"lhs\"]\r\n mapM (fmap toNormalizedFilePath' . canonicalizePath) fps\r\ntargetToFile _ (TargetFile f _) = do\r\n f' <- canonicalizePath f\r\n return [(toNormalizedFilePath' f')]\r\n\r\nsetNameCache :: IORef NameCache -> HscEnv -> HscEnv\r\nsetNameCache nc hsc = hsc { hsc_NC = nc }\r\n\r\n-- This is the key function which implements multi-component support. All\r\n-- components mapping to the same hie,yaml file are mapped to the same\r\n-- HscEnv which is updated as new components are discovered.\r\nloadSession :: FilePath -> Action (FilePath -> Action (IdeResult HscEnvEq))\r\nloadSession dir = do\r\n nc <- ideNc <$> getShakeExtras\r\n liftIO $ do\r\n -- Mapping from hie.yaml file to HscEnv, one per hie.yaml file\r\n hscEnvs <- newVar Map.empty\r\n -- Mapping from a filepath to HscEnv\r\n fileToFlags <- newVar Map.empty\r\n\r\n -- This caches the mapping from Mod.hs -> hie.yaml\r\n cradleLoc <- memoIO $ \\v -> do\r\n res <- findCradle v\r\n -- Sometimes we get C:, sometimes we get c:, and sometimes we get a relative path\r\n -- try and normalise that\r\n -- e.g. see https://github.com/digital-asset/ghcide/issues/126\r\n res' <- traverse IO.makeAbsolute res\r\n return $ normalise <$> res'\r\n\r\n -- Create a new HscEnv from a hieYaml root and a set of options\r\n -- If the hieYaml file already has an HscEnv, the new component is\r\n -- combined with the components in the old HscEnv into a new HscEnv\r\n -- which contains both.\r\n packageSetup <- return $ \\(hieYaml, cfp, opts) -> do\r\n -- Parse DynFlags for the newly discovered component\r\n hscEnv <- emptyHscEnv nc\r\n (df, targets) <- evalGhcEnv hscEnv $ do\r\n setOptions opts (hsc_dflags hscEnv)\r\n dep_info <- getDependencyInfo (componentDependencies opts)\r\n -- Now lookup to see whether we are combining with an exisiting HscEnv\r\n -- or making a new one. The lookup returns the HscEnv and a list of\r\n -- information about other components loaded into the HscEnv\r\n -- (unitId, DynFlag, Targets)\r\n modifyVar hscEnvs $ \\m -> do\r\n -- Just deps if there's already an HscEnv\r\n -- Nothing is it's the first time we are making an HscEnv\r\n let oldDeps = Map.lookup hieYaml m\r\n let -- Add the raw information about this component to the list\r\n -- We will modify the unitId and DynFlags used for\r\n -- compilation but these are the true source of\r\n -- information.\r\n new_deps = (thisInstalledUnitId df, df, targets, cfp, opts, dep_info) : maybe [] snd oldDeps\r\n -- Get all the unit-ids for things in this component\r\n inplace = map (\\(a, _, _, _, _, _) -> a) new_deps\r\n\r\n -- Note [Avoiding bad interface files]\r\n new_deps' <- forM new_deps $ \\(uid, df1, ts, cfp, opts, di) -> do\r\n -- let (uid, (df1, _target, ts, cfp, opts, di)) = do_one componentInfo\r\n -- Remove all inplace dependencies from package flags for\r\n -- components in this HscEnv\r\n let (df2, uids) = removeInplacePackages inplace df1\r\n let prefix = show $ thisInstalledUnitId df1\r\n df <- setCacheDir prefix (sort $ map show uids) opts df2\r\n -- All deps, but without any packages which are also loaded\r\n -- into memory\r\n pure $ (uid, (df, uids, ts, cfp, opts, di))\r\n -- Make a new HscEnv, we have to recompile everything from\r\n -- scratch again (for now)\r\n -- It's important to keep the same NameCache though for reasons\r\n -- that I do not fully understand\r\n print (\"Making new HscEnv\" ++ (show inplace))\r\n hscEnv <- emptyHscEnv nc\r\n newHscEnv <-\r\n -- Add the options for the current component to the HscEnv\r\n evalGhcEnv hscEnv $ do\r\n _ <- setSessionDynFlags df\r\n getSession\r\n -- Modify the map so the hieYaml now maps to the newly created\r\n -- HscEnv\r\n -- Returns\r\n -- * the new HscEnv so it can be used to modify the\r\n -- FilePath -> HscEnv map\r\n -- * The information for the new component which caused this cache miss\r\n -- * The modified information (without -inplace flags) for\r\n -- existing packages\r\n pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps'))\r\n\r\n\r\n session <- return $ \\(hieYaml, cfp, opts) -> do\r\n (hscEnv, new, old_deps) <- packageSetup (hieYaml, cfp, opts)\r\n -- TODO Handle the case where there is no hie.yaml\r\n -- Make a map from unit-id to DynFlags, this is used when trying to\r\n -- resolve imports.\r\n let uids = map (\\(iuid, (df, _uis, _targets, _cfp, _opts, _di)) -> (iuid, df)) (new : old_deps)\r\n\r\n -- For each component, now make a new HscEnvEq which contains the\r\n -- HscEnv for the hie.yaml file but the DynFlags for that component\r\n --\r\n -- Then look at the targets for each component and create a map\r\n -- from FilePath to the HscEnv\r\n let new_cache (_iuid, (df, _uis, targets, cfp, _opts, di)) = do\r\n let hscEnv' = hscEnv { hsc_dflags = df\r\n , hsc_IC = (hsc_IC hscEnv) { ic_dflags = df } }\r\n\r\n versionMismatch <- checkGhcVersion\r\n henv <- case versionMismatch of\r\n Just mismatch -> return mismatch\r\n Nothing -> newHscEnvEq hscEnv' uids\r\n let res = (([], Just henv), di)\r\n print res\r\n\r\n let is = importPaths df\r\n ctargets <- concatMapM (targetToFile is . targetId) targets\r\n -- A special target for the file which caused this wonderful\r\n -- component to be created.\r\n let special_target = (cfp, res)\r\n --pprTraceM \"TARGETS\" (ppr (map (text . show) ctargets))\r\n let xs = map (,res) ctargets\r\n return (special_target:xs, res)\r\n\r\n -- New HscEnv for the component in question\r\n (cs, res) <- new_cache new\r\n -- Modified cache targets for everything else in the hie.yaml file\r\n -- which now uses the same EPS and so on\r\n cached_targets <- concatMapM (fmap fst . new_cache) old_deps\r\n modifyVar_ fileToFlags $ \\var -> do\r\n pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets)) var\r\n\r\n return (cs, res)\r\n\r\n lock <- newLock\r\n\r\n -- This caches the mapping from hie.yaml + Mod.hs -> [String]\r\n sessionOpts <- return $ \\(hieYaml, file) -> do\r\n\r\n\r\n fm <- readVar fileToFlags\r\n let mv = Map.lookup hieYaml fm\r\n let v = fromMaybe HM.empty mv\r\n cfp <- liftIO $ canonicalizePath file\r\n case HM.lookup (toNormalizedFilePath' cfp) v of\r\n Just (_, old_di) -> do\r\n deps_ok <- checkDependencyInfo old_di\r\n unless deps_ok $ do\r\n modifyVar_ fileToFlags (const (return Map.empty))\r\n -- Keep the same name cache\r\n modifyVar_ hscEnvs (return . Map.adjust (\\(h, _) -> (h, [])) hieYaml )\r\n Nothing -> return ()\r\n -- We sort so exact matches come first.\r\n case HM.lookup (toNormalizedFilePath' cfp) v of\r\n Just opts -> do\r\n --putStrLn $ \"Cached component of \" <> show file\r\n pure ([], fst opts)\r\n Nothing-> do\r\n finished_barrier <- newBarrier\r\n -- fork a new thread here which won't be killed by shake\r\n -- throwing an async exception\r\n void $ forkIO $ do\r\n putStrLn $ \"Consulting the cradle for \" <> show file\r\n cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml\r\n eopts <- cradleToSessionOpts cradle cfp\r\n print eopts\r\n case eopts of\r\n Right opts -> do\r\n (cs, res) <- session (hieYaml, toNormalizedFilePath' cfp, opts)\r\n signalBarrier finished_barrier (cs, fst res)\r\n Left err -> do\r\n dep_info <- getDependencyInfo ([fp | Just fp <- [hieYaml]])\r\n let ncfp = toNormalizedFilePath' cfp\r\n let res = (map (renderCradleError ncfp) err, Nothing)\r\n modifyVar_ fileToFlags $ \\var -> do\r\n pure $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) var\r\n signalBarrier finished_barrier ([(ncfp, (res, dep_info) )], res)\r\n waitBarrier finished_barrier\r\n\r\n dummyAs <- async $ return (error \"Uninitialised\")\r\n runningCradle <- newIORef dummyAs\r\n -- The main function which gets options for a file. We only want one of these running\r\n -- at a time.\r\n let getOptions file = do\r\n hieYaml <- cradleLoc file\r\n sessionOpts (hieYaml, file)\r\n -- The lock is on the `runningCradle` resource\r\n return $ \\file -> do\r\n (cs, opts) <-\r\n liftIO $ withLock lock $ do\r\n as <- readIORef runningCradle\r\n finished <- poll as\r\n case finished of\r\n Just {} -> do\r\n as <- async $ getOptions file\r\n writeIORef runningCradle as\r\n wait as\r\n -- If it's not finished then wait and then get options, this could of course be killed still\r\n Nothing -> do\r\n _ <- wait as\r\n getOptions file\r\n let cfps = map fst cs\r\n -- Delayed to avoid recursion and only run if something changed.\r\n unless (null cs) (\r\n delay \"InitialLoad\" (\"InitialLoad\" :: String, cfps) (void $ do\r\n cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) cfps\r\n mmt <- uses GetModificationTime cfps'\r\n let cs_exist = catMaybes (zipWith (<$) cfps' mmt)\r\n uses GetModIface cs_exist))\r\n return opts\r\n\r\n\r\n{- Note [Avoiding bad interface files]\r\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r\nOriginally, we set the cache directory for the various components once\r\non the first occurrence of the component.\r\nThis works fine if these components have no references to each other,\r\nbut you have components that depend on each other, the interface files are\r\nupdated for each component.\r\nAfter restarting the session and only opening the component that depended\r\non the other, suddenly the interface files of this component are stale.\r\nHowever, from the point of view of `ghcide`, they do not look stale,\r\nthus, not regenerated and the IDE shows weird errors such as:\r\n```\r\ntypecheckIface\r\nDeclaration for Rep_ClientRunFlags\r\nAxiom branches Rep_ClientRunFlags:\r\n Failed to load interface for ‘Distribution.Simple.Flag’\r\n Use -v to see a list of the files searched for.\r\n```\r\nand\r\n```\r\nexpectJust checkFamInstConsistency\r\nCallStack (from HasCallStack):\r\n error, called at compiler\\\\utils\\\\Maybes.hs:55:27 in ghc:Maybes\r\n expectJust, called at compiler\\\\typecheck\\\\FamInst.hs:461:30 in ghc:FamInst\r\n```\r\n\r\nTo mitigate this, we set the cache directory for each component dependent\r\non the components of the current `HscEnv`, additionally to the component options\r\nof the respective components.\r\nAssume two components, c1, c2, where c2 depends on c1, and the options of the\r\nrespective components are co1, co2.\r\nIf we want to load component c2, followed by c1, we set the cache directory for\r\neach component in this way:\r\n\r\n * Load component c2\r\n * (Cache Directory State)\r\n - name of c2 + co2\r\n * Load component c1\r\n * (Cache Directory State)\r\n - name of c2 + name of c1 + co2\r\n - name of c2 + name of c1 + co1\r\n\r\nOverall, we created three cache directories. If we opened c1 first, then we\r\ncreate a fourth cache directory.\r\nThis makes sure that interface files are always correctly updated.\r\n\r\nSince this causes a lot of recompilation, we only update the cache-directory,\r\nif the dependencies of a component have really changed.\r\nE.g. when you load two executables, they can not depend on each other. They\r\nshould be filtered out, such that we dont have to re-compile everything.\r\n-}\r\n\r\n\r\nsetCacheDir :: MonadIO m => String -> [String] -> ComponentOptions -> DynFlags -> m DynFlags\r\nsetCacheDir prefix hscComponents comps dflags = do\r\n cacheDir <- liftIO $ getCacheDir prefix (hscComponents ++ componentOptions comps)\r\n pure $ dflags\r\n & setHiDir cacheDir\r\n & setDefaultHieDir cacheDir\r\n\r\n\r\nrenderCradleError :: NormalizedFilePath -> CradleError -> FileDiagnostic\r\nrenderCradleError nfp (CradleError _ec t) =\r\n ideErrorText nfp (T.unlines (map T.pack t))\r\n\r\n\r\ncheckDependencyInfo :: Map.Map FilePath (Maybe UTCTime) -> IO Bool\r\ncheckDependencyInfo old_di = do\r\n di <- getDependencyInfo (Map.keys old_di)\r\n return (di == old_di)\r\n\r\n\r\n\r\ngetDependencyInfo :: [FilePath] -> IO (Map.Map FilePath (Maybe UTCTime))\r\ngetDependencyInfo fs = Map.fromList <$> mapM do_one fs\r\n\r\n where\r\n do_one fp = do\r\n exists <- IO.doesFileExist fp\r\n if exists\r\n then do\r\n mtime <- getModificationTime fp\r\n return (fp, Just mtime)\r\n else return (fp, Nothing)\r\n\r\n-- This function removes all the -package flags which refer to packages we\r\n-- are going to deal with ourselves. For example, if a executable depends\r\n-- on a library component, then this function will remove the library flag\r\n-- from the package flags for the executable\r\n--\r\n-- There are several places in GHC (for example the call to hptInstances in\r\n-- tcRnImports) which assume that all modules in the HPT have the same unit\r\n-- ID. Therefore we create a fake one and give them all the same unit id.\r\nremoveInplacePackages :: [InstalledUnitId] -> DynFlags -> (DynFlags, [InstalledUnitId])\r\nremoveInplacePackages us df = (df { packageFlags = ps\r\n , thisInstalledUnitId = fake_uid }, uids)\r\n where\r\n (uids, ps) = partitionEithers (map go (packageFlags df))\r\n fake_uid = toInstalledUnitId (stringToUnitId \"fake_uid\")\r\n go p@(ExposePackage _ (UnitIdArg u) _) = if (toInstalledUnitId u `elem` us) then Left (toInstalledUnitId u) else Right p\r\n go p = Right p\r\n\r\n-- | Memoize an IO function, with the characteristics:\r\n--\r\n-- * If multiple people ask for a result simultaneously, make sure you only compute it once.\r\n--\r\n-- * If there are exceptions, repeatedly reraise them.\r\n--\r\n-- * If the caller is aborted (async exception) finish computing it anyway.\r\nmemoIO :: Ord a => (a -> IO b) -> IO (a -> IO b)\r\nmemoIO op = do\r\n ref <- newVar Map.empty\r\n return $ \\k -> join $ mask_ $ modifyVar ref $ \\mp ->\r\n case Map.lookup k mp of\r\n Nothing -> do\r\n res <- onceFork $ op k\r\n return (Map.insert k res mp, res)\r\n Just res -> return (mp, res)\r\n\r\nsetOptions :: GhcMonad m =>ComponentOptions -> DynFlags -> m (DynFlags, [Target])\r\nsetOptions (ComponentOptions theOpts compRoot _) dflags = do\r\n (dflags_, targets) <- addCmdOpts theOpts dflags\r\n let dflags' = makeDynFlagsAbsolute compRoot dflags_\r\n let dflags'' =\r\n -- disabled, generated directly by ghcide instead\r\n flip gopt_unset Opt_WriteInterface $\r\n -- disabled, generated directly by ghcide instead\r\n -- also, it can confuse the interface stale check\r\n dontWriteHieFiles $\r\n setIgnoreInterfacePragmas $\r\n setLinkerOptions $\r\n disableOptimisation dflags'\r\n -- initPackages parses the -package flags and\r\n -- sets up the visibility for each component.\r\n (final_df, _) <- liftIO $ initPackages dflags''\r\n-- let df'' = gopt_unset df' Opt_WarnIsError\r\n return (final_df, targets)\r\n\r\n\r\n-- we don't want to generate object code so we compile to bytecode\r\n-- (HscInterpreted) which implies LinkInMemory\r\n-- HscInterpreted\r\nsetLinkerOptions :: DynFlags -> DynFlags\r\nsetLinkerOptions df = df {\r\n ghcLink = LinkInMemory\r\n , hscTarget = HscNothing\r\n , ghcMode = CompManager\r\n }\r\n\r\nsetIgnoreInterfacePragmas :: DynFlags -> DynFlags\r\nsetIgnoreInterfacePragmas df =\r\n gopt_set (gopt_set df Opt_IgnoreInterfacePragmas) Opt_IgnoreOptimChanges\r\n\r\ndisableOptimisation :: DynFlags -> DynFlags\r\ndisableOptimisation df = updOptLevel 0 df\r\n\r\nsetHiDir :: FilePath -> DynFlags -> DynFlags\r\nsetHiDir f d =\r\n -- override user settings to avoid conflicts leading to recompilation\r\n d { hiDir = Just f}\r\n\r\ngetCacheDir :: String -> [String] -> IO FilePath\r\ngetCacheDir prefix opts = IO.getXdgDirectory IO.XdgCache (cacheDir </> prefix ++ \"-\" ++ opts_hash)\r\n where\r\n -- Create a unique folder per set of different GHC options, assuming that each different set of\r\n -- GHC options will create incompatible interface files.\r\n opts_hash = B.unpack $ encode $ H.finalize $ H.updates H.init $ (map B.pack opts)\r\n\r\n-- Prefix for the cache path\r\ncacheDir :: String\r\ncacheDir = \"ghcide\"\r\n\r\nghcVersionChecker :: IO VersionCheck\r\nghcVersionChecker = $$(makeGhcVersionChecker (pure <$> getLibdir))\r\n\r\ncheckGhcVersion :: IO (Maybe HscEnvEq)\r\ncheckGhcVersion = do\r\n res <- ghcVersionChecker\r\n case res of\r\n Failure err -> do\r\n putStrLn $ \"Error while checking GHC version: \" ++ show err\r\n return Nothing\r\n Mismatch {..} ->\r\n return $ Just GhcVersionMismatch {..}\r\n _ ->\r\n return Nothing\r\n"}}}
2020-05-24 21:46:35.0780836 [ThreadId 10] - Set files of interest to: [NormalizedFilePath "D:\\dev\\ws\\haskell\\hls\\exe\\Main.hs"]
2020-05-24 21:46:35.0850572 [ThreadId 10] - Opened text document: file:///d%3A/dev/ws/haskell/hls/exe/Main.hs
2020-05-24 21:46:35.0850572 [ThreadId 9] - Starting: (1,0):[DelayedAction: OfInterest]
2020-05-24 21:46:35.1150583 [ThreadId 4] - ---> {"jsonrpc":"2.0","id":1,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///d%3A/dev/ws/haskell/hls/exe/Main.hs"}}}
2020-05-24 21:46:35.1160543 [ThreadId 4] - ---> {"jsonrpc":"2.0","id":2,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///d%3A/dev/ws/haskell/hls/exe/Main.hs"},"range":{"start":{"line":446,"character":30},"end":{"line":446,"character":44}},"context":{"diagnostics":[]}}}
2020-05-24 21:46:35.1170549 [ThreadId 6] - <--2--{"result":[],"jsonrpc":"2.0","id":1}
2020-05-24 21:46:35.1884523 [ThreadId 6] - <--2--{"jsonrpc":"2.0","params":{"token":"2"},"method":"window/workDoneProgress/create","id":0}
2020-05-24 21:46:35.1884523 [ThreadId 6] - <--2--{"jsonrpc":"2.0","params":{"value":{"kind":"begin","title":"Processing"},"token":"2"},"method":"$/progress"}
2020-05-24 21:46:35.1985953 [ThreadId 4] - ---> {"jsonrpc":"2.0","id":0,"result":null}
2020-05-24 21:46:35.1985953 [ThreadId 4] - haskell-lsp:Got reply message:"{\"jsonrpc\":\"2.0\",\"id\":0,\"result\":null}"
2020-05-24 21:46:35.3102091 [ThreadId 6] - <--2--{"jsonrpc":"2.0","params":{"value":{"kind":"report","message":"1/2"},"token":"2"},"method":"$/progress"}
2020-05-24 21:46:35.5463687 [ThreadId 4] - ---> {"jsonrpc":"2.0","id":3,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///d%3A/dev/ws/haskell/hls/exe/Main.hs"}}}
2020-05-24 21:48:26.6224897 [ThreadId 4] - ---> {"jsonrpc":"2.0","method":"$/cancelRequest","params":{"id":3}}
2020-05-24 21:48:26.6234878 [ThreadId 4] - ---> {"jsonrpc":"2.0","method":"$/cancelRequest","params":{"id":2}}
2020-05-24 21:48:26.6234878 [ThreadId 10] - Cancelled request IdInt 2
2020-05-24 21:48:26.7754859 [ThreadId 6] - <--2--{"error":{"code":-32800,"message":""},"jsonrpc":"2.0","id":2}
2020-05-24 21:48:26.8644884 [ThreadId 10] - Cancelled request IdInt 3
2020-05-24 21:48:27.0074889 [ThreadId 6] - <--2--{"error":{"code":-32800,"message":""},"jsonrpc":"2.0","id":3}
2020-05-24 22:09:10.7253665 [ThreadId 4] - ---> {"jsonrpc":"2.0","id":4,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///d%3A/dev/ws/haskell/hls/exe/Main.hs"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}}
2020-05-24 22:09:10.9523814 [ThreadId 4] - ---> {"jsonrpc":"2.0","id":5,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///d%3A/dev/ws/haskell/hls/exe/Main.hs"}}}
2020-05-24 22:09:10.9533677 [ThreadId 4] - ---> {"jsonrpc":"2.0","id":6,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///d%3A/dev/ws/haskell/hls/exe/Main.hs"},"range":{"start":{"line":446,"character":30},"end":{"line":446,"character":44}},"context":{"diagnostics":[]}}}
2020-05-24 22:09:10.9533677 [ThreadId 4] - ---> {"jsonrpc":"2.0","method":"$/cancelRequest","params":{"id":4}}
2020-05-24 22:09:10.9543669 [ThreadId 10] - Cancelled request IdInt 4
2020-05-24 22:09:10.9543669 [ThreadId 53] - Plugin.makeCodeLens (ideLogger)
[client] run command = "haskell-language-server-wrapper --lsp"
[client] debug command = "haskell-language-server-wrapper --lsp -d -l C:\TEMP\hls.log"
ghcide version: 0.1.0.0 (GHC: 8.6.5) (PATH: D:\bin\haskell-language-server-wrapper.exe) (GIT hash: a2b7710a17b2b76a4954527b79f9f6f3e7a3f879)
ghcide version: 0.1.0.0 (GHC: 8.6.5) (PATH: D:\bin\haskell-language-server-8.6.5.exe) (GIT hash: a2b7710a17b2b76a4954527b79f9f6f3e7a3f879)
Starting (haskell-language-server)LSP server...
with arguments: Arguments {argLSP = True, argsCwd = Nothing, argFiles = [], argsVersion = False, argsShakeProfiling = Nothing, argsTesting = False, argsExamplePlugin = False, argsDebugOn = True, argsLogFile = Just "C:\\TEMP\\hls.log", argsThreads = 0}
with plugins: [PluginId "brittany",PluginId "floskell",PluginId "ghcide",PluginId "ormolu",PluginId "pragmas"]
If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!
Started LSP server in 0.01s
Consulting the cradle for "D:\\dev\\ws\\haskell\\hls\\exe\\Main.hs"
> Using main module: 1. Package `haskell-language-server' component haskell-language-server:exe:haskell-language-server with main-is file: D:\dev\ws\haskell\hls\exe\Main.hs
> Diff > using precompiled package
> SHA > using precompiled package
> StateVar > using precompiled package
> base-compat > using precompiled package
> base-orphans > using precompiled package
> alex > configure
> base16-bytestring > using precompiled package
> blaze-builder > using precompiled package
> call-stack > using precompiled package
> clock > using precompiled package
> blaze-markup > using precompiled package
> HUnit > using precompiled package
> cmdargs > using precompiled package
> colour > using precompiled package
> contravariant > using precompiled package
> cryptohash-sha1 > using precompiled package
> czipwith > using precompiled package
> data-default-class > using precompiled package
> dec > using precompiled package
> dlist > using precompiled package
> data-default-instances-containers> using precompiled package
> exceptions > using precompiled package
> alex > Configuring alex-3.2.5...
> data-default-instances-dlist > using precompiled package
> file-embed > using precompiled package
> githash > using precompiled package
> gitrev > using precompiled package
> hashable > using precompiled package
> heaps > using precompiled package
> async > using precompiled package
> case-insensitive > using precompiled package
> alex > build
> hspec-expectations > using precompiled package
> happy > configure
> alex > Preprocessing executable 'alex' for alex-3.2.5..
> alex > Building executable 'alex' for alex-3.2.5..
> indexed-profunctors > using precompiled package
> integer-logarithms > using precompiled package
> js-dgtable > using precompiled package
> js-flot > using precompiled package
> happy > Configuring happy-1.19.12...
> js-jquery > using precompiled package
> microlens > using precompiled package
> mintty > using precompiled package
> happy > build
> hspec-discover > configure
> ansi-terminal > using precompiled package
> alex > [ 1 of 22] Compiling Data.Ranged.Boundaries
> happy > Preprocessing executable 'happy' for happy-1.19.12..
> happy > Building executable 'happy' for happy-1.19.12..
> ansi-wl-pprint > using precompiled package
> network > using precompiled package
> alex > [ 2 of 22] Compiling Data.Ranged.Ranges
> old-locale > using precompiled package
> alex > [ 3 of 22] Compiling Data.Ranged.RangedSet
> data-default-instances-old-locale> using precompiled package
> alex > 
> alex > src\Data\Ranged\RangedSet.hs:31:1: warning: [-Wunused-imports]
> alex > The import of `Data.Semigroup' is redundant
> alex > except perhaps to import instances from `Data.Semigroup'
> alex > To import instances alone, use: import Data.Semigroup()
> alex >  |
> alex > 31 | import Data.Semigroup
> alex >  | ^^^^^^^^^^^^^^^^^^^^^
> hspec-discover > Configuring hspec-discover-2.7.1...
> data-default > using precompiled package
> alex > [ 4 of 22] Compiling Data.Ranged
> alex > [ 5 of 22] Compiling Map
> alex > [ 6 of 22] Compiling Paths_alex
> hslogger > using precompiled package
> alex > [ 7 of 22] Compiling Set
> opentelemetry > using precompiled package
> alex > [ 8 of 22] Compiling DFS
> optics-core > using precompiled package
> hspec-discover > build
> alex > [ 9 of 22] Compiling Sort
> hspec-discover > Preprocessing library for hspec-discover-2.7.1..
> hspec-discover > Building library for hspec-discover-2.7.1..
> parallel > using precompiled package
> alex > [10 of 22] Compiling UTF8
> hspec-discover > [1 of 4] Compiling Paths_hspec_discover
> alex > [11 of 22] Compiling CharSet
> parsec > using precompiled package
> happy > [ 1 of 19] Compiling AbsSyn
> hspec-discover > [2 of 4] Compiling Test.Hspec.Discover.Config
> alex > [12 of 22] Compiling Util
> Cabal > using precompiled package
> alex > [13 of 22] Compiling AbsSyn
> happy > [ 2 of 19] Compiling GenUtils
> hspec-discover > [3 of 4] Compiling Test.Hspec.Discover.Sort
> cabal-doctest > using precompiled package
> happy > [ 3 of 19] Compiling NameSet
> hspec-discover > [4 of 4] Compiling Test.Hspec.Discover.Run
> happy > [ 4 of 19] Compiling ParamRules
> ghc-paths > using precompiled package
> ghc-check > using precompiled package
> alex > [14 of 22] Compiling ParseMonad
> hspec-discover > Preprocessing executable 'hspec-discover' for hspec-discover-2.7.1..
> hspec-discover > Building executable 'hspec-discover' for hspec-discover-2.7.1..
> haddock-library > using precompiled package
> hspec-discover > [1 of 2] Compiling Main
> alex > [15 of 22] Compiling Scan
> happy > [ 5 of 19] Compiling ParseMonad
> network-uri > using precompiled package
> hspec-discover > [2 of 2] Compiling Paths_hspec_discover
> happy > [ 6 of 19] Compiling Lexer
> parser-combinators > using precompiled package
> hspec-discover > Linking .stack-work\dist\e626a42b\build\hspec-discover\hspec-discover.exe ...
> prettyprinter > using precompiled package
> happy > [ 7 of 19] Compiling AttrGrammar
> alex > [16 of 22] Compiling Parser
> prettyprinter-ansi-terminal > using precompiled package
> primes > using precompiled package
> happy > [ 8 of 19] Compiling AttrGrammarParser
> primitive > using precompiled package
> happy > [ 9 of 19] Compiling Grammar
> psqueues > using precompiled package
> alex > [17 of 22] Compiling Output
> random > using precompiled package
> reflection > using precompiled package
> regex-base > using precompiled package
> happy > [10 of 19] Compiling LALR
> regex-tdfa > using precompiled package
> alex > [18 of 22] Compiling NFA
> rope-utf16-splay > using precompiled package
> hspec-discover > copy/register
> hspec-discover > Installing library in C:\sr\snapshots\5abeca39\lib\x86_64-windows-ghc-8.6.5\hspec-discover-2.7.1-LGJDqSQ2jlrBzGstAgoI3G
> hspec-discover > Installing executable hspec-discover in C:\sr\snapshots\5abeca39\bin
> safe > using precompiled package
> alex > [19 of 22] Compiling Info
> alex > [20 of 22] Compiling DFAMin
> happy > [11 of 19] Compiling First
> alex > [21 of 22] Compiling DFA
> happy > [12 of 19] Compiling Parser
> alex > [22 of 22] Compiling Main
> hspec-discover > Registering library for hspec-discover-2.7.1..
> safe-exceptions > using precompiled package
> scientific > using precompiled package
> semigroups > using precompiled package
> happy > [13 of 19] Compiling Paths_happy
> attoparsec > using precompiled package
> happy > [14 of 19] Compiling Info
> extra > using precompiled package
> megaparsec > using precompiled package
> filepattern > using precompiled package
> happy > [15 of 19] Compiling PrettyGrammar
> neat-interpolation > using precompiled package
> setenv > using precompiled package
> happy > [16 of 19] Compiling ProduceGLRCode
> singleton-bool > using precompiled package
> sorted-list > using precompiled package
> split > using precompiled package
> splitmix > using precompiled package
> strict > using precompiled package
> QuickCheck > using precompiled package
> syb > using precompiled package
> quickcheck-io > using precompiled package
> data-tree-print > using precompiled package
> tagged > using precompiled package
> temporary > using precompiled package
> happy > [17 of 19] Compiling Target
> alex > Linking .stack-work\dist\e626a42b\build\alex\alex.exe ...
> distributive > using precompiled package
> happy > [18 of 19] Compiling ProduceCode
> tf-random > using precompiled package
> th-abstraction > using precompiled package
> hspec-core > using precompiled package
> microlens-th > using precompiled package
> hspec > using precompiled package
> time-compat > using precompiled package
> transformers-compat > using precompiled package
> type-equality > using precompiled package
> comonad > using precompiled package
> optparse-applicative > using precompiled package
> bifunctors > using precompiled package
> optparse-simple > using precompiled package
> assoc > using precompiled package
> profunctors > using precompiled package
> transformers-base > using precompiled package
> alex > 
> alex > copy/register
> unbounded-delays > using precompiled package
> alex > Installing executable alex in C:\sr\snapshots\5abeca39\bin
> monad-control > using precompiled package
> unix-compat > using precompiled package
> tasty > using precompiled package
> multistate > using precompiled package
> unliftio-core > using precompiled package
> tasty-hunit > using precompiled package
> unordered-containers > using precompiled package
> resourcet > using precompiled package
> happy > [19 of 19] Compiling Main
> typed-process > using precompiled package
> happy > 
> happy > src\Main.lhs:35:3: warning: [-Wunused-imports]
> happy > The import of `Foreign.Marshal.Array' is redundant
> happy > except perhaps to import instances from `Foreign.Marshal.Array'
> happy > To import instances alone, use: import Foreign.Marshal.Array()
> happy >  |
> happy > 35 | > import Foreign.Marshal.Array
> happy >  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> happy > 
> happy > src\Main.lhs:36:3: warning: [-Wunused-imports]
> happy > The import of `Foreign' is redundant
> happy > except perhaps to import instances from `Foreign'
> happy > To import instances alone, use: import Foreign()
> happy >  |
> happy > 36 | > import Foreign
> happy >  | ^^^^^^^^^^^^^^
> happy > 
> happy > src\Main.lhs:37:3: warning: [-Wunused-imports]
> happy > The import of `Foreign.C' is redundant
> happy > except perhaps to import instances from `Foreign.C'
> happy > To import instances alone, use: import Foreign.C()
> happy >  |
> happy > 37 | > import Foreign.C
> happy >  | ^^^^^^^^^^^^^^^^
> charset > using precompiled package
> invariant > using precompiled package
> semigroupoids > using precompiled package
> parsers > using precompiled package
> uniplate > using precompiled package
> free > using precompiled package
> strict-list > using precompiled package
> unsafe > using precompiled package
> ghc-exactprint > using precompiled package
> deque > using precompiled package
> monad-dijkstra > using precompiled package
> utf8-string > using precompiled package
> uuid-types > using precompiled package
> vector > using precompiled package
> void > using precompiled package
> aeson > using precompiled package
> adjunctions > using precompiled package
> happy > [ 1 of 19] Compiling AbsSyn [C:\\TEMP\ghc6952_0\ghc_3.lpp changed]
> butcher > using precompiled package
> shake > configure
> happy > [ 2 of 19] Compiling GenUtils [C:\\TEMP\ghc6952_0\ghc_9.lpp changed]
> kan-extensions > using precompiled package
> happy > [ 6 of 19] Compiling Lexer [C:\\TEMP\ghc6952_0\ghc_21.lpp changed]
> lens > using precompiled package
> haskell-lsp-types > using precompiled package
> happy > [ 7 of 19] Compiling AttrGrammar [C:\\TEMP\ghc6952_0\ghc_39.lpp changed]
> haskell-lsp > using precompiled package
> monad-memo > using precompiled package
> shake > Configuring shake-0.19...
> happy > [ 9 of 19] Compiling Grammar [C:\\TEMP\ghc6952_0\ghc_12.lpp changed]
> monoid-subclasses > using precompiled package
> fuzzy > using precompiled package
> these > using precompiled package
> shake > build
> aeson-pretty > configure
> semialign > using precompiled package
> shake > Preprocessing executable 'shake' for shake-0.19..
> shake > Building executable 'shake' for shake-0.19..
> topograph > using precompiled package
> happy > [10 of 19] Compiling LALR [C:\\TEMP\ghc6952_0\ghc_18.lpp changed]
> aeson-pretty > Configuring aeson-pretty-0.8.8...
> happy > [11 of 19] Compiling First [C:\\TEMP\ghc6952_0\ghc_6.lpp changed]
> happy > [14 of 19] Compiling Info [C:\\TEMP\ghc6952_0\ghc_15.lpp changed]
> shake > [ 1 of 71] Compiling Development.Ninja.Env
> happy > [16 of 19] Compiling ProduceGLRCode [C:\\TEMP\ghc6952_0\ghc_31.lpp changed]
> cabal-plan > configure
> aeson-pretty > build
> shake > [ 2 of 71] Compiling Development.Ninja.Type
> aeson-pretty > Preprocessing library for aeson-pretty-0.8.8..
> aeson-pretty > Building library for aeson-pretty-0.8.8..
> aeson-pretty > [1 of 1] Compiling Data.Aeson.Encode.Pretty
> shake > [ 3 of 71] Compiling Development.Ninja.Lexer
> aeson-pretty > 
> aeson-pretty > Data\Aeson\Encode\Pretty.hs:58:1: warning: [-Wdeprecations]
> aeson-pretty > Module `Data.Aeson.Encode' is deprecated:
> aeson-pretty > Use Data.Aeson or Data.Aeson.Text instead
> aeson-pretty >  |
> aeson-pretty > 58 | import qualified Data.Aeson.Encode as Aeson
> aeson-pretty >  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> aeson-pretty > 
> aeson-pretty > Data\Aeson\Encode\Pretty.hs:175:21: warning: [-Wdeprecations]
> aeson-pretty > In the use of `encodeToTextBuilder'
> aeson-pretty > (imported from Data.Aeson.Encode):
> aeson-pretty > Deprecated: "Use Data.Aeson or Data.Aeson.Text instead"
> aeson-pretty >  |
> aeson-pretty > 175 | go v = Aeson.encodeToTextBuilder v
> aeson-pretty >  | ^^^^^^^^^^^^^^^^^^^^^^^^^
> aeson-pretty > 
> aeson-pretty > Data\Aeson\Encode\Pretty.hs:196:3: warning: [-Wdeprecations]
> aeson-pretty > In the use of `encodeToTextBuilder'
> aeson-pretty > (imported from Data.Aeson.Encode):
> aeson-pretty > Deprecated: "Use Data.Aeson or Data.Aeson.Text instead"
> aeson-pretty >  |
> aeson-pretty > 196 | Aeson.encodeToTextBuilder (toJSON k) <> pKeyValSep st <> fromValue st v
> aeson-pretty >  | ^^^^^^^^^^^^^^^^^^^^^^^^^
> aeson-pretty > 
> aeson-pretty > Data\Aeson\Encode\Pretty.hs:205:20: warning: [-Wdeprecations]
> aeson-pretty > In the use of `encodeToTextBuilder'
> aeson-pretty > (imported from Data.Aeson.Encode):
> aeson-pretty > Deprecated: "Use Data.Aeson or Data.Aeson.Text instead"
> aeson-pretty >  |
> aeson-pretty > 205 | | otherwise -> Aeson.encodeToTextBuilder $ Number x
> aeson-pretty >  | ^^^^^^^^^^^^^^^^^^^^^^^^^
> cabal-plan > Configuring cabal-plan-0.6.2.0...
> happy > [17 of 19] Compiling Target [C:\\TEMP\ghc6952_0\ghc_36.lpp changed]
> shake > [ 4 of 71] Compiling Development.Ninja.Parse
> happy > [18 of 19] Compiling ProduceCode [C:\\TEMP\ghc6952_0\ghc_28.lpp changed]
> shake > [ 5 of 71] Compiling Development.Shake.Classes
> aeson-pretty > Preprocessing executable 'aeson-pretty' for aeson-pretty-0.8.8..
> aeson-pretty > Building executable 'aeson-pretty' for aeson-pretty-0.8.8..
> shake > [ 6 of 71] Compiling Development.Shake.FilePath
> aeson-pretty > [1 of 2] Compiling Paths_aeson_pretty
> shake > [ 7 of 71] Compiling Development.Shake.Internal.CmdOption
> aeson-pretty > [2 of 2] Compiling Main
> cabal-plan > build
> cabal-plan > Preprocessing library for cabal-plan-0.6.2.0..
> cabal-plan > Building library for cabal-plan-0.6.2.0..
> cabal-plan > [1 of 1] Compiling Cabal.Plan
> shake > [ 8 of 71] Compiling Development.Shake.Internal.History.Bloom
> shake > [ 9 of 71] Compiling Development.Shake.Internal.History.Network
> aeson-pretty > Linking .stack-work\dist\e626a42b\build\aeson-pretty\aeson-pretty.exe ...
> shake > [10 of 71] Compiling Development.Shake.Internal.History.Types
> shake > [11 of 71] Compiling General.Bilist
> shake > [12 of 71] Compiling General.Binary
> shake > [13 of 71] Compiling Development.Shake.Internal.FileName
> shake > [14 of 71] Compiling General.Cleanup
> shake > [15 of 71] Compiling General.EscCodes
> shake > [16 of 71] Compiling General.Extra
> shake > [17 of 71] Compiling Development.Shake.Internal.History.Symlink
> shake > [18 of 71] Compiling Development.Shake.Internal.Errors
> happy > [19 of 19] Compiling Main [C:\\TEMP\ghc6952_0\ghc_48.lpp changed]
> happy > 
> happy > src\Main.lhs:35:3: warning: [-Wunused-imports]
> happy > The import of `Foreign.Marshal.Array' is redundant
> happy > except perhaps to import instances from `Foreign.Marshal.Array'
> happy > To import instances alone, use: import Foreign.Marshal.Array()
> happy >  |
> happy > 35 | > import Foreign.Marshal.Array
> happy >  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> happy > 
> happy > src\Main.lhs:36:3: warning: [-Wunused-imports]
> happy > The import of `Foreign' is redundant
> happy > except perhaps to import instances from `Foreign'
> happy > To import instances alone, use: import Foreign()
> happy >  |
> happy > 36 | > import Foreign
> happy >  | ^^^^^^^^^^^^^^
> happy > 
> happy > src\Main.lhs:37:3: warning: [-Wunused-imports]
> happy > The import of `Foreign.C' is redundant
> happy > except perhaps to import instances from `Foreign.C'
> happy > To import instances alone, use: import Foreign.C()
> happy >  |
> happy > 37 | > import Foreign.C
> happy >  | ^^^^^^^^^^^^^^^^
> shake > [19 of 71] Compiling Development.Shake.Internal.Value
> shake > [20 of 71] Compiling Development.Shake.Internal.FilePattern
> happy > Linking .stack-work\dist\e626a42b\build\happy\happy.exe ...
> aeson-pretty > 
> aeson-pretty > copy/register
> aeson-pretty > Installing library in C:\sr\snapshots\5abeca39\lib\x86_64-windows-ghc-8.6.5\aeson-pretty-0.8.8-BHaqfkcOaexEqFi3LBKm4h
> aeson-pretty > Installing executable aeson-pretty in C:\sr\snapshots\5abeca39\bin
> shake > [21 of 71] Compiling Development.Shake.Internal.Options
> aeson-pretty > Registering library for aeson-pretty-0.8.8..
> cabal-plan > Preprocessing executable 'cabal-plan' for cabal-plan-0.6.2.0..
> cabal-plan > Building executable 'cabal-plan' for cabal-plan-0.6.2.0..
> vector-algorithms > using precompiled package
> cabal-plan > [1 of 5] Compiling Flag
> mono-traversable > using precompiled package
> cabal-plan > [2 of 5] Compiling LicenseReport
> happy > 
> happy > copy/register
> conduit > using precompiled package
> cabal-plan > [3 of 5] Compiling Paths_cabal_plan
> happy > Installing executable happy in C:\sr\snapshots\5abeca39\bin
> cabal-plan > [4 of 5] Compiling ProcessLazyByteString
> cabal-plan > [5 of 5] Compiling Main
> shake > [22 of 71] Compiling Development.Shake.Internal.FileInfo
> ghc-lib-parser > using precompiled package
> shake > [23 of 71] Compiling Development.Shake.Internal.Core.Monad
> conduit-parse > using precompiled package
> haskell-src-exts > using precompiled package
> shake > [24 of 71] Compiling General.Fence
> libyaml > using precompiled package
> shake > [25 of 71] Compiling General.FileLock
> shake > [26 of 71] Compiling General.GetOpt
> floskell > configure
> lsp-test > using precompiled package
> shake > [27 of 71] Compiling General.Intern
> shake > [28 of 71] Compiling General.Ids
> shake > [29 of 71] Compiling Development.Shake.Internal.History.Serialise
> shake > [30 of 71] Compiling Development.Shake.Internal.History.Server
> shake > [31 of 71] Compiling Development.Shake.Internal.Core.Database
> shake > [32 of 71] Compiling General.ListBuilder
> shake > [33 of 71] Compiling General.Makefile
> floskell > Configuring floskell-0.10.2...
> shake > [34 of 71] Compiling General.Process
> shake > [35 of 71] Compiling General.Thread
> shake > [36 of 71] Compiling General.Chunks
> floskell > build
> ormolu > configure
> floskell > Preprocessing library for floskell-0.10.2..
> floskell > Building library for floskell-0.10.2..
> shake > [37 of 71] Compiling General.Timing
> shake > [38 of 71] Compiling General.Pool
> floskell > [ 1 of 12] Compiling Floskell.Attoparsec
> floskell > [ 2 of 12] Compiling Floskell.Buffer
> shake > [39 of 71] Compiling Development.Shake.Internal.Core.Storage
> floskell > [ 3 of 12] Compiling Floskell.Config
> ormolu > Configuring ormolu-0.0.5.0...
> shake > [40 of 71] Compiling General.TypeMap
> shake > [41 of 71] Compiling General.Wait
> ormolu > build
> shake > [42 of 71] Compiling Development.Shake.Internal.History.Shared
> ormolu > Preprocessing library for ormolu-0.0.5.0..
> ormolu > Building library for ormolu-0.0.5.0..
> ormolu > [ 1 of 46] Compiling GHC
> shake > [43 of 71] Compiling Development.Shake.Internal.History.Cloud
> ormolu > [ 2 of 46] Compiling GHC.DynFlags
> shake > [44 of 71] Compiling Development.Shake.Internal.Core.Types
> ormolu > [ 3 of 46] Compiling Ormolu.Config
> ormolu > [ 4 of 46] Compiling Ormolu.Parser.Anns
> ormolu > [ 5 of 46] Compiling Ormolu.Parser.Pragma
> ormolu > [ 6 of 46] Compiling Ormolu.Parser.Shebang
> shake > [45 of 71] Compiling Development.Shake.Internal.Core.Rules
> ormolu > [ 7 of 46] Compiling Ormolu.Printer.SpanStream
> cabal-plan > Linking .stack-work\dist\e626a42b\build\cabal-plan\cabal-plan.exe ...
> ormolu > [ 8 of 46] Compiling Ormolu.Processing.Common
> ormolu > [ 9 of 46] Compiling Ormolu.Processing.Cpp
> ormolu > [10 of 46] Compiling Ormolu.Processing.Postprocess
> ormolu > [11 of 46] Compiling Ormolu.Processing.Preprocess
> ormolu > [12 of 46] Compiling Ormolu.Utils
> shake > [46 of 71] Compiling Development.Shake.Internal.Core.Pool
> shake > [47 of 71] Compiling Development.Shake.Internal.Core.Action
> ormolu > [13 of 46] Compiling Ormolu.Printer.Operators
> ormolu > [14 of 46] Compiling Ormolu.Parser.CommentStream
> ormolu > [15 of 46] Compiling Ormolu.Printer.Internal
> shake > [48 of 71] Compiling Development.Shake.Internal.Resource
> shake > [49 of 71] Compiling Development.Shake.Internal.Core.Build
> shake > [50 of 71] Compiling Development.Shake.Internal.Rules.Rerun
> shake > [51 of 71] Compiling Development.Shake.Internal.Rules.Oracle
> shake > [52 of 71] Compiling Development.Shake.Internal.Rules.File
> cabal-plan > copy/register
> cabal-plan > Installing library in C:\sr\snapshots\5abeca39\lib\x86_64-windows-ghc-8.6.5\cabal-plan-0.6.2.0-6jNNKB1mrLq6dF5Ru6ZQaO
> cabal-plan > Installing executable cabal-plan in C:\sr\snapshots\5abeca39\bin
> shake > [53 of 71] Compiling Development.Shake.Internal.Rules.OrderOnly
> ormolu > [16 of 46] Compiling Ormolu.Printer.Comments
> shake > [54 of 71] Compiling Development.Shake.Internal.Rules.Files
> ormolu > [17 of 46] Compiling Ormolu.Printer.Combinators
> cabal-plan > Registering library for cabal-plan-0.6.2.0..
> ormolu > [18 of 46] Compiling Ormolu.Printer.Meat.Pragma
> shake > [55 of 71] Compiling Development.Shake.Internal.Derived
> cabal-helper > using precompiled package
> ormolu > [19 of 46] Compiling Ormolu.Printer.Meat.Declaration.Value[boot]
> ormolu > [20 of 46] Compiling Ormolu.Printer.Meat.Common
> yaml > using precompiled package
> shake > [56 of 71] Compiling Development.Shake.Command
> brittany > configure
> brittany > Configuring brittany-0.12.1.1...
> shake > [57 of 71] Compiling Development.Shake.Internal.Rules.Directory
> ormolu > [21 of 46] Compiling Ormolu.Printer.Meat.Type
> ormolu > [22 of 46] Compiling Ormolu.Printer.Meat.Declaration.Default
> ormolu > [23 of 46] Compiling Ormolu.Printer.Meat.ImportExport
> shake > [58 of 71] Compiling Development.Shake.Internal.Rules.Default
> shake > [59 of 71] Compiling Paths_shake
> shake > [60 of 71] Compiling Development.Shake.Internal.Paths
> brittany > build
> ormolu > [24 of 46] Compiling Ormolu.Printer.Meat.Declaration.Warning
> ormolu > [25 of 46] Compiling Ormolu.Printer.Meat.Declaration.TypeFamily
> brittany > Preprocessing library for brittany-0.12.1.1..
> brittany > Building library for brittany-0.12.1.1..
> ormolu > [26 of 46] Compiling Ormolu.Printer.Meat.Declaration.Type
> shake > [61 of 71] Compiling General.Template
> ormolu > [27 of 46] Compiling Ormolu.Printer.Meat.Declaration.Signature
> shake > [62 of 71] Compiling Development.Shake.Internal.Progress
> ormolu > [28 of 46] Compiling Ormolu.Printer.Meat.Declaration.RoleAnnotation
> ormolu > [29 of 46] Compiling Ormolu.Printer.Meat.Declaration.Foreign
> ormolu > [30 of 46] Compiling Ormolu.Printer.Meat.Declaration.Data
> shake > [63 of 71] Compiling Development.Shake.Internal.CompactUI
> shake > [64 of 71] Compiling Development.Shake.Internal.Profile
> ormolu > [31 of 46] Compiling Ormolu.Printer.Meat.Declaration[boot]
> ormolu > [32 of 46] Compiling Ormolu.Printer.Meat.Declaration.Value
> shake > [65 of 71] Compiling Development.Shake.Internal.Core.Run
> shake > [66 of 71] Compiling Development.Shake.Database
> shake > [67 of 71] Compiling Development.Shake.Internal.Demo
> shake > [68 of 71] Compiling Development.Shake.Internal.Args
> brittany > [ 1 of 30] Compiling Language.Haskell.Brittany.Internal.Prelude
> floskell > [ 4 of 12] Compiling Floskell.Fixities
> ormolu > [33 of 46] Compiling Ormolu.Printer.Meat.Declaration.Splice
> shake > [69 of 71] Compiling Development.Shake
> brittany > [ 2 of 30] Compiling Language.Haskell.Brittany.Internal.PreludeUtils
> ormolu > [34 of 46] Compiling Ormolu.Printer.Meat.Declaration.Rule
> shake > [70 of 71] Compiling Development.Ninja.All
> floskell > [ 5 of 12] Compiling Floskell.Imports
> ormolu > [35 of 46] Compiling Ormolu.Printer.Meat.Declaration.Annotation
> brittany > [ 3 of 30] Compiling Language.Haskell.Brittany.Internal.Obfuscation
> ormolu > [36 of 46] Compiling Ormolu.Printer.Meat.Declaration.Instance
> floskell > [ 6 of 12] Compiling Floskell.Styles
> ormolu > [37 of 46] Compiling Ormolu.Printer.Meat.Declaration.Class
> brittany > [ 4 of 30] Compiling Language.Haskell.Brittany.Internal.Config.Types
> floskell > [ 7 of 12] Compiling Floskell.ConfigFile
> ormolu > [38 of 46] Compiling Ormolu.Printer.Meat.Declaration
> shake > [71 of 71] Compiling Run
> ormolu > [39 of 46] Compiling Ormolu.Parser.Result
> floskell > [ 8 of 12] Compiling Floskell.Types
> ormolu > [40 of 46] Compiling Ormolu.Imports
> ormolu > [41 of 46] Compiling Ormolu.Printer.Meat.Module
> ormolu > [42 of 46] Compiling Ormolu.Printer
> floskell > [ 9 of 12] Compiling Floskell.Printers
> ormolu > [43 of 46] Compiling Ormolu.Exception
> ormolu > [44 of 46] Compiling Ormolu.Parser
> floskell > [10 of 12] Compiling Floskell.Pretty
> ormolu > [45 of 46] Compiling Ormolu.Diff
> ormolu > [46 of 46] Compiling Ormolu
> ormolu > Preprocessing executable 'ormolu' for ormolu-0.0.5.0..
> ormolu > Building executable 'ormolu' for ormolu-0.0.5.0..
> ormolu > [1 of 2] Compiling Paths_ormolu
> ormolu > [2 of 2] Compiling Main
> shake > Linking .stack-work\dist\e626a42b\build\shake\shake.exe ...
> ormolu > Linking .stack-work\dist\e626a42b\build\ormolu\ormolu.exe ...
> brittany > [ 5 of 30] Compiling Language.Haskell.Brittany.Internal.Config.Types.Instances
> brittany > [ 6 of 30] Compiling Language.Haskell.Brittany.Internal.Types
> shake > Preprocessing library for shake-0.19..
> shake > Building library for shake-0.19..
> brittany > [ 7 of 30] Compiling Language.Haskell.Brittany.Internal.Utils
> ormolu > copy/register
> brittany > [ 8 of 30] Compiling Language.Haskell.Brittany.Internal.Transformations.Par
> brittany > [ 9 of 30] Compiling Language.Haskell.Brittany.Internal.Transformations.Indent
> brittany > [10 of 30] Compiling Language.Haskell.Brittany.Internal.Transformations.Floating
> shake > [ 1 of 73] Compiling Development.Ninja.Env
> brittany > [11 of 30] Compiling Language.Haskell.Brittany.Internal.Transformations.Columns
> shake > [ 2 of 73] Compiling Development.Ninja.Type
> brittany > [12 of 30] Compiling Language.Haskell.Brittany.Internal.Transformations.Alt
> shake > [ 3 of 73] Compiling Development.Ninja.Lexer
> floskell > [11 of 12] Compiling Floskell.Comments
> ormolu > Installing library in C:\sr\snapshots\5abeca39\lib\x86_64-windows-ghc-8.6.5\ormolu-0.0.5.0-6zbnnxQhniLETAdDWWMYmq
> ormolu > Installing executable ormolu in C:\sr\snapshots\5abeca39\bin
> shake > [ 4 of 73] Compiling Development.Ninja.Parse
> shake > [ 5 of 73] Compiling Development.Shake.Classes
> shake > [ 6 of 73] Compiling Development.Shake.FilePath
> floskell > [12 of 12] Compiling Floskell
> floskell > 
> floskell > src\Floskell.hs:31:1: warning: [-Wunused-imports]
> floskell > The import of `Data.Monoid' is redundant
> floskell > except perhaps to import instances from `Data.Monoid'
> floskell > To import instances alone, use: import Data.Monoid()
> floskell >  |
> floskell > 31 | import Data.Monoid
> floskell >  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> shake > [ 7 of 73] Compiling Development.Shake.Internal.CmdOption
> shake > [ 8 of 73] Compiling Development.Shake.Internal.History.Bloom
> brittany > [13 of 30] Compiling Language.Haskell.Brittany.Internal.ExactPrintUtils
> shake > [ 9 of 73] Compiling Development.Shake.Internal.History.Network
> shake > [10 of 73] Compiling Development.Shake.Internal.History.Types
> floskell > Preprocessing executable 'floskell' for floskell-0.10.2..
> floskell > Building executable 'floskell' for floskell-0.10.2..
> shake > [11 of 73] Compiling General.Bilist
> shake > [12 of 73] Compiling General.Binary
> floskell > [1 of 2] Compiling Paths_floskell
> floskell > [2 of 2] Compiling Main
> ormolu > Registering library for ormolu-0.0.5.0..
> shake > [13 of 73] Compiling Development.Shake.Internal.FileName
> zlib > using precompiled package
> shake > [14 of 73] Compiling General.Cleanup
> streaming-commons > using precompiled package
> shake > [15 of 73] Compiling General.EscCodes
> floskell > Linking .stack-work\dist\e626a42b\build\floskell\floskell.exe ...
> conduit-extra > using precompiled package
> brittany > [14 of 30] Compiling Language.Haskell.Brittany.Internal.LayouterBasics
> shake > [16 of 73] Compiling General.Extra
> hie-bios > configure
> shake > [17 of 73] Compiling Development.Shake.Internal.History.Symlink
> shake > [18 of 73] Compiling Development.Shake.Internal.Errors
> shake > [19 of 73] Compiling Development.Shake.Internal.Value
> shake > [20 of 73] Compiling Development.Shake.Internal.FilePattern
> shake > [21 of 73] Compiling Development.Shake.Internal.Options
> brittany > [15 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Type
> hie-bios > Configuring hie-bios-0.5.0...
> hie-bios > build
> hie-bios > Preprocessing library for hie-bios-0.5.0..
> hie-bios > Building library for hie-bios-0.5.0..
> brittany > [16 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Stmt[boot]
> brittany > [17 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.IE
> hie-bios > [ 1 of 16] Compiling HIE.Bios.Config
> brittany > [18 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Import
> shake > [22 of 73] Compiling Development.Shake.Internal.FileInfo
> floskell > 
> floskell > copy/register
> hie-bios > [ 2 of 16] Compiling HIE.Bios.Ghc.Gap
> shake > [23 of 73] Compiling Development.Shake.Internal.Core.Monad
> floskell > Installing library in C:\sr\snapshots\5abeca39\lib\x86_64-windows-ghc-8.6.5\floskell-0.10.2-GukPAsNJ1G5Vrjw1IFuw7
> floskell > Installing executable floskell in C:\sr\snapshots\5abeca39\bin
> shake > [24 of 73] Compiling General.Fence
> brittany > [19 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Module
> shake > [25 of 73] Compiling General.FileLock
> hie-bios > [ 3 of 16] Compiling HIE.Bios.Ghc.Doc
> shake > [26 of 73] Compiling General.GetOpt
> hie-bios > [ 4 of 16] Compiling HIE.Bios.Internal.Log
> brittany > [20 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Expr[boot]
> brittany > [21 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Pattern
> hie-bios > [ 5 of 16] Compiling HIE.Bios.Ghc.Load
> shake > [27 of 73] Compiling General.Intern
> shake > [28 of 73] Compiling General.Ids
> hie-bios > [ 6 of 16] Compiling HIE.Bios.Types
> shake > [29 of 73] Compiling Development.Shake.Internal.History.Serialise
> hie-bios > [ 7 of 16] Compiling HIE.Bios.Flags
> hie-bios > [ 8 of 16] Compiling HIE.Bios.Environment
> brittany > [22 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Decl
> shake > [30 of 73] Compiling Development.Shake.Internal.History.Server
> floskell > Registering library for floskell-0.10.2..
> shake > [31 of 73] Compiling Development.Shake.Internal.Core.Database
> shake > [32 of 73] Compiling General.ListBuilder
> hie-bios > [ 9 of 16] Compiling HIE.Bios.Ghc.Api
> shake > [33 of 73] Compiling General.Makefile
> hie-bios > [10 of 16] Compiling HIE.Bios.Ghc.Logger
> shake > [34 of 73] Compiling General.Process
> hie-bios > [11 of 16] Compiling HIE.Bios.Ghc.Check
> hie-bios > [12 of 16] Compiling HIE.Bios.Wrappers
> shake > [35 of 73] Compiling General.Thread
> shake > [36 of 73] Compiling General.Chunks
> shake > [37 of 73] Compiling General.Timing
> shake > [38 of 73] Compiling General.Pool
> hie-bios > [13 of 16] Compiling HIE.Bios.Cradle
> shake > [39 of 73] Compiling Development.Shake.Internal.Core.Storage
> hie-bios > 
> hie-bios > src\HIE\Bios\Cradle.hs:664:25: warning: [-Wname-shadowing]
> hie-bios > This binding for `env' shadows the existing binding
> hie-bios > imported from `Data.Conduit.Process' at src\HIE\Bios\Cradle.hs:47:1-27
> hie-bios > (and originally defined in `process-1.6.5.0:System.Process.Common')
> hie-bios >  |
> hie-bios > 664 | withHieBiosOutput env action = do
> hie-bios >  | ^^^
> hie-bios > [14 of 16] Compiling HIE.Bios.Internal.Debug
> shake > [40 of 73] Compiling General.TypeMap
> hie-bios > [15 of 16] Compiling HIE.Bios
> hie-bios > [16 of 16] Compiling Paths_hie_bios
> shake > [41 of 73] Compiling General.Wait
> brittany > [23 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Stmt
> hie-bios > Preprocessing executable 'hie-bios' for hie-bios-0.5.0..
> hie-bios > Building executable 'hie-bios' for hie-bios-0.5.0..
> shake > [42 of 73] Compiling Development.Shake.Internal.History.Shared
> hie-bios > [1 of 2] Compiling Paths_hie_bios
> brittany > [24 of 30] Compiling Language.Haskell.Brittany.Internal.Layouters.Expr
> hie-bios > [2 of 2] Compiling Main
> shake > [43 of 73] Compiling Development.Shake.Internal.History.Cloud
> shake > [44 of 73] Compiling Development.Shake.Internal.Core.Types
> hie-bios > Linking .stack-work\dist\e626a42b\build\hie-bios\hie-bios.exe ...
> shake > [45 of 73] Compiling Development.Shake.Internal.Core.Rules
> shake > [46 of 73] Compiling Development.Shake.Internal.Core.Pool
> shake > [47 of 73] Compiling Development.Shake.Internal.Core.Action
> shake > [48 of 73] Compiling Development.Shake.Internal.Resource
> shake > [49 of 73] Compiling Development.Shake.Internal.Core.Build
> shake > [50 of 73] Compiling Development.Shake.Rule
> shake > [51 of 73] Compiling Development.Shake.Internal.Rules.Rerun
> shake > [52 of 73] Compiling Development.Shake.Internal.Rules.Oracle
> shake > [53 of 73] Compiling Development.Shake.Internal.Rules.File
> brittany > [25 of 30] Compiling Language.Haskell.Brittany.Internal.Config
> brittany > [26 of 30] Compiling Language.Haskell.Brittany.Internal.BackendUtils
> brittany > [27 of 30] Compiling Language.Haskell.Brittany.Internal.Backend
> shake > [54 of 73] Compiling Development.Shake.Internal.Rules.OrderOnly
> shake > [55 of 73] Compiling Development.Shake.Internal.Rules.Files
> shake > [56 of 73] Compiling Development.Shake.Internal.Derived
> hie-bios > 
> hie-bios > copy/register
> shake > [57 of 73] Compiling Development.Shake.Command
> brittany > [28 of 30] Compiling Language.Haskell.Brittany.Internal
> hie-bios > Installing library in C:\sr\snapshots\5abeca39\lib\x86_64-windows-ghc-8.6.5\hie-bios-0.5.0-5VZcc8LU1z2GHE3wORzrDN
> hie-bios > Installing executable hie-bios in C:\sr\snapshots\5abeca39\bin
> brittany > [29 of 30] Compiling Language.Haskell.Brittany
> brittany > [30 of 30] Compiling Paths_brittany
> shake > [58 of 73] Compiling Development.Shake.Internal.Rules.Directory
> shake > [59 of 73] Compiling Development.Shake.Internal.Rules.Default
> shake > [60 of 73] Compiling Paths_shake
> hie-bios > Registering library for hie-bios-0.5.0..
> brittany > Preprocessing executable 'brittany' for brittany-0.12.1.1..
> brittany > Building executable 'brittany' for brittany-0.12.1.1..
> shake > [61 of 73] Compiling Development.Shake.Internal.Paths
> shake > [62 of 73] Compiling General.Template
> brittany > [1 of 2] Compiling Paths_brittany
> shake > [63 of 73] Compiling Development.Shake.Internal.Progress
> brittany > [2 of 2] Compiling Main
> shake > [64 of 73] Compiling Development.Shake.Internal.CompactUI
> shake > [65 of 73] Compiling Development.Shake.Internal.Profile
> shake > [66 of 73] Compiling Development.Shake.Internal.Core.Run
> brittany > Linking .stack-work\dist\e626a42b\build\brittany\brittany.exe ...
> shake > [67 of 73] Compiling Development.Shake.Database
> shake > [68 of 73] Compiling Development.Shake.Internal.Demo
> shake > [69 of 73] Compiling Development.Shake.Internal.Args
> shake > [70 of 73] Compiling Development.Shake
> shake > [71 of 73] Compiling Development.Shake.Util
> shake > [72 of 73] Compiling Development.Shake.Forward
> shake > [73 of 73] Compiling Development.Shake.Config
> shake > copy/register
> shake > Installing executable shake in C:\sr\snapshots\5abeca39\bin
> shake > Installing library in C:\sr\snapshots\5abeca39\lib\x86_64-windows-ghc-8.6.5\shake-0.19-F4KIhMxli1gEdS9eVwdqx3
> shake > Registering library for shake-0.19..
> ghcide > configure (lib + exe)
> brittany > copy/register
> brittany > Installing library in C:\sr\snapshots\5abeca39\lib\x86_64-windows-ghc-8.6.5\brittany-0.12.1.1-KTCubNOS0OhCSjM62MmNy1
> brittany > Installing executable brittany in C:\sr\snapshots\5abeca39\bin
> ghcide > Configuring ghcide-0.1.0...
> ghcide > build (lib + exe)
> ghcide > Preprocessing executable 'ghcide-test-preprocessor' for ghcide-0.1.0..
> ghcide > Building executable 'ghcide-test-preprocessor' for ghcide-0.1.0..
> ghcide > Preprocessing library for ghcide-0.1.0..
> ghcide > Building library for ghcide-0.1.0..
> brittany > Registering library for brittany-0.12.1.1..
> ghcide > Preprocessing executable 'ghcide' for ghcide-0.1.0..
> ghcide > Building executable 'ghcide' for ghcide-0.1.0..
> ghcide > [3 of 4] Compiling Paths_ghcide
> ghcide > [4 of 4] Compiling Main [TH]
> ghcide > 
> ghcide > exe\Main.hs:56:1: warning: [-Wunused-imports]
> ghcide > The import of `Development.GitRev' is redundant
> ghcide > except perhaps to import instances from `Development.GitRev'
> ghcide > To import instances alone, use: import Development.GitRev()
> ghcide >  |
> ghcide > 56 | import Development.GitRev
> ghcide >  | ^^^^^^^^^^^^^^^^^^^^^^^^^
> ghcide > 
> ghcide > exe\Main.hs:57:1: warning: [-Wunused-imports]
> ghcide > The import of `action' from module `Development.Shake' is redundant
> ghcide >  |
> ghcide > 57 | import Development.Shake (Action, action)
> ghcide >  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> ghcide > 
> ghcide > exe\Main.hs:83:1: warning: [-Wunused-imports]
> ghcide > The import of `Debug.Trace' is redundant
> ghcide > except perhaps to import instances from `Debug.Trace'
> ghcide > To import instances alone, use: import Debug.Trace()
> ghcide >  |
> ghcide > 83 | import Debug.Trace
> ghcide >  | ^^^^^^^^^^^^^^^^^^
> ghcide > Linking .stack-work\dist\e626a42b\build\ghcide\ghcide.exe ...
> ghcide > 
> ghcide > copy/register
> ghcide > Installing executable ghcide-test-preprocessor in D:\dev\ws\haskell\hls\.stack-work\install\15d153f3\bin
> ghcide > Installing library in D:\dev\ws\haskell\hls\.stack-work\install\15d153f3\lib\x86_64-windows-ghc-8.6.5\ghcide-0.1.0-KhREzo7jDNU4tRViaOnMFo
> ghcide > Installing executable ghcide in D:\dev\ws\haskell\hls\.stack-work\install\15d153f3\bin
> ghcide > Registering library for ghcide-0.1.0..
> haskell-language-server > configure (lib + internal-lib + exe)
> Configuring haskell-language-server-0.1.0.0...
> haskell-language-server > initial-build-steps (lib + internal-lib + exe)
> Completed 165 action(s).
> The following GHC options are incompatible with GHCi and have not been passed to it: -threaded
> Configuring GHCi with the following packages: haskell-language-server
> D:\dev\ws\haskell\hls\.stack-work\install\15d153f3\pkgdb;C:\sr\snapshots\5abeca39\pkgdb;D:\bin\stack\x86_64-windows\ghc-8.6.5\lib\package.conf.d
Right (ComponentOptions {componentOptions = ["-i","-odir=D:\\dev\\ws\\haskell\\hls\\.stack-work\\odir","-hidir=D:\\dev\\ws\\haskell\\hls\\.stack-work\\odir","-hide-all-packages","-iD:\\dev\\ws\\haskell\\hls\\.stack-work\\dist\\e626a42b\\build\\haskell-language-server","-iD:\\dev\\ws\\haskell\\hls\\exe","-iD:\\dev\\ws\\haskell\\hls\\.stack-work\\dist\\e626a42b\\build\\haskell-language-server\\autogen","-iD:\\dev\\ws\\haskell\\hls\\.stack-work\\dist\\e626a42b\\build\\global-autogen","-iD:\\dev\\ws\\haskell\\hls\\.stack-work\\dist\\e626a42b\\build\\haskell-language-server\\haskell-language-server-tmp","-stubdir=D:\\dev\\ws\\haskell\\hls\\.stack-work\\dist\\e626a42b\\build","-ID:\\bin\\stack\\x86_64-windows\\msys2-20180531\\mingw64\\include","-LD:\\bin\\stack\\x86_64-windows\\msys2-20180531\\mingw64\\lib","-LD:\\bin\\stack\\x86_64-windows\\msys2-20180531\\mingw64\\bin","-package=z-haskell-language-server-z-hls-test-utils","-package-id=base-4.12.0.0","-package-id=aeson-1.4.6.0-DsrnuPFXLAlILCFBQ2AzgE","-package-id=async-2.2.2-EbxQ7tk0OFk9dJNMtaidSf","-package-id=base16-bytestring-0.1.1.6-17atVnUhDnM13pAkKbwL6I","-package-id=binary-0.8.6.0","-package-id=bytestring-0.10.8.2","-package-id=cryptohash-sha1-0.11.100.1-FedZHhK3zTs7eOQXIrPeso","-package-id=containers-0.6.0.1","-package-id=data-default-0.7.1.1-COovZVyOTYqEavTGLlfqy8","-package-id=deepseq-1.4.4.0","-package-id=directory-1.3.3.0","-package-id=extra-1.7.1-PSuBSigoW23dwesYtnXfZ","-package-id=filepath-1.4.2.1","-package-id=ghc-8.6.5","-package-id=ghc-check-0.3.0.1-4A801B9g1biEE5sFqd62dN","-package-id=ghc-paths-0.1.0.12-8MhNqRZlSJXAzmVO0F6ybT","-package-id=ghcide-0.1.0-KhREzo7jDNU4tRViaOnMFo","-package-id=gitrev-1.3.1-7TThbNd1bbyEHouSCbophD","-package-id=hashable-1.2.7.0-2SI038axTEd7AEZJ275kpi","-package-id=haskell-lsp-0.22.0.0-3piifcNOUrW3byFYhRQLQo","-package-id=hie-bios-0.5.0-5VZcc8LU1z2GHE3wORzrDN","-package=haskell-language-server-0.1.0.0","-package-id=hslogger-1.2.12-IV3VyzKmB3vIKqKHt4daAX","-package-id=optparse-applicative-0.15.1.0-FihWsyor2QQHorNvaQqP8c","-package-id=shake-0.19-F4KIhMxli1gEdS9eVwdqx3","-package-id=text-1.2.3.1","-package-id=time-1.8.0.2","-package-id=unordered-containers-0.2.10.0-LgoTL3wbBEY5bZIDJiyxW4","-Wall","-Wno-name-shadowing","-Wredundant-constraints","-rtsopts","-with-rtsopts=-I0 -qg -A128M","-DAGPL","-optP-include","-optPD:\\dev\\ws\\haskell\\hls\\.stack-work\\ghci\\3c86ed7a\\cabal_macros.h","-ghci-script=C:\\TEMP\\haskell-stack-ghci\\556c9616\\ghci-script","-package-db","D:\\dev\\ws\\haskell\\hls\\.stack-work\\install\\15d153f3\\pkgdb","-package-db","C:\\sr\\snapshots\\5abeca39\\pkgdb","-package-db","D:\\bin\\stack\\x86_64-windows\\ghc-8.6.5\\lib\\package.conf.d"], componentRoot = "D:\\dev\\ws\\haskell\\hls", componentDependencies = ["haskell-language-server.cabal","package.yaml","stack.yaml"]})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment