module Ribosome.Msgpack.Error where

import System.Log.Logger (Priority(ERROR))

import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty)
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))
import Ribosome.Error.Report.Class (ReportError(..))
import Ribosome.Msgpack.Util (Err)

newtype DecodeError =
  Failed Err
  deriving Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodeError] -> ShowS
$cshowList :: [DecodeError] -> ShowS
show :: DecodeError -> String
$cshow :: DecodeError -> String
showsPrec :: Int -> DecodeError -> ShowS
$cshowsPrec :: Int -> DecodeError -> ShowS
Show

deepPrisms ''DecodeError

instance ReportError DecodeError where
  errorReport :: DecodeError -> ErrorReport
errorReport (Failed Err
err) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"error decoding response from neovim" [Item [Text]
"DecodeError:", Text
Item [Text]
rendered] Priority
ERROR
    where
      rendered :: Text
rendered = SimpleDocStream AnsiStyle -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream AnsiStyle -> Text)
-> SimpleDocStream AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$ LayoutOptions -> Err -> SimpleDocStream AnsiStyle
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions Err
err