{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A data type to represent system failures (as distinct from robot
-- program failures).
--
-- These failures are often not fatal and serve
-- to create common infrastructure for logging.
module Swarm.Game.Failure (
  SystemFailure (..),
  AssetData (..),
  Asset (..),
  Entry (..),
  LoadingFailure (..),
  OrderFileWarning (..),
) where

import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void
import Data.Yaml (ParseException, prettyPrintParseException)
import Prettyprinter (Pretty (pretty), nest, squotes, vcat, (<+>))
import Swarm.Language.Pretty
import Swarm.Util (showLowT)
import Text.Megaparsec (ParseErrorBundle, errorBundlePretty)
import Witch (into)

------------------------------------------------------------
-- Failure descriptions

-- | Enumeration of various assets we can attempt to load.
data AssetData = AppAsset | NameGeneration | Entities | Recipes | Worlds | Scenarios | Script
  deriving (AssetData -> AssetData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssetData -> AssetData -> Bool
$c/= :: AssetData -> AssetData -> Bool
== :: AssetData -> AssetData -> Bool
$c== :: AssetData -> AssetData -> Bool
Eq, Int -> AssetData -> ShowS
[AssetData] -> ShowS
AssetData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssetData] -> ShowS
$cshowList :: [AssetData] -> ShowS
show :: AssetData -> String
$cshow :: AssetData -> String
showsPrec :: Int -> AssetData -> ShowS
$cshowsPrec :: Int -> AssetData -> ShowS
Show)

-- | Overarching enumeration of various assets we can attempt to load.
data Asset = Achievement | Data AssetData | 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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Asset] -> ShowS
$cshowList :: [Asset] -> ShowS
show :: Asset -> String
$cshow :: Asset -> String
showsPrec :: Int -> Asset -> ShowS
$cshowsPrec :: Int -> Asset -> ShowS
Show)

-- | Enumeration type to distinguish between directories and files.
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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show)

-- | An error that occurred while attempting to load some kind of asset.
data LoadingFailure
  = DoesNotExist Entry
  | EntryNot Entry
  | CanNotParseYaml ParseException
  | CanNotParseMegaparsec (ParseErrorBundle Text Void)
  | DoesNotTypecheck Text -- See Note [Typechecking errors]
  | Duplicate AssetData Text
  | CustomMessage Text
  deriving (Int -> LoadingFailure -> ShowS
[LoadingFailure] -> ShowS
LoadingFailure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoadingFailure] -> ShowS
$cshowList :: [LoadingFailure] -> ShowS
show :: LoadingFailure -> String
$cshow :: LoadingFailure -> String
showsPrec :: Int -> LoadingFailure -> ShowS
$cshowsPrec :: Int -> LoadingFailure -> ShowS
Show)

-- ~~~~ Note [Pretty-printing typechecking errors]
--
-- It would make sense to store a CheckErr in DoesNotTypecheck;
-- however, Swarm.Game.Failure is imported in lots of places, and
-- CheckErr can contain high-level things like TTerms etc., so it
-- would lead to an import cycle.  Instead, we choose to just
-- pretty-print typechecking errors before storing them here.

-- | A warning that arose while processing an @00-ORDER.txt@ file.
data OrderFileWarning
  = NoOrderFile
  | MissingFiles (NonEmpty FilePath)
  | DanglingFiles (NonEmpty FilePath)
  deriving (OrderFileWarning -> OrderFileWarning -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderFileWarning -> OrderFileWarning -> Bool
$c/= :: OrderFileWarning -> OrderFileWarning -> Bool
== :: OrderFileWarning -> OrderFileWarning -> Bool
$c== :: OrderFileWarning -> OrderFileWarning -> Bool
Eq, Int -> OrderFileWarning -> ShowS
[OrderFileWarning] -> ShowS
OrderFileWarning -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderFileWarning] -> ShowS
$cshowList :: [OrderFileWarning] -> ShowS
show :: OrderFileWarning -> String
$cshow :: OrderFileWarning -> String
showsPrec :: Int -> OrderFileWarning -> ShowS
$cshowsPrec :: Int -> OrderFileWarning -> ShowS
Show)

-- | An enumeration of various types of failures (errors or warnings)
--   that can occur.
data SystemFailure
  = AssetNotLoaded Asset FilePath LoadingFailure
  | ScenarioNotFound FilePath
  | OrderFileWarning FilePath OrderFileWarning
  | CustomFailure Text
  deriving (Int -> SystemFailure -> ShowS
[SystemFailure] -> ShowS
SystemFailure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemFailure] -> ShowS
$cshowList :: [SystemFailure] -> ShowS
show :: SystemFailure -> String
$cshow :: SystemFailure -> String
showsPrec :: Int -> SystemFailure -> ShowS
$cshowsPrec :: Int -> SystemFailure -> ShowS
Show)

------------------------------------------------------------
-- Pretty-printing

instance PrettyPrec AssetData where
  prettyPrec :: forall ann. Int -> AssetData -> Doc ann
prettyPrec Int
_ = \case
    AssetData
NameGeneration -> Doc ann
"name generation data"
    AssetData
AppAsset -> Doc ann
"data assets"
    AssetData
d -> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> Text
showLowT AssetData
d)

instance PrettyPrec Asset where
  prettyPrec :: forall ann. Int -> Asset -> Doc ann
prettyPrec Int
_ = \case
    Data AssetData
ad -> forall a ann. PrettyPrec a => a -> Doc ann
ppr AssetData
ad
    Asset
a -> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> Text
showLowT Asset
a)

instance PrettyPrec Entry where
  prettyPrec :: forall ann. Int -> Entry -> Doc ann
prettyPrec Int
_ = forall a ann. Show a => a -> Doc ann
prettyShowLow

instance PrettyPrec LoadingFailure where
  prettyPrec :: forall ann. Int -> LoadingFailure -> Doc ann
prettyPrec Int
_ = \case
    DoesNotExist Entry
e -> Doc ann
"The" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr Entry
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"is missing!"
    EntryNot Entry
e -> Doc ann
"The entry is not a" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr Entry
e forall a. Semigroup a => a -> a -> a
<> Doc ann
"!"
    CanNotParseYaml ParseException
p ->
      forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vcat forall a b. (a -> b) -> a -> b
$
        Doc ann
"Parse failure:"
          forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Text]
T.lines (forall target source. From source target => source -> target
into @Text (ParseException -> String
prettyPrintParseException ParseException
p)))
    CanNotParseMegaparsec ParseErrorBundle Text Void
p ->
      forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vcat forall a b. (a -> b) -> a -> b
$
        Doc ann
"Parse failure:"
          forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Text]
T.lines (forall target source. From source target => source -> target
into @Text (forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
p)))
    DoesNotTypecheck Text
t ->
      forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vcat forall a b. (a -> b) -> a -> b
$
        Doc ann
"Parse failure:"
          forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Text]
T.lines Text
t)
    Duplicate AssetData
thing Text
duped -> Doc ann
"Duplicate" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr AssetData
thing forall a. Semigroup a => a -> a -> a
<> Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Text
duped)
    CustomMessage Text
m -> forall a ann. Pretty a => a -> Doc ann
pretty Text
m

instance PrettyPrec OrderFileWarning where
  prettyPrec :: forall ann. Int -> OrderFileWarning -> Doc ann
prettyPrec Int
_ = \case
    OrderFileWarning
NoOrderFile -> Doc ann
"File not found; using alphabetical order"
    MissingFiles NonEmpty String
missing ->
      forall a ann. PrettyPrec a => a -> Doc ann
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. (forall a. Doc a) -> [i] -> BulletList i
BulletList Doc a
"Files not listed will be ignored:" forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (forall target source. From source target => source -> target
into @Text) (forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
missing)
    DanglingFiles NonEmpty String
dangling ->
      forall a ann. PrettyPrec a => a -> Doc ann
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. (forall a. Doc a) -> [i] -> BulletList i
BulletList Doc a
"Some listed files do not exist:" forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (forall target source. From source target => source -> target
into @Text) (forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
dangling)

instance PrettyPrec SystemFailure where
  prettyPrec :: forall ann. Int -> SystemFailure -> Doc ann
prettyPrec Int
_ = \case
    AssetNotLoaded Asset
a String
fp LoadingFailure
l ->
      forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vcat forall a b. (a -> b) -> a -> b
$
        [ Doc ann
"Failed to acquire" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr Asset
a forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"from path" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty String
fp) forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
        , forall a ann. PrettyPrec a => a -> Doc ann
ppr LoadingFailure
l
        ]
    ScenarioNotFound String
s -> Doc ann
"Scenario not found:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
s
    OrderFileWarning String
orderFile OrderFileWarning
w ->
      forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vcat forall a b. (a -> b) -> a -> b
$
        [ Doc ann
"Warning: while processing" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
orderFile forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
        , forall a ann. PrettyPrec a => a -> Doc ann
ppr OrderFileWarning
w
        ]
    CustomFailure Text
m -> forall a ann. Pretty a => a -> Doc ann
pretty Text
m