{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      : Data.MemPack.Error
-- Copyright   : (c) Alexey Kuleshevich 2024
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
module Data.MemPack.Error where

import Control.Exception
import Data.List.NonEmpty as NE
import Data.Text (Text)
import Data.Typeable
import GHC.Exts

data SomeError where
  SomeError :: (Typeable e, Error e) => e -> SomeError

instance Show SomeError where
  showsPrec :: Int -> SomeError -> ShowS
showsPrec Int
p (SomeError e
e) = Int -> e -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p e
e

instance Exception SomeError

-- | Very similar interface to `Exceptions`, except not intended for runtime exceptions.
class Show e => Error e where
  toSomeError :: e -> SomeError
  default toSomeError :: Typeable e => e -> SomeError
  toSomeError = e -> SomeError
forall e. (Typeable e, Error e) => e -> SomeError
SomeError

  fromSomeError :: SomeError -> Maybe e
  default fromSomeError :: Typeable e => SomeError -> Maybe e
  fromSomeError (SomeError e
t) = e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
t

instance Error SomeError where
  toSomeError :: SomeError -> SomeError
toSomeError = SomeError -> SomeError
forall a. a -> a
id
  fromSomeError :: SomeError -> Maybe SomeError
fromSomeError = SomeError -> Maybe SomeError
forall a. a -> Maybe a
Just

newtype TextError = TextError Text
  deriving newtype (TextError -> TextError -> Bool
(TextError -> TextError -> Bool)
-> (TextError -> TextError -> Bool) -> Eq TextError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextError -> TextError -> Bool
== :: TextError -> TextError -> Bool
$c/= :: TextError -> TextError -> Bool
/= :: TextError -> TextError -> Bool
Eq, Int -> TextError -> ShowS
[TextError] -> ShowS
TextError -> String
(Int -> TextError -> ShowS)
-> (TextError -> String)
-> ([TextError] -> ShowS)
-> Show TextError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextError -> ShowS
showsPrec :: Int -> TextError -> ShowS
$cshow :: TextError -> String
show :: TextError -> String
$cshowList :: [TextError] -> ShowS
showList :: [TextError] -> ShowS
Show, String -> TextError
(String -> TextError) -> IsString TextError
forall a. (String -> a) -> IsString a
$cfromString :: String -> TextError
fromString :: String -> TextError
IsString)

instance Error TextError

instance IsString SomeError where
  fromString :: String -> SomeError
fromString = TextError -> SomeError
forall e. Error e => e -> SomeError
toSomeError (TextError -> SomeError)
-> (String -> TextError) -> String -> SomeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TextError
TextError (Text -> TextError) -> (String -> Text) -> String -> TextError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

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

instance Error ManyErrors

data UnknownError = UnknownError
  deriving (Int -> UnknownError -> ShowS
[UnknownError] -> ShowS
UnknownError -> String
(Int -> UnknownError -> ShowS)
-> (UnknownError -> String)
-> ([UnknownError] -> ShowS)
-> Show UnknownError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnknownError -> ShowS
showsPrec :: Int -> UnknownError -> ShowS
$cshow :: UnknownError -> String
show :: UnknownError -> String
$cshowList :: [UnknownError] -> ShowS
showList :: [UnknownError] -> ShowS
Show)

instance Error UnknownError

fromMultipleErrors :: [SomeError] -> SomeError
fromMultipleErrors :: [SomeError] -> SomeError
fromMultipleErrors [SomeError]
es =
  case [SomeError]
es of
    [] -> UnknownError -> SomeError
forall e. Error e => e -> SomeError
toSomeError UnknownError
UnknownError
    [SomeError
e] -> SomeError
e
    SomeError
e : [SomeError]
rest -> ManyErrors -> SomeError
forall e. Error e => e -> SomeError
toSomeError (ManyErrors -> SomeError) -> ManyErrors -> SomeError
forall a b. (a -> b) -> a -> b
$ NonEmpty SomeError -> ManyErrors
ManyErrors (SomeError
e SomeError -> [SomeError] -> NonEmpty SomeError
forall a. a -> [a] -> NonEmpty a
:| [SomeError]
rest)
{-# NOINLINE fromMultipleErrors #-}


data RanOutOfBytesError = RanOutOfBytesError
  { RanOutOfBytesError -> Int
ranOutOfBytesRead :: Int
  , RanOutOfBytesError -> Int
ranOutOfBytesAvailable :: Int
  , RanOutOfBytesError -> Int
ranOutOfBytesRequested :: Int
  }
  deriving (RanOutOfBytesError -> RanOutOfBytesError -> Bool
(RanOutOfBytesError -> RanOutOfBytesError -> Bool)
-> (RanOutOfBytesError -> RanOutOfBytesError -> Bool)
-> Eq RanOutOfBytesError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
== :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
$c/= :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
/= :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
Eq, Eq RanOutOfBytesError
Eq RanOutOfBytesError =>
(RanOutOfBytesError -> RanOutOfBytesError -> Ordering)
-> (RanOutOfBytesError -> RanOutOfBytesError -> Bool)
-> (RanOutOfBytesError -> RanOutOfBytesError -> Bool)
-> (RanOutOfBytesError -> RanOutOfBytesError -> Bool)
-> (RanOutOfBytesError -> RanOutOfBytesError -> Bool)
-> (RanOutOfBytesError -> RanOutOfBytesError -> RanOutOfBytesError)
-> (RanOutOfBytesError -> RanOutOfBytesError -> RanOutOfBytesError)
-> Ord RanOutOfBytesError
RanOutOfBytesError -> RanOutOfBytesError -> Bool
RanOutOfBytesError -> RanOutOfBytesError -> Ordering
RanOutOfBytesError -> RanOutOfBytesError -> RanOutOfBytesError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RanOutOfBytesError -> RanOutOfBytesError -> Ordering
compare :: RanOutOfBytesError -> RanOutOfBytesError -> Ordering
$c< :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
< :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
$c<= :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
<= :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
$c> :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
> :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
$c>= :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
>= :: RanOutOfBytesError -> RanOutOfBytesError -> Bool
$cmax :: RanOutOfBytesError -> RanOutOfBytesError -> RanOutOfBytesError
max :: RanOutOfBytesError -> RanOutOfBytesError -> RanOutOfBytesError
$cmin :: RanOutOfBytesError -> RanOutOfBytesError -> RanOutOfBytesError
min :: RanOutOfBytesError -> RanOutOfBytesError -> RanOutOfBytesError
Ord)

instance Show RanOutOfBytesError where
  show :: RanOutOfBytesError -> String
show RanOutOfBytesError{Int
ranOutOfBytesRead :: RanOutOfBytesError -> Int
ranOutOfBytesAvailable :: RanOutOfBytesError -> Int
ranOutOfBytesRequested :: RanOutOfBytesError -> Int
ranOutOfBytesRead :: Int
ranOutOfBytesAvailable :: Int
ranOutOfBytesRequested :: Int
..} =
    String
"Ran out of bytes. Read "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes Int
ranOutOfBytesRead
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" out of "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes Int
ranOutOfBytesAvailable
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". Requested to read "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes Int
ranOutOfBytesRequested
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" more."

instance Error RanOutOfBytesError

data NotFullyConsumedError = NotFullyConsumedError
  { NotFullyConsumedError -> Int
notFullyConsumedRead :: Int
  , NotFullyConsumedError -> Int
notFullyConsumedAvailable :: Int
  , NotFullyConsumedError -> String
notFullyConsumedTypeName :: String
  }
  deriving (NotFullyConsumedError -> NotFullyConsumedError -> Bool
(NotFullyConsumedError -> NotFullyConsumedError -> Bool)
-> (NotFullyConsumedError -> NotFullyConsumedError -> Bool)
-> Eq NotFullyConsumedError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
== :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
$c/= :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
/= :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
Eq, Eq NotFullyConsumedError
Eq NotFullyConsumedError =>
(NotFullyConsumedError -> NotFullyConsumedError -> Ordering)
-> (NotFullyConsumedError -> NotFullyConsumedError -> Bool)
-> (NotFullyConsumedError -> NotFullyConsumedError -> Bool)
-> (NotFullyConsumedError -> NotFullyConsumedError -> Bool)
-> (NotFullyConsumedError -> NotFullyConsumedError -> Bool)
-> (NotFullyConsumedError
    -> NotFullyConsumedError -> NotFullyConsumedError)
-> (NotFullyConsumedError
    -> NotFullyConsumedError -> NotFullyConsumedError)
-> Ord NotFullyConsumedError
NotFullyConsumedError -> NotFullyConsumedError -> Bool
NotFullyConsumedError -> NotFullyConsumedError -> Ordering
NotFullyConsumedError
-> NotFullyConsumedError -> NotFullyConsumedError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NotFullyConsumedError -> NotFullyConsumedError -> Ordering
compare :: NotFullyConsumedError -> NotFullyConsumedError -> Ordering
$c< :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
< :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
$c<= :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
<= :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
$c> :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
> :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
$c>= :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
>= :: NotFullyConsumedError -> NotFullyConsumedError -> Bool
$cmax :: NotFullyConsumedError
-> NotFullyConsumedError -> NotFullyConsumedError
max :: NotFullyConsumedError
-> NotFullyConsumedError -> NotFullyConsumedError
$cmin :: NotFullyConsumedError
-> NotFullyConsumedError -> NotFullyConsumedError
min :: NotFullyConsumedError
-> NotFullyConsumedError -> NotFullyConsumedError
Ord)

instance Show NotFullyConsumedError where
  show :: NotFullyConsumedError -> String
show NotFullyConsumedError{Int
String
notFullyConsumedRead :: NotFullyConsumedError -> Int
notFullyConsumedAvailable :: NotFullyConsumedError -> Int
notFullyConsumedTypeName :: NotFullyConsumedError -> String
notFullyConsumedRead :: Int
notFullyConsumedAvailable :: Int
notFullyConsumedTypeName :: String
..} =
    String
"Buffer of length " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes Int
notFullyConsumedAvailable
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was not fully consumed while unpacking '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
notFullyConsumedTypeName
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'. Unconsumed " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes (Int
notFullyConsumedAvailable Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
notFullyConsumedRead)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was leftover."

instance Error NotFullyConsumedError

showBytes :: Int -> String
showBytes :: Int -> String
showBytes Int
1 = String
"1 byte"
showBytes Int
n = Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bytes"