Skip to content

Commit

Permalink
Use stan config files for stan plugin (#3904)
Browse files Browse the repository at this point in the history
  • Loading branch information
@0rphee
0rphee committed Dec 22, 2023
1 parent 74466a9 commit 8bbc2b7
Show file tree
Hide file tree
Showing 2 changed files with 77 additions and 19 deletions.
2 changes: 2 additions & 0 deletions plugins/hls-stan-plugin/hls-stan-plugin.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,8 @@ library
, transformers
, unordered-containers
, stan >= 0.1.1.0
, trial
, directory

default-language: Haskell2010
default-extensions:
Expand Down
94 changes: 75 additions & 19 deletions plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs
View file
Original file line number Diff line number Diff line change
@@ -1,19 +1,20 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternSynonyms #-}
module Ide.Plugin.Stan (descriptor, Log) where

import Compat.HieTypes (HieASTs, HieFile)
import Control.DeepSeq (NFData)
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Compat.HieTypes (HieASTs, HieFile (..))
import Control.DeepSeq (NFData)
import Control.Monad (void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Data.Default
import Data.Foldable (toList)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as Map
import Data.Maybe (fromJust, mapMaybe)
import qualified Data.Text as T
import Data.Foldable (toList)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as Map
import Data.Maybe (fromJust, mapMaybe,
maybeToList)
import qualified Data.Text as T
import Development.IDE
import Development.IDE (Diagnostic (_codeDescription))
import Development.IDE.Core.Rules (getHieFile,
Expand All @@ -26,7 +27,7 @@ import Development.IDE.GHC.Compat (HieASTs (HieASTs),
runHsc, srcSpanEndCol,
srcSpanEndLine,
srcSpanStartCol,
srcSpanStartLine, tcg_exports)
srcSpanStartLine, tcg_exports, HieFile (hie_hs_file))
import Development.IDE.GHC.Error (realSrcSpanToRange)
import GHC.Generics (Generic)
import Ide.Plugin.Config
Expand All @@ -36,12 +37,20 @@ import Ide.Types (PluginDescriptor (..),
defaultPluginDescriptor,
pluginEnabledConfig)
import qualified Language.LSP.Protocol.Types as LSP
import Stan (getStanConfig, createCabalExtensionsMap)
import Stan.Analysis (Analysis (..), runAnalysis)
import Stan.Category (Category (..))
import Stan.Core.Id (Id (..))
import Stan.Inspection (Inspection (..))
import Stan.Inspection.All (inspectionsIds, inspectionsMap)
import Stan.Observation (Observation (..))
import System.Directory (makeRelativeToCurrentDirectory)
import Stan.Cli (StanArgs (..))
import Trial (whenResult, fiasco, pattern FiascoL, pattern ResultL, Fatality, Trial, TaggedTrial)
import Stan.Report.Settings (ToggleSolution(..), Verbosity (..), OutputSettings (..))
import Stan.Config (defaultConfig, ConfigP (..), applyConfig, Config)
import Stan.EnvVars (EnvVars(..))
import Data.HashSet (HashSet)

descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId = (defaultPluginDescriptor plId desc)
Expand All @@ -53,11 +62,21 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc)
where
desc = "Provides stan diagnostics. Built with stan-" <> VERSION_stan

newtype Log = LogShake Shake.Log deriving (Show)
data Log = LogShake !Shake.Log
| LogWarnConf ![(Fatality, T.Text)]
| LogDebugStanConfigResult !(Trial T.Text Stan.Config.Config)
| LogDebugStanEnvVars !(TaggedTrial T.Text Bool)
| LogDebugStanCheckMap !(HM.HashMap FilePath (HashSet (Id Inspection)))
deriving (Show)

instance Pretty Log where
pretty = \case
LogShake log -> pretty log
LogWarnConf errs -> "Fiasco encountered when trying to load stan configuration. Using default inspections:"
<> line <> (pretty $ show errs)
LogDebugStanConfigResult t -> "Config result: " <> (pretty $ show t)
LogDebugStanEnvVars t -> "Env vars: " <> (pretty $ show t)
LogDebugStanCheckMap hm -> "Map of checks per file: " <> (pretty $ show hm)

data GetStanDiagnostics = GetStanDiagnostics
deriving (Eq, Show, Generic)
Expand All @@ -72,15 +91,52 @@ rules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
rules recorder plId = do
define (cmapWithPrio LogShake recorder) $
\GetStanDiagnostics file -> do
config <- getPluginConfigAction plId
if pluginEnabledConfig plcDiagnosticsOn config then do
plugConfig <- getPluginConfigAction plId
if pluginEnabledConfig plcDiagnosticsOn plugConfig then do
maybeHie <- getHieFile file
case maybeHie of
Nothing -> return ([], Nothing)
Just hie -> do
let enabledInspections = HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)]
-- This should use Cabal config for extensions and Stan config for inspection preferences is the future
let analysis = runAnalysis Map.empty enabledInspections [] [hie]
let isLoud = False -- in Stan: notJson = not isLoud
let stanArgs =
StanArgs
{ stanArgsHiedir = "" -- :: !FilePath -- ^ Directory with HIE files
, stanArgsCabalFilePath = [] -- :: ![FilePath] -- ^ Path to @.cabal@ files.
, stanArgsOutputSettings = OutputSettings NonVerbose ShowSolution -- :: !OutputSettings -- ^ Settings for output terminal report
-- doesnt matter, because it is silenced by isLoud
, stanArgsReport = Nothing -- :: !(Maybe ReportArgs) -- ^ @HTML@ report settings
, stanArgsUseDefaultConfigFile = fiasco "" -- :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file
, stanArgsConfigFile = Nothing -- :: !(Maybe FilePath) -- ^ Path to a custom configurations file.
, stanArgsConfig = ConfigP {configChecks = fiasco "",
configRemoved = fiasco "",
configIgnored = fiasco ""} -- :: !PartialConfig
-- if they are not fiascos, .stan.toml's aren't taken into account
,stanArgsJsonOut = not isLoud -- :: !Bool -- ^ Output the machine-readable output in JSON format instead.
}

(configTrial, useDefConfig, env) <- liftIO $ getStanConfig stanArgs isLoud
logWith recorder Debug (LogDebugStanConfigResult configTrial)
logWith recorder Debug (LogDebugStanEnvVars $ envVarsUseDefaultConfigFile env)

(cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of
FiascoL es -> do
logWith recorder Warning (LogWarnConf es)
pure (Map.empty,
HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)],
[])
ResultL warnings stanConfig -> do
let currentHSAbs = fromNormalizedFilePath file -- hie_hs_file hie
currentHSRel <- liftIO $ makeRelativeToCurrentDirectory currentHSAbs
cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hie]

-- Files (keys) in checksMap need to have an absolute path for the analysis, but applyConfig needs to receive relative
-- filepaths to apply the config, because the toml config has relative paths. Stan itself seems to work only in terms of relative paths.
let checksMap = HM.mapKeys (const currentHSAbs) $ applyConfig [currentHSRel] stanConfig
logWith recorder Debug (LogDebugStanCheckMap checksMap)

let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored stanConfig) [hie]
pure (cabalExtensionsMap, checksMap, configIgnored stanConfig)
let analysis = runAnalysis cabalExtensionsMap checksMap confIgnored [hie]
return (analysisToDiagnostics file analysis, Just ())
else return ([], Nothing)

Expand Down

0 comments on commit 8bbc2b7

Please sign in to comment.