module SocketsAndPipes.Serve.Exceptions
  (
    -- * Types
    BindFailed (..), AddrTried (..),

    -- * Functions related to the types
    displayBindFailed, displayAddrTried,

    -- * General functions for working with exceptions
    overException, firstSuccessOrAllExceptions

  ) where

import Control.Exception.Safe
    ( Exception (displayException), SomeException, catch, throw )

import Data.Foldable ( fold )

import qualified Data.Sequence          as Seq
import qualified Data.Foldable          as Seq ( toList )
import qualified Data.List              as List
import qualified Data.Text.Lazy         as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified Network.Socket         as Socket

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

instance Exception BindFailed
  where
    displayException :: BindFailed -> String
displayException = Text -> String
LT.unpack (Text -> String) -> (BindFailed -> Text) -> BindFailed -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (BindFailed -> Builder) -> BindFailed -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindFailed -> Builder
displayBindFailed

data AddrTried =
    AddrTried
        { AddrTried -> AddrInfo
addrTried :: Socket.AddrInfo
        , AddrTried -> SomeException
addrException :: SomeException
        }
    deriving Int -> AddrTried -> ShowS
[AddrTried] -> ShowS
AddrTried -> String
(Int -> AddrTried -> ShowS)
-> (AddrTried -> String)
-> ([AddrTried] -> ShowS)
-> Show AddrTried
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddrTried] -> ShowS
$cshowList :: [AddrTried] -> ShowS
show :: AddrTried -> String
$cshow :: AddrTried -> String
showsPrec :: Int -> AddrTried -> ShowS
$cshowsPrec :: Int -> AddrTried -> ShowS
Show

instance Exception AddrTried
  where
    displayException :: AddrTried -> String
displayException = Text -> String
LT.unpack (Text -> String) -> (AddrTried -> Text) -> AddrTried -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text) -> (AddrTried -> Builder) -> AddrTried -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrTried -> Builder
displayAddrTried

displayBindFailed :: BindFailed -> TB.Builder
displayBindFailed :: BindFailed -> Builder
displayBindFailed BindFailed{ [AddrTried]
bindAddrsTried :: [AddrTried]
bindAddrsTried :: BindFailed -> [AddrTried]
bindAddrsTried }
    | [AddrTried] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AddrTried]
bindAddrsTried = Builder
displayBindFailedNoAddresses
    | Bool
otherwise           = [AddrTried] -> Builder
displayBindFailedWithAddrs [AddrTried]
bindAddrsTried

displayBindFailedNoAddresses :: TB.Builder
displayBindFailedNoAddresses :: Builder
displayBindFailedNoAddresses =
  String -> Builder
TB.fromString
    String
"Failed to set up a passive socket for the server \
    \because no candidate addresses were found."

displayBindFailedWithAddrs :: [AddrTried] -> TB.Builder
displayBindFailedWithAddrs :: [AddrTried] -> Builder
displayBindFailedWithAddrs [AddrTried]
bindAddrsTried =
    String -> Builder
TB.fromString String
"Failed to set up a passive socket for the server. \
                  \The following addresses were tried:\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
      (
        Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse
            (String -> Builder
TB.fromString String
"\n")
            (
              (AddrTried -> Builder) -> [AddrTried] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
List.map
                  ( \AddrTried{ AddrInfo
addrTried :: AddrInfo
addrTried :: AddrTried -> AddrInfo
addrTried, SomeException
addrException :: SomeException
addrException :: AddrTried -> SomeException
addrException } ->
                        String -> Builder
TB.fromString String
" ❌ " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                        String -> Builder
TB.fromString (SockAddr -> String
forall a. Show a => a -> String
show (AddrInfo -> SockAddr
Socket.addrAddress AddrInfo
addrTried)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                        String -> Builder
TB.fromString String
" — " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                        String -> Builder
TB.fromString (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
addrException)
                  )
                  [AddrTried]
bindAddrsTried
            )
      )

displayAddrTried :: AddrTried -> TB.Builder
displayAddrTried :: AddrTried -> Builder
displayAddrTried AddrTried{ AddrInfo
addrTried :: AddrInfo
addrTried :: AddrTried -> AddrInfo
addrTried, SomeException
addrException :: SomeException
addrException :: AddrTried -> SomeException
addrException } =
    String -> Builder
TB.fromString (AddrInfo -> String
forall a. Show a => a -> String
show AddrInfo
addrTried) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TB.fromString String
": "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TB.fromString (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
addrException)

overException :: (Exception e1, Exception e2) =>
    (e1 -> e2) -- ^ How to turn the exception
               --   into a different exception
    -> IO a -- ^ Action that might throw the first exception
    -> IO a -- ^ Action that might throw the second exception
overException :: (e1 -> e2) -> IO a -> IO a
overException e1 -> e2
f IO a
a = IO a -> (e1 -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch IO a
a (e2 -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (e2 -> IO a) -> (e1 -> e2) -> e1 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f)
{- ^
    If the action throws an exception, turn it into a different
    exception. This is useful to add information that explains
    the context in which the original exception occurred.
-}

firstSuccessOrAllExceptions :: (Exception e1, Exception e2) =>
    ([e1] -> e2) -- ^ How to collect the many exceptions into one
    -> [IO a] -- ^ Many actions that may fail
    -> IO a -- ^ The result from the first action that succeeds,
            --   or else throws a collection of all the exceptions.
firstSuccessOrAllExceptions :: ([e1] -> e2) -> [IO a] -> IO a
firstSuccessOrAllExceptions [e1] -> e2
f = Seq e1 -> [IO a] -> IO a
forall (m :: * -> *) a. MonadCatch m => Seq e1 -> [m a] -> m a
go Seq e1
forall a. Seq a
Seq.empty
  where
    go :: Seq e1 -> [m a] -> m a
go Seq e1
exs [] = e2 -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw ([e1] -> e2
f (Seq e1 -> [e1]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Seq.toList Seq e1
exs))
    go Seq e1
exs (m a
a : [m a]
as) = m a -> (e1 -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
a (\e1
ex -> Seq e1 -> [m a] -> m a
go (Seq e1
exs Seq e1 -> e1 -> Seq e1
forall a. Seq a -> a -> Seq a
Seq.|> e1
ex) [m a]
as)