module Proteome.Data.FilesError where

import Log (Severity (Error, Warn))
import Ribosome (Report (Report), Reportable (toReport))

data FilesError =
  BadCwd
  |
  NoSuchPath Text
  |
  BadRegex Text Text
  |
  InvalidFilePath Text
  |
  CouldntCreateDir Text
  deriving stock (FilesError -> FilesError -> Bool
(FilesError -> FilesError -> Bool)
-> (FilesError -> FilesError -> Bool) -> Eq FilesError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilesError -> FilesError -> Bool
$c/= :: FilesError -> FilesError -> Bool
== :: FilesError -> FilesError -> Bool
$c== :: FilesError -> FilesError -> Bool
Eq, Int -> FilesError -> ShowS
[FilesError] -> ShowS
FilesError -> String
(Int -> FilesError -> ShowS)
-> (FilesError -> String)
-> ([FilesError] -> ShowS)
-> Show FilesError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilesError] -> ShowS
$cshowList :: [FilesError] -> ShowS
show :: FilesError -> String
$cshow :: FilesError -> String
showsPrec :: Int -> FilesError -> ShowS
$cshowsPrec :: Int -> FilesError -> ShowS
Show)

instance Reportable FilesError where
  toReport :: FilesError -> Report
toReport FilesError
BadCwd =
    HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report Text
"internal error" [Item [Text]
"FilesError.BadCwd"] Severity
Error
  toReport (NoSuchPath Text
path) =
    HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report (Text
"path doesn't exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path) [Item [Text]
"FilesError.NoSuchPath:", Text
Item [Text]
path] Severity
Warn
  toReport (BadRegex Text
var Text
re) =
    HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report (Text
"bad regex in `g:proteome_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
re) [Item [Text]
"FilesError.BadRegex:", Text
Item [Text]
var, Text
Item [Text]
re] Severity
Warn
  toReport (InvalidFilePath Text
path) =
    HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report (Text
"invalid file path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path) [Item [Text]
"FilesError.InvalidFilePath:", Text
Item [Text]
path] Severity
Warn
  toReport (CouldntCreateDir Text
path) =
    HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report (Text
"couldn't create directory: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path) [Item [Text]
"FilesError.CouldntCreateDir:", Text
Item [Text]
path] Severity
Warn