{-# LANGUAGE TypeApplications #-}
module Serokell.Util.Verify
( VerificationRes (..)
, isVerFailure
, isVerSuccess
, verResToMonadError
, verifyGeneric
, formatAllErrors
, formatFirstError
, verResFullF
, verResSingleF
) where
import Universum
import Control.Monad.Except (MonadError, throwError)
import Fmt (fmt)
import Serokell.Util.Text (listBuilder)
import qualified Data.Text.Lazy.Builder as B
data VerificationRes
= VerSuccess
| VerFailure !(NonEmpty Text)
deriving (Eq, Show)
isVerSuccess :: VerificationRes -> Bool
isVerSuccess VerSuccess = True
isVerSuccess _ = False
isVerFailure :: VerificationRes -> Bool
isVerFailure (VerFailure _) = True
isVerFailure _ = False
instance Semigroup VerificationRes where
VerSuccess <> a = a
a <> VerSuccess = a
VerFailure xs <> VerFailure ys = VerFailure $ xs <> ys
instance Monoid VerificationRes where
mempty = VerSuccess
mappend = (<>)
verifyGeneric :: [(Bool, Text)] -> VerificationRes
verifyGeneric errors = case messages of
[] -> VerSuccess
(x:xs) -> VerFailure $ x :| xs
where
messages = map snd . filter (not . fst) $ errors
verResFullF :: VerificationRes -> Text
verResFullF VerSuccess = "success"
verResFullF (VerFailure errors) = fmt $ buildVerResImpl errors
verResSingleF :: VerificationRes -> Text
verResSingleF VerSuccess = "success"
verResSingleF (VerFailure errors) = fmt $ buildVerResImpl $ one $ head errors
buildVerResImpl :: NonEmpty Text -> B.Builder
buildVerResImpl errors =
"failure: " <> listBuilder @Text @Text @Text "[" "; " "]" errors
formatAllErrors :: NonEmpty Text -> Text
formatAllErrors = verResFullF . VerFailure
formatFirstError :: NonEmpty Text -> Text
formatFirstError = verResSingleF . VerFailure
verResToMonadError
:: MonadError e m
=> (NonEmpty Text -> e) -> VerificationRes -> m ()
verResToMonadError _ VerSuccess = pass
verResToMonadError f (VerFailure errors) = throwError $ f errors