module Ribosome.Data.PersistError where

import System.Log (Priority(INFO, NOTICE, ERROR))

import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))
import Ribosome.Error.Report.Class (ReportError(..))

-- TODO use Path
data PersistError =
  FileNotReadable FilePath
  |
  NoSuchFile FilePath
  |
  Decode FilePath Text
  deriving (PersistError -> PersistError -> Bool
(PersistError -> PersistError -> Bool)
-> (PersistError -> PersistError -> Bool) -> Eq PersistError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersistError -> PersistError -> Bool
$c/= :: PersistError -> PersistError -> Bool
== :: PersistError -> PersistError -> Bool
$c== :: PersistError -> PersistError -> Bool
Eq, Int -> PersistError -> ShowS
[PersistError] -> ShowS
PersistError -> String
(Int -> PersistError -> ShowS)
-> (PersistError -> String)
-> ([PersistError] -> ShowS)
-> Show PersistError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistError] -> ShowS
$cshowList :: [PersistError] -> ShowS
show :: PersistError -> String
$cshow :: PersistError -> String
showsPrec :: Int -> PersistError -> ShowS
$cshowsPrec :: Int -> PersistError -> ShowS
Show)

deepPrisms ''PersistError

instance ReportError PersistError where
  errorReport :: PersistError -> ErrorReport
errorReport (FileNotReadable String
path) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Item [Text]
"PersistError.FileNotReadable:", String -> Text
forall a. ToText a => a -> Text
toText String
path] Priority
NOTICE
    where
      msg :: Text
msg = Text
"persistence file not readable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
path
  errorReport (NoSuchFile String
path) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Item [Text]
"PersistError.SoSuchFile:", String -> Text
forall a. ToText a => a -> Text
toText String
path] Priority
INFO
    where
      msg :: Text
msg = Text
"no persistence file present at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
path
  errorReport (Decode String
path Text
err) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Item [Text]
"PersistError.Decode:", String -> Text
forall a. ToText a => a -> Text
toText String
path, Text
Item [Text]
err] Priority
ERROR
    where
      msg :: Text
msg = Text
"invalid data in persistence file, please delete it: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
path