{-# LANGUAGE DeriveAnyClass #-}

module Inferno.VersionControl.Operations.Error where

import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text, unpack)
import GHC.Generics (Generic)
import Inferno.VersionControl.Types
  ( VCObjectHash (..),
  )

data VCStoreError
  = CouldNotDecodeObject VCObjectHash String
  | CouldNotFindObject VCObjectHash
  | CouldNotFindPath FilePath
  | CouldNotFindHead VCObjectHash
  | TryingToAppendToNonHead VCObjectHash
  | InvalidHash String
  | UnexpectedObjectType VCObjectHash Text
  | TryingToDeleteNonAutosave Text
  deriving (Int -> VCStoreError -> ShowS
[VCStoreError] -> ShowS
VCStoreError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VCStoreError] -> ShowS
$cshowList :: [VCStoreError] -> ShowS
show :: VCStoreError -> String
$cshow :: VCStoreError -> String
showsPrec :: Int -> VCStoreError -> ShowS
$cshowsPrec :: Int -> VCStoreError -> ShowS
Show, forall x. Rep VCStoreError x -> VCStoreError
forall x. VCStoreError -> Rep VCStoreError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VCStoreError x -> VCStoreError
$cfrom :: forall x. VCStoreError -> Rep VCStoreError x
Generic, [VCStoreError] -> Encoding
[VCStoreError] -> Value
VCStoreError -> Encoding
VCStoreError -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VCStoreError] -> Encoding
$ctoEncodingList :: [VCStoreError] -> Encoding
toJSONList :: [VCStoreError] -> Value
$ctoJSONList :: [VCStoreError] -> Value
toEncoding :: VCStoreError -> Encoding
$ctoEncoding :: VCStoreError -> Encoding
toJSON :: VCStoreError -> Value
$ctoJSON :: VCStoreError -> Value
ToJSON, Value -> Parser [VCStoreError]
Value -> Parser VCStoreError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VCStoreError]
$cparseJSONList :: Value -> Parser [VCStoreError]
parseJSON :: Value -> Parser VCStoreError
$cparseJSON :: Value -> Parser VCStoreError
FromJSON)

vcStoreErrorToString :: VCStoreError -> String
vcStoreErrorToString :: VCStoreError -> String
vcStoreErrorToString = \case
  CouldNotDecodeObject VCObjectHash
h String
s -> String
"Could not decode object '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
h forall a. Semigroup a => a -> a -> a
<> String
"': " forall a. Semigroup a => a -> a -> a
<> String
s
  CouldNotFindObject VCObjectHash
h ->
    String
"Could not find object '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
h forall a. Semigroup a => a -> a -> a
<> String
"'"
  CouldNotFindPath String
fp -> String
"Could not find path: " forall a. Semigroup a => a -> a -> a
<> String
fp
  CouldNotFindHead VCObjectHash
h -> String
"Could not find HEAD for object '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
h forall a. Semigroup a => a -> a -> a
<> String
"'"
  TryingToAppendToNonHead VCObjectHash
h -> String
"Trying to append to non-HEAD object '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
h forall a. Semigroup a => a -> a -> a
<> String
"'"
  InvalidHash String
s -> String
"Could not decode hash '" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
"'"
  UnexpectedObjectType VCObjectHash
h Text
s ->
    String
"Unexpected object type of '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VCObjectHash
h forall a. Semigroup a => a -> a -> a
<> String
"'. Was expecting " forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
s
  TryingToDeleteNonAutosave Text
n -> String
"Trying to delete a non-autosaved script " forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
n