{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Swarm.Game.Failure
-- Copyright   :  Ondřej Šebek
-- Maintainer  :  ondras98@icloud.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A data type to represent system failures.
--
-- These failures are often not fatal and serve
-- to create common infrastructure for logging.
module Swarm.TUI.Model.Failure where

import Data.Char (toLower)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Yaml (ParseException, prettyPrintParseException)

data SystemFailure
  = AssetNotLoaded Asset FilePath LoadingFailure

data Asset = Achievement | Data | History | Save
  deriving (Asset -> Asset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Asset -> Asset -> Bool
$c/= :: Asset -> Asset -> Bool
== :: Asset -> Asset -> Bool
$c== :: Asset -> Asset -> Bool
Eq, Int -> Asset -> ShowS
[Asset] -> ShowS
Asset -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Asset] -> ShowS
$cshowList :: [Asset] -> ShowS
show :: Asset -> FilePath
$cshow :: Asset -> FilePath
showsPrec :: Int -> Asset -> ShowS
$cshowsPrec :: Int -> Asset -> ShowS
Show)

data Entry = Directory | File
  deriving (Entry -> Entry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> FilePath
$cshow :: Entry -> FilePath
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show)

data LoadingFailure
  = DoesNotExist Entry
  | EntryNot Entry
  | CanNotParse ParseException

tShowLow :: Show a => a -> Text
tShowLow :: forall a. Show a => a -> Text
tShowLow = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show

tShow :: Show a => a -> Text
tShow :: forall a. Show a => a -> Text
tShow = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show

prettyLoadingFailure :: LoadingFailure -> Text
prettyLoadingFailure :: LoadingFailure -> Text
prettyLoadingFailure = \case
  DoesNotExist Entry
e -> Text
"The " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShowLow Entry
e forall a. Semigroup a => a -> a -> a
<> Text
" is missing!"
  EntryNot Entry
e -> Text
"The entry is not a " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShowLow Entry
e forall a. Semigroup a => a -> a -> a
<> Text
"!"
  CanNotParse ParseException
p -> Text
"Parse failure:\n" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> ShowS
indent Int
8 forall a b. (a -> b) -> a -> b
$ ParseException -> FilePath
prettyPrintParseException ParseException
p)
 where
  indent :: Int -> ShowS
indent Int
n = [FilePath] -> FilePath
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> a -> [a]
replicate Int
n Char
' ' forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines

prettyFailure :: SystemFailure -> Text
prettyFailure :: SystemFailure -> Text
prettyFailure = \case
  AssetNotLoaded Asset
a FilePath
fp LoadingFailure
l -> [Text] -> Text
T.unwords [Text
"Failed to acquire", forall a. Show a => a -> Text
tShowLow Asset
a, forall a. Show a => a -> Text
tShow FilePath
fp] forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> LoadingFailure -> Text
prettyLoadingFailure LoadingFailure
l