{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      :  Neovim.Exceptions
Description :  General Exceptions
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC
-}
module Neovim.Exceptions (
    NeovimException (..),
    exceptionToDoc,
    catchNeovimException,
) where

import Control.Exception (Exception)
import Data.MessagePack (Object (..))
import Data.String (IsString (..))
import Data.Typeable (Typeable)
import Prettyprinter (Doc, viaShow, (<+>))
import Prettyprinter.Render.Terminal (AnsiStyle)
import UnliftIO (MonadUnliftIO, catch)

-- | Exceptions specific to /nvim-hs/.
data NeovimException
    = -- | Simple error message that is passed to neovim. It should currently only
      -- contain one line of text.
      ErrorMessage (Doc AnsiStyle)
    | -- | Error that can be returned by a remote API call. The 'Doc' argument is
      -- the name of the remote function that threw this exception.
      ErrorResult (Doc AnsiStyle) Object
    deriving (Typeable, Int -> NeovimException -> ShowS
[NeovimException] -> ShowS
NeovimException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NeovimException] -> ShowS
$cshowList :: [NeovimException] -> ShowS
show :: NeovimException -> String
$cshow :: NeovimException -> String
showsPrec :: Int -> NeovimException -> ShowS
$cshowsPrec :: Int -> NeovimException -> ShowS
Show)

instance Exception NeovimException

instance IsString NeovimException where
    fromString :: String -> NeovimException
fromString = Doc AnsiStyle -> NeovimException
ErrorMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

exceptionToDoc :: NeovimException -> Doc AnsiStyle
exceptionToDoc :: NeovimException -> Doc AnsiStyle
exceptionToDoc = \case
    ErrorMessage Doc AnsiStyle
e ->
        Doc AnsiStyle
"Error message:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
e
    ErrorResult Doc AnsiStyle
fn Object
o ->
        Doc AnsiStyle
"Function" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
fn forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"has thrown an error:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow Object
o

-- | Specialization of 'catch' for 'NeovimException's.
catchNeovimException :: MonadUnliftIO io => io a -> (NeovimException -> io a) -> io a
catchNeovimException :: forall (io :: * -> *) a.
MonadUnliftIO io =>
io a -> (NeovimException -> io a) -> io a
catchNeovimException io a
action NeovimException -> io a
exceptionHandler = io a
action forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` NeovimException -> io a
exceptionHandler