module Ribosome.Data.Errors(
  ComponentName(..),
  Errors(..),
  Error(..),
  componentErrors,
  timestamp,
  report,
) where

import qualified Data.Map.Strict as Map (toList)
import Data.Text.Prettyprint.Doc (Doc, Pretty(..), align, line, vsep, (<+>))
import Prelude hiding (error)

import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))

newtype ComponentName =
  ComponentName Text
  deriving (ComponentName -> ComponentName -> Bool
(ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> Bool) -> Eq ComponentName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentName -> ComponentName -> Bool
$c/= :: ComponentName -> ComponentName -> Bool
== :: ComponentName -> ComponentName -> Bool
$c== :: ComponentName -> ComponentName -> Bool
Eq, Eq ComponentName
Eq ComponentName
-> (ComponentName -> ComponentName -> Ordering)
-> (ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> Bool)
-> (ComponentName -> ComponentName -> ComponentName)
-> (ComponentName -> ComponentName -> ComponentName)
-> Ord ComponentName
ComponentName -> ComponentName -> Bool
ComponentName -> ComponentName -> Ordering
ComponentName -> ComponentName -> ComponentName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentName -> ComponentName -> ComponentName
$cmin :: ComponentName -> ComponentName -> ComponentName
max :: ComponentName -> ComponentName -> ComponentName
$cmax :: ComponentName -> ComponentName -> ComponentName
>= :: ComponentName -> ComponentName -> Bool
$c>= :: ComponentName -> ComponentName -> Bool
> :: ComponentName -> ComponentName -> Bool
$c> :: ComponentName -> ComponentName -> Bool
<= :: ComponentName -> ComponentName -> Bool
$c<= :: ComponentName -> ComponentName -> Bool
< :: ComponentName -> ComponentName -> Bool
$c< :: ComponentName -> ComponentName -> Bool
compare :: ComponentName -> ComponentName -> Ordering
$ccompare :: ComponentName -> ComponentName -> Ordering
$cp1Ord :: Eq ComponentName
Ord, Int -> ComponentName -> ShowS
[ComponentName] -> ShowS
ComponentName -> String
(Int -> ComponentName -> ShowS)
-> (ComponentName -> String)
-> ([ComponentName] -> ShowS)
-> Show ComponentName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentName] -> ShowS
$cshowList :: [ComponentName] -> ShowS
show :: ComponentName -> String
$cshow :: ComponentName -> String
showsPrec :: Int -> ComponentName -> ShowS
$cshowsPrec :: Int -> ComponentName -> ShowS
Show)

data Error =
  Error {
    Error -> Int
_timestamp :: Int,
    Error -> ErrorReport
_report :: ErrorReport
  }
  deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

makeClassy ''Error

instance Pretty Error where
  pretty :: Error -> Doc ann
pretty (Error Int
stamp (ErrorReport Text
_ [Text]
lines' Priority
_)) =
    Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
stamp Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> [Text] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
lines'))

newtype Errors =
  Errors {
    Errors -> Map ComponentName [Error]
_componentErrors :: Map ComponentName [Error]
    }
  deriving (Errors -> Errors -> Bool
(Errors -> Errors -> Bool)
-> (Errors -> Errors -> Bool) -> Eq Errors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Errors -> Errors -> Bool
$c/= :: Errors -> Errors -> Bool
== :: Errors -> Errors -> Bool
$c== :: Errors -> Errors -> Bool
Eq, Int -> Errors -> ShowS
[Errors] -> ShowS
Errors -> String
(Int -> Errors -> ShowS)
-> (Errors -> String) -> ([Errors] -> ShowS) -> Show Errors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Errors] -> ShowS
$cshowList :: [Errors] -> ShowS
show :: Errors -> String
$cshow :: Errors -> String
showsPrec :: Int -> Errors -> ShowS
$cshowsPrec :: Int -> Errors -> ShowS
Show)
  deriving newtype Errors
Errors -> Default Errors
forall a. a -> Default a
def :: Errors
$cdef :: Errors
Default

makeClassy ''Errors

prettyComponentErrors :: ComponentName -> [Error] -> Doc a
prettyComponentErrors :: ComponentName -> [Error] -> Doc a
prettyComponentErrors (ComponentName Text
name) [Error]
errors' =
  Doc a
forall ann. Doc ann
line Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
line Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty Text
name Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
":" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
line Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep (Error -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty (Error -> Doc a) -> [Error] -> [Doc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Error]
errors')

instance Pretty Errors where
  pretty :: Errors -> Doc ann
pretty (Errors Map ComponentName [Error]
errors') =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((ComponentName -> [Error] -> Doc ann)
-> (ComponentName, [Error]) -> Doc ann
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ComponentName -> [Error] -> Doc ann
forall a. ComponentName -> [Error] -> Doc a
prettyComponentErrors ((ComponentName, [Error]) -> Doc ann)
-> [(ComponentName, [Error])] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ComponentName [Error] -> [(ComponentName, [Error])]
forall k a. Map k a -> [(k, a)]
Map.toList Map ComponentName [Error]
errors')