-- This file is part of purebred-email
-- Copyright (C) 2018-2021  Fraser Tweedale
--
-- purebred-email is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE LambdaCase #-}

module Data.MIME.Error where

import Control.Lens (Prism', prism')

import Data.MIME.Charset
import Data.MIME.TransferEncoding


-- | Transfer or character encoding errors
--
data EncodingError
  = TransferEncodingError TransferEncodingError
  | CharsetError CharsetError
  deriving (Int -> EncodingError -> ShowS
[EncodingError] -> ShowS
EncodingError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodingError] -> ShowS
$cshowList :: [EncodingError] -> ShowS
show :: EncodingError -> String
$cshow :: EncodingError -> String
showsPrec :: Int -> EncodingError -> ShowS
$cshowsPrec :: Int -> EncodingError -> ShowS
Show)

class AsEncodingError s where
  _EncodingError :: Prism' s EncodingError
  _EncodingErrorTransferEncodingError :: Prism' s TransferEncodingError
  _EncodingErrorCharsetError :: Prism' s CharsetError

  _EncodingErrorTransferEncodingError = forall s. AsEncodingError s => Prism' s EncodingError
_EncodingError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s.
AsTransferEncodingError s =>
Prism' s TransferEncodingError
_TransferEncodingError
  _EncodingErrorCharsetError = forall s. AsEncodingError s => Prism' s EncodingError
_EncodingError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. AsCharsetError s => Prism' s CharsetError
_CharsetError

instance AsEncodingError EncodingError where
  _EncodingError :: Prism' EncodingError EncodingError
_EncodingError = forall a. a -> a
id
  _EncodingErrorTransferEncodingError :: Prism' EncodingError TransferEncodingError
_EncodingErrorTransferEncodingError = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' TransferEncodingError -> EncodingError
TransferEncodingError forall a b. (a -> b) -> a -> b
$ \case
    TransferEncodingError TransferEncodingError
e -> forall a. a -> Maybe a
Just TransferEncodingError
e ; EncodingError
_ -> forall a. Maybe a
Nothing
  _EncodingErrorCharsetError :: Prism' EncodingError CharsetError
_EncodingErrorCharsetError = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' CharsetError -> EncodingError
CharsetError forall a b. (a -> b) -> a -> b
$ \case
    CharsetError CharsetError
e -> forall a. a -> Maybe a
Just CharsetError
e ; EncodingError
_ -> forall a. Maybe a
Nothing

instance AsCharsetError EncodingError where
  _CharsetError :: Prism' EncodingError CharsetError
_CharsetError = forall s. AsEncodingError s => Prism' s CharsetError
_EncodingErrorCharsetError

instance AsTransferEncodingError EncodingError where
  _TransferEncodingError :: Prism' EncodingError TransferEncodingError
_TransferEncodingError = forall s. AsEncodingError s => Prism' s TransferEncodingError
_EncodingErrorTransferEncodingError