{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-

Manage the "textDocument/publishDiagnostics" notifications to keep a local copy of the
diagnostics for a particular file and version, partitioned by source.
-}
module Language.LSP.Diagnostics
  (
    DiagnosticStore
  , DiagnosticsBySource
  , StoreItem(..)
  , partitionBySource
  , flushBySource
  , updateDiagnostics
  , getDiagnosticParamsFor

  -- * for tests
  ) where

import qualified Data.SortedList as SL
import qualified Data.Map.Strict as Map
import qualified Data.HashMap.Strict as HM
import qualified Language.LSP.Types      as J

-- ---------------------------------------------------------------------
{-# ANN module ("hlint: ignore Eta reduce" :: String) #-}
{-# ANN module ("hlint: ignore Redundant do" :: String) #-}
-- ---------------------------------------------------------------------

{-
We need a three level store

  Uri : Maybe TextDocumentVersion : Maybe DiagnosticSource : [Diagnostics]

For a given Uri, as soon as we see a new (Maybe TextDocumentVersion) we flush
all prior entries for the Uri.

-}

type DiagnosticStore = HM.HashMap J.NormalizedUri StoreItem

data StoreItem
  = StoreItem J.TextDocumentVersion DiagnosticsBySource
  deriving (Int -> StoreItem -> ShowS
[StoreItem] -> ShowS
StoreItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoreItem] -> ShowS
$cshowList :: [StoreItem] -> ShowS
show :: StoreItem -> String
$cshow :: StoreItem -> String
showsPrec :: Int -> StoreItem -> ShowS
$cshowsPrec :: Int -> StoreItem -> ShowS
Show,StoreItem -> StoreItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoreItem -> StoreItem -> Bool
$c/= :: StoreItem -> StoreItem -> Bool
== :: StoreItem -> StoreItem -> Bool
$c== :: StoreItem -> StoreItem -> Bool
Eq)

type DiagnosticsBySource = Map.Map (Maybe J.DiagnosticSource) (SL.SortedList J.Diagnostic)

-- ---------------------------------------------------------------------

partitionBySource :: [J.Diagnostic] -> DiagnosticsBySource
partitionBySource :: [Diagnostic] -> DiagnosticsBySource
partitionBySource [Diagnostic]
diags = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Monoid a => a -> a -> a
mappend forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Diagnostic
d -> (Diagnostic -> Maybe DiagnosticSource
J._source Diagnostic
d, (forall a. a -> SortedList a
SL.singleton Diagnostic
d))) [Diagnostic]
diags

-- ---------------------------------------------------------------------

flushBySource :: DiagnosticStore -> Maybe J.DiagnosticSource -> DiagnosticStore
flushBySource :: DiagnosticStore -> Maybe DiagnosticSource -> DiagnosticStore
flushBySource DiagnosticStore
store Maybe DiagnosticSource
Nothing       = DiagnosticStore
store
flushBySource DiagnosticStore
store (Just DiagnosticSource
source) = forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map StoreItem -> StoreItem
remove DiagnosticStore
store
  where
    remove :: StoreItem -> StoreItem
remove (StoreItem TextDocumentVersion
mv DiagnosticsBySource
diags) = TextDocumentVersion -> DiagnosticsBySource -> StoreItem
StoreItem TextDocumentVersion
mv (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (forall a. a -> Maybe a
Just DiagnosticSource
source) DiagnosticsBySource
diags)

-- ---------------------------------------------------------------------

updateDiagnostics :: DiagnosticStore
                  -> J.NormalizedUri -> J.TextDocumentVersion -> DiagnosticsBySource
                  -> DiagnosticStore
updateDiagnostics :: DiagnosticStore
-> NormalizedUri
-> TextDocumentVersion
-> DiagnosticsBySource
-> DiagnosticStore
updateDiagnostics DiagnosticStore
store NormalizedUri
uri TextDocumentVersion
mv DiagnosticsBySource
newDiagsBySource = DiagnosticStore
r
  where
    newStore :: DiagnosticStore
    newStore :: DiagnosticStore
newStore = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert NormalizedUri
uri (TextDocumentVersion -> DiagnosticsBySource -> StoreItem
StoreItem TextDocumentVersion
mv DiagnosticsBySource
newDiagsBySource) DiagnosticStore
store

    updateDbs :: DiagnosticsBySource -> DiagnosticStore
updateDbs DiagnosticsBySource
dbs = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert NormalizedUri
uri StoreItem
new DiagnosticStore
store
      where
        new :: StoreItem
new = TextDocumentVersion -> DiagnosticsBySource -> StoreItem
StoreItem TextDocumentVersion
mv DiagnosticsBySource
newDbs
        -- note: Map.union is left-biased, so for identical keys the first
        -- argument is used
        newDbs :: DiagnosticsBySource
newDbs = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union DiagnosticsBySource
newDiagsBySource DiagnosticsBySource
dbs

    r :: DiagnosticStore
r = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup NormalizedUri
uri DiagnosticStore
store of
      Maybe StoreItem
Nothing -> DiagnosticStore
newStore
      Just (StoreItem TextDocumentVersion
mvs DiagnosticsBySource
dbs) ->
        if TextDocumentVersion
mvs forall a. Eq a => a -> a -> Bool
/= TextDocumentVersion
mv
          then DiagnosticStore
newStore
          else DiagnosticsBySource -> DiagnosticStore
updateDbs DiagnosticsBySource
dbs

-- ---------------------------------------------------------------------

getDiagnosticParamsFor :: Int -> DiagnosticStore -> J.NormalizedUri -> Maybe J.PublishDiagnosticsParams
getDiagnosticParamsFor :: Int
-> DiagnosticStore
-> NormalizedUri
-> Maybe PublishDiagnosticsParams
getDiagnosticParamsFor Int
maxDiagnostics DiagnosticStore
ds NormalizedUri
uri =
  case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup NormalizedUri
uri DiagnosticStore
ds of
    Maybe StoreItem
Nothing -> forall a. Maybe a
Nothing
    Just (StoreItem TextDocumentVersion
mv DiagnosticsBySource
diags) ->
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Uri -> Maybe UInt -> List Diagnostic -> PublishDiagnosticsParams
J.PublishDiagnosticsParams (NormalizedUri -> Uri
J.fromNormalizedUri NormalizedUri
uri) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral TextDocumentVersion
mv) (forall a. [a] -> List a
J.List (forall a. Int -> [a] -> [a]
take Int
maxDiagnostics forall a b. (a -> b) -> a -> b
$ forall a. SortedList a -> [a]
SL.fromSortedList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems DiagnosticsBySource
diags))

-- ---------------------------------------------------------------------