module Proteome.Data.TagsError where

import Exon (exon)
import Log (Severity (Warn))
import Ribosome (Report (Report), Reportable (toReport), SettingError, reportMessages)

data TagsError =
  Process Text
  |
  TempName
  |
  RenameTags Text
  |
  Setting SettingError
  deriving stock (TagsError -> TagsError -> Bool
(TagsError -> TagsError -> Bool)
-> (TagsError -> TagsError -> Bool) -> Eq TagsError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagsError -> TagsError -> Bool
$c/= :: TagsError -> TagsError -> Bool
== :: TagsError -> TagsError -> Bool
$c== :: TagsError -> TagsError -> Bool
Eq, Int -> TagsError -> ShowS
[TagsError] -> ShowS
TagsError -> String
(Int -> TagsError -> ShowS)
-> (TagsError -> String)
-> ([TagsError] -> ShowS)
-> Show TagsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagsError] -> ShowS
$cshowList :: [TagsError] -> ShowS
show :: TagsError -> String
$cshow :: TagsError -> String
showsPrec :: Int -> TagsError -> ShowS
$cshowsPrec :: Int -> TagsError -> ShowS
Show)

instance Reportable TagsError where
  toReport :: TagsError -> Report
toReport = \case
    Process Text
msg ->
      HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report Text
"tags process failed" [Item [Text]
"TagsError.Process", Text
Item [Text]
msg] Severity
Warn
    TagsError
TempName ->
      HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report Text
"failed to create temp dir for tags process" [Item [Text]
"TagsError.TempName"] Severity
Warn
    RenameTags Text
msg ->
      HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report Text
"Failed to rename temporary tags file" [Item [Text]
"TagsError.RenameTags", Text
Item [Text]
msg] Severity
Warn
    Setting SettingError
e ->
      HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report [exon|tags failed: #{reportMessages (toReport e)}|] [Item [Text]
"TagsError.Setting:", SettingError -> Text
forall b a. (Show a, IsString b) => a -> b
show SettingError
e] Severity
Warn