module Ribosome.Error.Report.Class where

import qualified Data.Text as Text (pack)
import GHC.Generics (K1(..), M1(..), Rep, from, (:+:)(..))
import System.Log.Logger (Priority(NOTICE, DEBUG))

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

class ReportError a where
  errorReport :: a -> ErrorReport
  default errorReport ::
    Generic a =>
    GenReportError (Rep a) =>
    a ->
    ErrorReport
  errorReport =
    Rep a Any -> ErrorReport
forall k (f :: k -> *) (a :: k).
GenReportError f =>
f a -> ErrorReport
genErrorReport (Rep a Any -> ErrorReport) -> (a -> Rep a Any) -> a -> ErrorReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

class GenReportError f where
  genErrorReport :: f a -> ErrorReport

instance GenReportError f => GenReportError (M1 i c f) where
  genErrorReport :: M1 i c f a -> ErrorReport
genErrorReport =
    f a -> ErrorReport
forall k (f :: k -> *) (a :: k).
GenReportError f =>
f a -> ErrorReport
genErrorReport (f a -> ErrorReport)
-> (M1 i c f a -> f a) -> M1 i c f a -> ErrorReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

instance (GenReportError f, GenReportError g) => GenReportError (f :+: g) where
  genErrorReport :: (:+:) f g a -> ErrorReport
genErrorReport (L1 f a
a) =
    f a -> ErrorReport
forall k (f :: k -> *) (a :: k).
GenReportError f =>
f a -> ErrorReport
genErrorReport f a
a
  genErrorReport (R1 g a
a) =
    g a -> ErrorReport
forall k (f :: k -> *) (a :: k).
GenReportError f =>
f a -> ErrorReport
genErrorReport g a
a

instance ReportError a => GenReportError (K1 i a) where
  genErrorReport :: K1 i a a -> ErrorReport
genErrorReport =
    a -> ErrorReport
forall a. ReportError a => a -> ErrorReport
errorReport (a -> ErrorReport) -> (K1 i a a -> a) -> K1 i a a -> ErrorReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a a -> a
forall i c k (p :: k). K1 i c p -> c
unK1

instance ReportError [Char] where
  errorReport :: [Char] -> ErrorReport
errorReport [Char]
msg = Text -> [Text] -> Priority -> ErrorReport
ErrorReport ([Char] -> Text
Text.pack [Char]
msg) ([Char] -> Text
Text.pack ([Char] -> Text) -> [[Char]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]
Item [[Char]]
msg]) Priority
NOTICE

instance ReportError [[Char]] where
  errorReport :: [[Char]] -> ErrorReport
errorReport ([Char]
msg : [[Char]]
extra) = Text -> [Text] -> Priority -> ErrorReport
ErrorReport ([Char] -> Text
Text.pack [Char]
msg) ([Char] -> Text
Text.pack ([Char] -> Text) -> [[Char]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char]
msg [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
extra)) Priority
NOTICE
  errorReport [] = Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"empty error" [Item [Text]
"empty error"] Priority
DEBUG

instance ReportError Text where
  errorReport :: Text -> ErrorReport
errorReport Text
msg = Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Text
Item [Text]
msg] Priority
NOTICE

instance ReportError [Text] where
  errorReport :: [Text] -> ErrorReport
errorReport (Text
msg : [Text]
extra) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg (Text
msg Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
extra) Priority
NOTICE
  errorReport [] = Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"empty error" [Item [Text]
"empty error"] Priority
DEBUG

instance ReportError () where
  errorReport :: () -> ErrorReport
errorReport ()
_ = Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"" [] Priority
DEBUG