{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Ide.Plugin.Cabal (descriptor, Log(..)) where
import Control.Concurrent.STM
import Control.Concurrent.Strict
import Control.DeepSeq
import Control.Monad.Extra
import Control.Monad.IO.Class
import qualified Data.ByteString as BS
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List.NonEmpty as NE
import qualified Data.Text.Encoding as Encoding
import Data.Typeable
import Development.IDE as D
import Development.IDE.Core.Shake (restartShakeSession)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.Graph (alwaysRerun)
import GHC.Generics
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
import qualified Ide.Plugin.Cabal.Parse as Parse
import Ide.Plugin.Config (Config)
import Ide.Types
import Language.LSP.Server (LspM)
import Language.LSP.Types
import qualified Language.LSP.Types as LSP
import qualified Language.LSP.VFS as VFS
data Log
= LogModificationTime NormalizedFilePath FileVersion
| LogShake Shake.Log
| LogDocOpened Uri
| LogDocModified Uri
| LogDocSaved Uri
| LogDocClosed Uri
| LogFOI (HashMap NormalizedFilePath FileOfInterestStatus)
deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> [Char]
$cshow :: Log -> [Char]
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show
instance Pretty Log where
pretty :: forall ann. Log -> Doc ann
pretty = \case
LogShake Log
log' -> forall a ann. Pretty a => a -> Doc ann
pretty Log
log'
LogModificationTime NormalizedFilePath
nfp FileVersion
modTime ->
Doc ann
"Modified:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
nfp) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> [Char]
show FileVersion
modTime)
LogDocOpened Uri
uri ->
Doc ann
"Opened text document:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (Uri -> Text
getUri Uri
uri)
LogDocModified Uri
uri ->
Doc ann
"Modified text document:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (Uri -> Text
getUri Uri
uri)
LogDocSaved Uri
uri ->
Doc ann
"Saved text document:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (Uri -> Text
getUri Uri
uri)
LogDocClosed Uri
uri ->
Doc ann
"Closed text document:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (Uri -> Text
getUri Uri
uri)
LogFOI HashMap NormalizedFilePath FileOfInterestStatus
files ->
Doc ann
"Set files of interest to:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow HashMap NormalizedFilePath FileOfInterestStatus
files
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId = (forall ideState. PluginId -> PluginDescriptor ideState
defaultCabalPluginDescriptor PluginId
plId)
{ pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
cabalRules Recorder (WithPriority Log)
recorder
, pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCodeAction
STextDocumentCodeAction IdeState
-> PluginId
-> CodeActionParams
-> LspM
Config
(Either ResponseError (ResponseResult 'TextDocumentCodeAction))
licenseSuggestCodeAction
, pluginNotificationHandlers :: PluginNotificationHandlers IdeState
pluginNotificationHandlers = forall a. Monoid a => [a] -> a
mconcat
[ forall (m :: Method 'FromClient 'Notification) ideState.
PluginNotificationMethod m =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SMethod 'TextDocumentDidOpen
LSP.STextDocumentDidOpen forall a b. (a -> b) -> a -> b
$
\IdeState
ide VFS
vfs PluginId
_ (DidOpenTextDocumentParams TextDocumentItem{Uri
$sel:_uri:TextDocumentItem :: TextDocumentItem -> Uri
_uri :: Uri
_uri,Int32
$sel:_version:TextDocumentItem :: TextDocumentItem -> Int32
_version :: Int32
_version}) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
_uri forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> do
Priority -> Log -> IO ()
log' Priority
Debug forall a b. (a -> b) -> a -> b
$ Uri -> Log
LogDocOpened Uri
_uri
Recorder (WithPriority Log)
-> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest Recorder (WithPriority Log)
recorder IdeState
ide NormalizedFilePath
file Modified{firstOpen :: Bool
firstOpen=Bool
True}
ShakeExtras -> VFS -> NormalizedFilePath -> [Char] -> IO ()
restartCabalShakeSession (IdeState -> ShakeExtras
shakeExtras IdeState
ide) VFS
vfs NormalizedFilePath
file [Char]
"(opened)"
, forall (m :: Method 'FromClient 'Notification) ideState.
PluginNotificationMethod m =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SMethod 'TextDocumentDidChange
LSP.STextDocumentDidChange forall a b. (a -> b) -> a -> b
$
\IdeState
ide VFS
vfs PluginId
_ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{Uri
$sel:_uri:VersionedTextDocumentIdentifier :: VersionedTextDocumentIdentifier -> Uri
_uri :: Uri
_uri} List TextDocumentContentChangeEvent
_) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
_uri forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> do
Priority -> Log -> IO ()
log' Priority
Debug forall a b. (a -> b) -> a -> b
$ Uri -> Log
LogDocModified Uri
_uri
Recorder (WithPriority Log)
-> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest Recorder (WithPriority Log)
recorder IdeState
ide NormalizedFilePath
file Modified{firstOpen :: Bool
firstOpen=Bool
False}
ShakeExtras -> VFS -> NormalizedFilePath -> [Char] -> IO ()
restartCabalShakeSession (IdeState -> ShakeExtras
shakeExtras IdeState
ide) VFS
vfs NormalizedFilePath
file [Char]
"(changed)"
, forall (m :: Method 'FromClient 'Notification) ideState.
PluginNotificationMethod m =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SMethod 'TextDocumentDidSave
LSP.STextDocumentDidSave forall a b. (a -> b) -> a -> b
$
\IdeState
ide VFS
vfs PluginId
_ (DidSaveTextDocumentParams TextDocumentIdentifier{Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri :: Uri
_uri} Maybe Text
_) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
_uri forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> do
Priority -> Log -> IO ()
log' Priority
Debug forall a b. (a -> b) -> a -> b
$ Uri -> Log
LogDocSaved Uri
_uri
Recorder (WithPriority Log)
-> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest Recorder (WithPriority Log)
recorder IdeState
ide NormalizedFilePath
file FileOfInterestStatus
OnDisk
ShakeExtras -> VFS -> NormalizedFilePath -> [Char] -> IO ()
restartCabalShakeSession (IdeState -> ShakeExtras
shakeExtras IdeState
ide) VFS
vfs NormalizedFilePath
file [Char]
"(saved)"
, forall (m :: Method 'FromClient 'Notification) ideState.
PluginNotificationMethod m =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SMethod 'TextDocumentDidClose
LSP.STextDocumentDidClose forall a b. (a -> b) -> a -> b
$
\IdeState
ide VFS
vfs PluginId
_ (DidCloseTextDocumentParams TextDocumentIdentifier{Uri
_uri :: Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri}) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
_uri forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> do
Priority -> Log -> IO ()
log' Priority
Debug forall a b. (a -> b) -> a -> b
$ Uri -> Log
LogDocClosed Uri
_uri
Recorder (WithPriority Log)
-> IdeState -> NormalizedFilePath -> IO ()
deleteFileOfInterest Recorder (WithPriority Log)
recorder IdeState
ide NormalizedFilePath
file
ShakeExtras -> VFS -> NormalizedFilePath -> [Char] -> IO ()
restartCabalShakeSession (IdeState -> ShakeExtras
shakeExtras IdeState
ide) VFS
vfs NormalizedFilePath
file [Char]
"(closed)"
]
}
where
log' :: Priority -> Log -> IO ()
log' = forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
uri NormalizedFilePath -> IO ()
act = forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Uri -> Maybe [Char]
LSP.uriToFilePath Uri
uri) forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> IO ()
act forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> NormalizedFilePath
toNormalizedFilePath'
restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO ()
restartCabalShakeSession :: ShakeExtras -> VFS -> NormalizedFilePath -> [Char] -> IO ()
restartCabalShakeSession ShakeExtras
shakeExtras VFS
vfs NormalizedFilePath
file [Char]
actionMsg = do
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall k.
ShakeValue k =>
ShakeExtras -> k -> [NormalizedFilePath] -> STM (IO ())
Shake.recordDirtyKeys ShakeExtras
shakeExtras GetModificationTime
GetModificationTime [NormalizedFilePath
file]
ShakeExtras -> VFSModified -> [Char] -> [DelayedAction ()] -> IO ()
restartShakeSession ShakeExtras
shakeExtras (VFS -> VFSModified
VFSModified VFS
vfs) (NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
file forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
actionMsg) []
data ParseCabal = ParseCabal
deriving (ParseCabal -> ParseCabal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseCabal -> ParseCabal -> Bool
$c/= :: ParseCabal -> ParseCabal -> Bool
== :: ParseCabal -> ParseCabal -> Bool
$c== :: ParseCabal -> ParseCabal -> Bool
Eq, Int -> ParseCabal -> ShowS
[ParseCabal] -> ShowS
ParseCabal -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ParseCabal] -> ShowS
$cshowList :: [ParseCabal] -> ShowS
show :: ParseCabal -> [Char]
$cshow :: ParseCabal -> [Char]
showsPrec :: Int -> ParseCabal -> ShowS
$cshowsPrec :: Int -> ParseCabal -> ShowS
Show, Typeable, forall x. Rep ParseCabal x -> ParseCabal
forall x. ParseCabal -> Rep ParseCabal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseCabal x -> ParseCabal
$cfrom :: forall x. ParseCabal -> Rep ParseCabal x
Generic)
instance Hashable ParseCabal
instance NFData ParseCabal
type instance RuleResult ParseCabal = ()
cabalRules :: Recorder (WithPriority Log) -> Rules ()
cabalRules :: Recorder (WithPriority Log) -> Rules ()
cabalRules Recorder (WithPriority Log)
recorder = do
Recorder (WithPriority Log) -> Rules ()
ofInterestRules Recorder (WithPriority Log)
recorder
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$ \ParseCabal
ParseCabal NormalizedFilePath
file -> do
(FileVersion
t, Maybe Text
mCabalSource) <- forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetFileContents
GetFileContents NormalizedFilePath
file
Priority -> Log -> Action ()
log' Priority
Debug forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FileVersion -> Log
LogModificationTime NormalizedFilePath
file FileVersion
t
ByteString
contents <- case Maybe Text
mCabalSource of
Just Text
sources -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Encoding.encodeUtf8 Text
sources
Maybe Text
Nothing -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
file
([PWarning]
pWarnings, Either (Maybe Version, NonEmpty PError) GenericPackageDescription
pm) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString
-> IO
([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
Parse.parseCabalFileContents ByteString
contents
let warningDiags :: [FileDiagnostic]
warningDiags = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NormalizedFilePath -> PWarning -> FileDiagnostic
Diagnostics.warningDiagnostic NormalizedFilePath
file) [PWarning]
pWarnings
case Either (Maybe Version, NonEmpty PError) GenericPackageDescription
pm of
Left (Maybe Version
_cabalVersion, NonEmpty PError
pErrorNE) -> do
let errorDiags :: [FileDiagnostic]
errorDiags = forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (NormalizedFilePath -> PError -> FileDiagnostic
Diagnostics.errorDiagnostic NormalizedFilePath
file) NonEmpty PError
pErrorNE
allDiags :: [FileDiagnostic]
allDiags = [FileDiagnostic]
errorDiags forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
warningDiags
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
allDiags, forall a. Maybe a
Nothing)
Right GenericPackageDescription
_ -> do
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
warningDiags, forall a. a -> Maybe a
Just ())
forall a. Action a -> Rules ()
action forall a b. (a -> b) -> a -> b
$ do
Action ()
kick
where
log' :: Priority -> Log -> Action ()
log' = forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder
kick :: Action ()
kick :: Action ()
kick = do
[NormalizedFilePath]
files <- forall k v. HashMap k v -> [k]
HashMap.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action (HashMap NormalizedFilePath FileOfInterestStatus)
getCabalFilesOfInterestUntracked
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f (Maybe v))
uses ParseCabal
ParseCabal [NormalizedFilePath]
files
licenseSuggestCodeAction
:: IdeState
-> PluginId
-> CodeActionParams
-> LspM Config (Either ResponseError (ResponseResult 'TextDocumentCodeAction))
licenseSuggestCodeAction :: IdeState
-> PluginId
-> CodeActionParams
-> LspM
Config
(Either ResponseError (ResponseResult 'TextDocumentCodeAction))
licenseSuggestCodeAction IdeState
_ PluginId
_ (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ (TextDocumentIdentifier Uri
uri) Range
_range CodeActionContext{$sel:_diagnostics:CodeActionContext :: CodeActionContext -> List Diagnostic
_diagnostics=List [Diagnostic]
diags}) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List forall a b. (a -> b) -> a -> b
$ [Diagnostic]
diags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> a |? b
InR forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Diagnostic -> [CodeAction]
LicenseSuggest.licenseErrorAction Uri
uri))
newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
instance Shake.IsIdeGlobal OfInterestCabalVar
data IsCabalFileOfInterest = IsCabalFileOfInterest
deriving (IsCabalFileOfInterest -> IsCabalFileOfInterest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsCabalFileOfInterest -> IsCabalFileOfInterest -> Bool
$c/= :: IsCabalFileOfInterest -> IsCabalFileOfInterest -> Bool
== :: IsCabalFileOfInterest -> IsCabalFileOfInterest -> Bool
$c== :: IsCabalFileOfInterest -> IsCabalFileOfInterest -> Bool
Eq, Int -> IsCabalFileOfInterest -> ShowS
[IsCabalFileOfInterest] -> ShowS
IsCabalFileOfInterest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IsCabalFileOfInterest] -> ShowS
$cshowList :: [IsCabalFileOfInterest] -> ShowS
show :: IsCabalFileOfInterest -> [Char]
$cshow :: IsCabalFileOfInterest -> [Char]
showsPrec :: Int -> IsCabalFileOfInterest -> ShowS
$cshowsPrec :: Int -> IsCabalFileOfInterest -> ShowS
Show, Typeable, forall x. Rep IsCabalFileOfInterest x -> IsCabalFileOfInterest
forall x. IsCabalFileOfInterest -> Rep IsCabalFileOfInterest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsCabalFileOfInterest x -> IsCabalFileOfInterest
$cfrom :: forall x. IsCabalFileOfInterest -> Rep IsCabalFileOfInterest x
Generic)
instance Hashable IsCabalFileOfInterest
instance NFData IsCabalFileOfInterest
type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult
data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus
deriving (CabalFileOfInterestResult -> CabalFileOfInterestResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalFileOfInterestResult -> CabalFileOfInterestResult -> Bool
$c/= :: CabalFileOfInterestResult -> CabalFileOfInterestResult -> Bool
== :: CabalFileOfInterestResult -> CabalFileOfInterestResult -> Bool
$c== :: CabalFileOfInterestResult -> CabalFileOfInterestResult -> Bool
Eq, Int -> CabalFileOfInterestResult -> ShowS
[CabalFileOfInterestResult] -> ShowS
CabalFileOfInterestResult -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CabalFileOfInterestResult] -> ShowS
$cshowList :: [CabalFileOfInterestResult] -> ShowS
show :: CabalFileOfInterestResult -> [Char]
$cshow :: CabalFileOfInterestResult -> [Char]
showsPrec :: Int -> CabalFileOfInterestResult -> ShowS
$cshowsPrec :: Int -> CabalFileOfInterestResult -> ShowS
Show, Typeable, forall x.
Rep CabalFileOfInterestResult x -> CabalFileOfInterestResult
forall x.
CabalFileOfInterestResult -> Rep CabalFileOfInterestResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CabalFileOfInterestResult x -> CabalFileOfInterestResult
$cfrom :: forall x.
CabalFileOfInterestResult -> Rep CabalFileOfInterestResult x
Generic)
instance Hashable CabalFileOfInterestResult
instance NFData CabalFileOfInterestResult
ofInterestRules :: Recorder (WithPriority Log) -> Rules ()
ofInterestRules :: Recorder (WithPriority Log) -> Rules ()
ofInterestRules Recorder (WithPriority Log)
recorder = do
forall a. IsIdeGlobal a => a -> Rules ()
Shake.addIdeGlobal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> OfInterestCabalVar
OfInterestCabalVar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. a -> IO (Var a)
newVar forall k v. HashMap k v
HashMap.empty)
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
Shake.defineEarlyCutoff (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$ forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, Maybe v))
-> RuleBody k v
RuleNoDiagnostics forall a b. (a -> b) -> a -> b
$ \IsCabalFileOfInterest
IsCabalFileOfInterest NormalizedFilePath
f -> do
Action ()
alwaysRerun
HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest <- Action (HashMap NormalizedFilePath FileOfInterestStatus)
getCabalFilesOfInterestUntracked
let foi :: CabalFileOfInterestResult
foi = forall b a. b -> (a -> b) -> Maybe a -> b
maybe CabalFileOfInterestResult
NotCabalFOI FileOfInterestStatus -> CabalFileOfInterestResult
IsCabalFOI forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
f forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest
fp :: ByteString
fp = CabalFileOfInterestResult -> ByteString
summarize CabalFileOfInterestResult
foi
res :: (Maybe ByteString, Maybe CabalFileOfInterestResult)
res = (forall a. a -> Maybe a
Just ByteString
fp, forall a. a -> Maybe a
Just CabalFileOfInterestResult
foi)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString, Maybe CabalFileOfInterestResult)
res
where
summarize :: CabalFileOfInterestResult -> ByteString
summarize CabalFileOfInterestResult
NotCabalFOI = Word8 -> ByteString
BS.singleton Word8
0
summarize (IsCabalFOI FileOfInterestStatus
OnDisk) = Word8 -> ByteString
BS.singleton Word8
1
summarize (IsCabalFOI (Modified Bool
False)) = Word8 -> ByteString
BS.singleton Word8
2
summarize (IsCabalFOI (Modified Bool
True)) = Word8 -> ByteString
BS.singleton Word8
3
getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getCabalFilesOfInterestUntracked = do
OfInterestCabalVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- forall a. (HasCallStack, IsIdeGlobal a) => Action a
Shake.getIdeGlobalAction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Var a -> IO a
readVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var
addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest :: Recorder (WithPriority Log)
-> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest Recorder (WithPriority Log)
recorder IdeState
state NormalizedFilePath
f FileOfInterestStatus
v = do
OfInterestCabalVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- forall a. IsIdeGlobal a => IdeState -> IO a
Shake.getIdeGlobalState IdeState
state
(Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
files) <- forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var forall a b. (a -> b) -> a -> b
$ \HashMap NormalizedFilePath FileOfInterestStatus
dict -> do
let (Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
new) = forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF (, forall a. a -> Maybe a
Just FileOfInterestStatus
v) NormalizedFilePath
f HashMap NormalizedFilePath FileOfInterestStatus
dict
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap NormalizedFilePath FileOfInterestStatus
new, (Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
new))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FileOfInterestStatus
prev forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just FileOfInterestStatus
v) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall k.
ShakeValue k =>
ShakeExtras -> k -> [NormalizedFilePath] -> STM (IO ())
Shake.recordDirtyKeys (IdeState -> ShakeExtras
shakeExtras IdeState
state) IsFileOfInterest
IsFileOfInterest [NormalizedFilePath
f]
Priority -> Log -> IO ()
log' Priority
Debug forall a b. (a -> b) -> a -> b
$ HashMap NormalizedFilePath FileOfInterestStatus -> Log
LogFOI HashMap NormalizedFilePath FileOfInterestStatus
files
where
log' :: Priority -> Log -> IO ()
log' = forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder
deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO ()
deleteFileOfInterest :: Recorder (WithPriority Log)
-> IdeState -> NormalizedFilePath -> IO ()
deleteFileOfInterest Recorder (WithPriority Log)
recorder IdeState
state NormalizedFilePath
f = do
OfInterestCabalVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- forall a. IsIdeGlobal a => IdeState -> IO a
Shake.getIdeGlobalState IdeState
state
HashMap NormalizedFilePath FileOfInterestStatus
files <- forall a. Var a -> (a -> a) -> IO a
modifyVar' Var (HashMap NormalizedFilePath FileOfInterestStatus)
var forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete NormalizedFilePath
f
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall k.
ShakeValue k =>
ShakeExtras -> k -> [NormalizedFilePath] -> STM (IO ())
Shake.recordDirtyKeys (IdeState -> ShakeExtras
shakeExtras IdeState
state) IsFileOfInterest
IsFileOfInterest [NormalizedFilePath
f]
Priority -> Log -> IO ()
log' Priority
Debug forall a b. (a -> b) -> a -> b
$ HashMap NormalizedFilePath FileOfInterestStatus -> Log
LogFOI HashMap NormalizedFilePath FileOfInterestStatus
files
where
log' :: Priority -> Log -> IO ()
log' = forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder