-- |Error for 'Ribosome.PersistPath'.
module Ribosome.Data.PersistPathError where

import Exon (exon)
import Path (Abs, Dir, Path)
import Polysemy.Log (Severity (Error))

import Ribosome.Host.Data.Report (Report (Report), Reportable (toReport))
import Ribosome.Host.Path (pathText)

-- |The errors emitted by the effect 'Ribosome.PersistPath'.
data PersistPathError =
  -- |Cannot determine the cache directory.
  Undefined
  |
  -- |General permissions error.
  Permissions (Path Abs Dir)
  deriving stock (PersistPathError -> PersistPathError -> Bool
(PersistPathError -> PersistPathError -> Bool)
-> (PersistPathError -> PersistPathError -> Bool)
-> Eq PersistPathError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersistPathError -> PersistPathError -> Bool
$c/= :: PersistPathError -> PersistPathError -> Bool
== :: PersistPathError -> PersistPathError -> Bool
$c== :: PersistPathError -> PersistPathError -> Bool
Eq, Int -> PersistPathError -> ShowS
[PersistPathError] -> ShowS
PersistPathError -> String
(Int -> PersistPathError -> ShowS)
-> (PersistPathError -> String)
-> ([PersistPathError] -> ShowS)
-> Show PersistPathError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistPathError] -> ShowS
$cshowList :: [PersistPathError] -> ShowS
show :: PersistPathError -> String
$cshow :: PersistPathError -> String
showsPrec :: Int -> PersistPathError -> ShowS
$cshowsPrec :: Int -> PersistPathError -> ShowS
Show)

instance Reportable PersistPathError where
  toReport :: PersistPathError -> Report
toReport = \case
    PersistPathError
Undefined ->
      HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report Text
msg [Item [Text]
"PersistPathError.Undefined"] Severity
Error
      where
        msg :: Text
msg =
          Text
"g:ribosome_persistence_dir unset and XDG not available."
    Permissions (Path Abs Dir -> Text
forall b t. Path b t -> Text
pathText -> Text
path) ->
      HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report Text
msg [Item [Text]
"PersistPathError.Permissions:", Text
Item [Text]
path] Severity
Error
      where
        msg :: Text
msg =
          [exon|Couldn't create persistence dir '#{path}'|]