{-# LANGUAGE DeriveDataTypeable         #-}

module Data.KeyStore.Types.E
    ( E
    , Reason
    , E.strMsg
    , rsaError
    , eWrap
    , showReason
    ) where

import           Crypto.PubKey.RSA
import           Data.Typeable
import qualified Control.Monad.Error            as E
import qualified Control.Exception              as X
import           System.IO
import           System.Exit


type E a = Either Reason a

data Reason
    = R_RSA Error
    | R_MSG String
    | R_GEN
    deriving (Typeable,Int -> Reason -> ShowS
[Reason] -> ShowS
Reason -> String
(Int -> Reason -> ShowS)
-> (Reason -> String) -> ([Reason] -> ShowS) -> Show Reason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reason] -> ShowS
$cshowList :: [Reason] -> ShowS
show :: Reason -> String
$cshow :: Reason -> String
showsPrec :: Int -> Reason -> ShowS
$cshowsPrec :: Int -> Reason -> ShowS
Show)

instance X.Exception Reason

instance E.Error Reason where
    noMsg :: Reason
noMsg  = Reason
R_GEN
    strMsg :: String -> Reason
strMsg = String -> Reason
R_MSG

rsaError :: Error -> Reason
rsaError :: Error -> Reason
rsaError = Error -> Reason
R_RSA

eWrap :: IO a -> IO a
eWrap :: IO a -> IO a
eWrap IO a
p = IO a -> (Reason -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
X.catch IO a
p Reason -> IO a
forall b. Reason -> IO b
h
  where
    h :: Reason -> IO b
h     = String -> IO b
forall b. String -> IO b
rpt (String -> IO b) -> (Reason -> String) -> Reason -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reason -> String
showReason

    rpt :: String -> IO b
rpt String
s = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
s IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
forall a. IO a
exitFailure

showReason :: Reason -> String
showReason :: Reason -> String
showReason Reason
r =
    case Reason
r of
      R_RSA Error
e -> String
"error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Error -> String
forall a. Show a => a -> String
show Error
e
      R_MSG String
s -> String
"error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
      Reason
R_GEN   -> String
"error"