ribosome-0.9.9.9: Neovim plugin framework for Polysemy
Safe HaskellSafe-Inferred
LanguageHaskell2010

Ribosome.Report

Description

Smart constructors for DataLog LogReport

Synopsis

Documentation

context :: Member (DataLog LogReport) r => Text -> Sem r a -> Sem r a Source #

Add a segment to the current Report logging context.

setContext :: Member (DataLog LogReport) r => ReportContext -> Sem r a -> Sem r a Source #

Set the current Report logging context.

logReport :: Reportable e => Member (DataLog LogReport) r => e -> Sem r () Source #

Convert a value to Report via Reportable and send it to the log.

info :: Member (DataLog LogReport) r => Text -> [Text] -> Sem r () Source #

Send a Report to the log given a user and log message, with serverity Info.

warn :: Member (DataLog LogReport) r => Text -> [Text] -> Sem r () Source #

Send a Report to the log given a user and log message, with serverity Warn.

error :: Member (DataLog LogReport) r => Text -> [Text] -> Sem r () Source #

Send a Report to the log given a user and log message, with serverity Error.

reportStop :: forall err r. Reportable err => Member (DataLog LogReport) r => Sem (Stop err ': r) () -> Sem r () Source #

Eliminate Stop err by converting err to a Report and logging it, continuing execution for a unit action.

resumeLogReport :: forall eff e r. Reportable e => Members [eff !! e, DataLog LogReport] r => Sem (eff ': r) () -> Sem r () Source #

Resume an effect by converting the error to a Report and logging it, continuing execution for a unit action.

storedReports :: forall (r :: EffectRow). Member Reports r => Sem r (Map ReportContext [StoredReport]) #

Get all reports.

storeReport :: forall (r :: EffectRow). Member Reports r => ReportContext -> Report -> Sem r () #

Add a report to the store.

data Reports (a :: Type -> Type) b where #

This internal effect stores all errors in memory that have been created through the Report system.

Constructors

StoreReport :: forall (a :: Type -> Type). ReportContext -> Report -> Reports a ()

Add a report to the store.

StoredReports :: forall (a :: Type -> Type). Reports a (Map ReportContext [StoredReport])

Get all reports.

data LogReport #

The type used by request handlers and expected by the RPC dispatcher.

Instances

Instances details
IsString LogReport 
Instance details

Defined in Ribosome.Host.Data.Report

Generic LogReport 
Instance details

Defined in Ribosome.Host.Data.Report

Associated Types

type Rep LogReport :: Type -> Type #

Show LogReport 
Instance details

Defined in Ribosome.Host.Data.Report

type Rep LogReport 
Instance details

Defined in Ribosome.Host.Data.Report

type Rep LogReport = D1 ('MetaData "LogReport" "Ribosome.Host.Data.Report" "ribosome-host-0.9.9.9-4n86eC1033RAA2pmC2T1m9" 'False) (C1 ('MetaCons "LogReport" 'PrefixI 'True) ((S1 ('MetaSel ('Just "report") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Report) :*: S1 ('MetaSel ('Just "echo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)) :*: (S1 ('MetaSel ('Just "store") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool) :*: S1 ('MetaSel ('Just "context") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ReportContext))))

data Report where #

An report with different messages intended to be sent to Neovim and the log, respectively.

Used by request handlers and expected by the RPC dispatcher.

Also contains the Severity of the report, or minimum log level, which determines whether the report should be logged and echoed in Neovim, and what kind of highlighting should be used in Neovim (red for errors, orange for warnings, none for infomrational errors).

The log message may span multiple lines.

Constructors

Report :: HasCallStack => !Text -> ![Text] -> !Severity -> Report 

Instances

Instances details
IsString Report 
Instance details

Defined in Ribosome.Host.Data.Report

Methods

fromString :: String -> Report #

Show Report 
Instance details

Defined in Ribosome.Host.Data.Report

Reportable Report 
Instance details

Defined in Ribosome.Host.Data.Report

Methods

toReport :: Report -> Report #

MsgpackEncode a => HandlerCodec (Handler r a) r 
Instance details

Defined in Ribosome.Host.Handler.Codec

Methods

handlerCodec :: Handler r a -> RpcHandlerFun r #

newtype ReportContext #

The provenance of a report, for use in logs.

Constructors

ReportContext [Text] 

class Reportable e where #

The class of types that are convertible to a Report.

This is used to create a uniform format for handlers, since control flow is passed on to the internal machinery when they return. If an error would be thrown that is not caught by the request dispatcher, the entire plugin would stop, so all Stop and Resumable effects need to be converted to Report before returning (see Errors).

The combinators associated with this class make this task a little less arduous:

data NumbersError = InvalidNumber

instance Reportable NumbersError where
  toReport InvalidNumber = Report "Invalid number!" ["The user entered an invalid number"] Warn

count :: Int -> Sem r Int
count i =
  resumeReport @Rpc $ mapReport @NumbersError do
    when (i == 0) (stop InvalidNumber)
    nvimGetVar ("number_" <> show i)

Here resumeReport converts a potential RpcError from nvimGetVar to Report (e.g. if the variable is not set), while mapReport uses the instance Reportable NumbersError to convert the call to stop.

Methods

toReport :: e -> Report #

Instances

Instances details
Reportable Void 
Instance details

Defined in Ribosome.Host.Data.Report

Methods

toReport :: Void -> Report #

Reportable PersistError Source # 
Instance details

Defined in Ribosome.Data.PersistError

Reportable PersistPathError Source # 
Instance details

Defined in Ribosome.Data.PersistPathError

Reportable SettingError Source # 
Instance details

Defined in Ribosome.Data.SettingError

Reportable DecodeError 
Instance details

Defined in Ribosome.Host.Class.Msgpack.Error

Reportable Report 
Instance details

Defined in Ribosome.Host.Data.Report

Methods

toReport :: Report -> Report #

Reportable RpcError 
Instance details

Defined in Ribosome.Host.Data.RpcError

Methods

toReport :: RpcError -> Report #