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