module Ribosome.Error.Report where

import qualified Data.Map.Strict as Map (alter)
import Data.Text.Prettyprint.Doc (line, pretty)
import Data.Text.Prettyprint.Doc.Render.Terminal (putDoc)
import System.Log (Priority(NOTICE))

import Ribosome.Api.Echo (echom)
import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim, NvimE, RNeovim, Ribo, runRibo)
import qualified Ribosome.Control.Monad.Ribo as Ribo (getErrors, modifyErrors, pluginName)
import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))
import Ribosome.Data.Errors (ComponentName(ComponentName), Error(Error), Errors(Errors))
import Ribosome.Error.Report.Class (ReportError(..))
import Ribosome.Log (logAs)
import Ribosome.Nvim.Api.RpcCall (RpcError)
import Ribosome.System.Time (epochSeconds)

storeError' :: Int -> Text -> ErrorReport -> Errors -> Errors
storeError' :: Int -> Text -> ErrorReport -> Errors -> Errors
storeError' Int
time Text
name ErrorReport
report (Errors Map ComponentName [Error]
errors) =
  Map ComponentName [Error] -> Errors
Errors ((Maybe [Error] -> Maybe [Error])
-> ComponentName
-> Map ComponentName [Error]
-> Map ComponentName [Error]
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe [Error] -> Maybe [Error]
alter (Text -> ComponentName
ComponentName Text
name) Map ComponentName [Error]
errors)
  where
    err :: Error
err = Int -> ErrorReport -> Error
Error Int
time ErrorReport
report
    alter :: Maybe [Error] -> Maybe [Error]
alter Maybe [Error]
Nothing = [Error] -> Maybe [Error]
forall a. a -> Maybe a
Just [Item [Error]
Error
err]
    alter (Just [Error]
current) = [Error] -> Maybe [Error]
forall a. a -> Maybe a
Just (Error
errError -> [Error] -> [Error]
forall a. a -> [a] -> [a]
:[Error]
current)

storeError :: MonadRibo m => Text -> ErrorReport -> m ()
storeError :: Text -> ErrorReport -> m ()
storeError Text
name ErrorReport
e = do
  Int
time <- m Int
forall (m :: * -> *). MonadIO m => m Int
epochSeconds
  (Errors -> Errors) -> m ()
forall (m :: * -> *). MonadRibo m => (Errors -> Errors) -> m ()
Ribo.modifyErrors ((Errors -> Errors) -> m ()) -> (Errors -> Errors) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ErrorReport -> Errors -> Errors
storeError' Int
time Text
name ErrorReport
e

logErrorReport ::
  (MonadRibo m, NvimE e m) =>
  ErrorReport ->
  m ()
logErrorReport :: ErrorReport -> m ()
logErrorReport (ErrorReport Text
user [Text]
logMsgs Priority
prio) = do
  Text
name <- m Text
forall (m :: * -> *). MonadRibo m => m Text
Ribo.pluginName
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Priority -> Text -> Text -> IO ()
forall a (m :: * -> *).
(Loggable a, MonadIO m) =>
Priority -> Text -> a -> m ()
logAs Priority
prio Text
name) [Text]
logMsgs
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Priority
prio Priority -> Priority -> Bool
forall a. Ord a => a -> a -> Bool
>= Priority
NOTICE) (Text -> m ()
forall (m :: * -> *) e. (MonadRibo m, NvimE e m) => Text -> m ()
echom Text
user)

processErrorReport ::
  (MonadRibo m, NvimE e m) =>
  Text ->
  ErrorReport ->
  m ()
processErrorReport :: Text -> ErrorReport -> m ()
processErrorReport Text
name ErrorReport
report = do
  Text -> ErrorReport -> m ()
forall (m :: * -> *). MonadRibo m => Text -> ErrorReport -> m ()
storeError Text
name ErrorReport
report
  ErrorReport -> m ()
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m) =>
ErrorReport -> m ()
logErrorReport ErrorReport
report

processErrorReport' ::
  (MonadRibo m, Nvim m) =>
  Text ->
  ErrorReport ->
  m ()
processErrorReport' :: Text -> ErrorReport -> m ()
processErrorReport' Text
name =
  m (Either RpcError ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either RpcError ()) -> m ())
-> (ErrorReport -> m (Either RpcError ())) -> ErrorReport -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
forall (m :: * -> *) a.
ExceptT RpcError m a -> m (Either RpcError a)
runExceptT @RpcError (ExceptT RpcError m () -> m (Either RpcError ()))
-> (ErrorReport -> ExceptT RpcError m ())
-> ErrorReport
-> m (Either RpcError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorReport -> ExceptT RpcError m ()
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m) =>
Text -> ErrorReport -> m ()
processErrorReport Text
name

reportErrorWith ::
  (MonadRibo m, NvimE e m) =>
  Text ->
  (a -> ErrorReport) ->
  a ->
  m ()
reportErrorWith :: Text -> (a -> ErrorReport) -> a -> m ()
reportErrorWith Text
name a -> ErrorReport
cons a
err =
  Text -> ErrorReport -> m ()
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m) =>
Text -> ErrorReport -> m ()
processErrorReport Text
name (a -> ErrorReport
cons a
err)

reportError ::
  MonadRibo m =>
  NvimE e m =>
  ReportError a =>
  Text ->
  a ->
  m ()
reportError :: Text -> a -> m ()
reportError Text
name =
  Text -> (a -> ErrorReport) -> a -> m ()
forall (m :: * -> *) e a.
(MonadRibo m, NvimE e m) =>
Text -> (a -> ErrorReport) -> a -> m ()
reportErrorWith Text
name a -> ErrorReport
forall a. ReportError a => a -> ErrorReport
errorReport

reportErrorOr ::
  (MonadRibo m, NvimE e m, ReportError e) =>
  Text ->
  (a -> m ()) ->
  Either e a ->
  m ()
reportErrorOr :: Text -> (a -> m ()) -> Either e a -> m ()
reportErrorOr Text
name =
  (e -> m ()) -> (a -> m ()) -> Either e a -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((e -> m ()) -> (a -> m ()) -> Either e a -> m ())
-> (e -> m ()) -> (a -> m ()) -> Either e a -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> e -> m ()
forall (m :: * -> *) e a.
(MonadRibo m, NvimE e m, ReportError a) =>
Text -> a -> m ()
reportError Text
name

reportErrorOr_ ::
  (MonadRibo m, NvimE e m, ReportError e) =>
  Text ->
  m () ->
  Either e a ->
  m ()
reportErrorOr_ :: Text -> m () -> Either e a -> m ()
reportErrorOr_ Text
name =
  Text -> (a -> m ()) -> Either e a -> m ()
forall (m :: * -> *) e a.
(MonadRibo m, NvimE e m, ReportError e) =>
Text -> (a -> m ()) -> Either e a -> m ()
reportErrorOr Text
name ((a -> m ()) -> Either e a -> m ())
-> (m () -> a -> m ()) -> m () -> Either e a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> a -> m ()
forall a b. a -> b -> a
const

reportError' ::
  ∀ e m a .
  (MonadRibo m, Nvim m, ReportError e) =>
  Text ->
  Either e a ->
  m ()
reportError' :: Text -> Either e a -> m ()
reportError' Text
_ (Right a
_) =
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reportError' Text
componentName (Left e
e) =
  m (Either RpcError ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either RpcError ()) -> m ()) -> m (Either RpcError ()) -> m ()
forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
forall (m :: * -> *) a.
ExceptT RpcError m a -> m (Either RpcError a)
runExceptT @RpcError (ExceptT RpcError m () -> m (Either RpcError ()))
-> ExceptT RpcError m () -> m (Either RpcError ())
forall a b. (a -> b) -> a -> b
$ Text -> e -> ExceptT RpcError m ()
forall (m :: * -> *) e a.
(MonadRibo m, NvimE e m, ReportError a) =>
Text -> a -> m ()
reportError Text
componentName e
e

printAllErrors :: MonadRibo m => m ()
printAllErrors :: m ()
printAllErrors = do
  Errors
errors <- m Errors
forall (m :: * -> *). MonadRibo m => m Errors
Ribo.getErrors
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> IO ()
putDoc (Errors -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Errors
errors Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line)

runRiboReport ::
  ∀ e s.
  ReportError e =>
  Text ->
  Ribo s e () ->
  RNeovim s ()
runRiboReport :: Text -> Ribo s e () -> RNeovim s ()
runRiboReport Text
componentName =
  Text -> Either e () -> RNeovim s ()
forall e (m :: * -> *) a.
(MonadRibo m, Nvim m, ReportError e) =>
Text -> Either e a -> m ()
reportError' Text
componentName (Either e () -> RNeovim s ())
-> (Ribo s e () -> Neovim (Ribosome s) (Either e ()))
-> Ribo s e ()
-> RNeovim s ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ribo s e () -> Neovim (Ribosome s) (Either e ())
forall s e a. Ribo s e a -> RNeovim s (Either e a)
runRibo