{-# language ConstraintKinds #-}
{-# language ExistentialQuantification #-}

-- | Definitions of Frames. Frames are messages that gather and ship themself with a context related to the message. For example - the message about some exception would also gather, keep and bring with it the tracing information.
module Nix.Frames
  ( NixLevel(..)
  , Frames
  , askFrames
  , Framed
  , NixFrame(..)
  , NixException(..)
  , withFrame
  , throwError
  , module Data.Typeable
  )
where

import           Nix.Prelude
import           Data.Typeable           hiding ( typeOf )
import           Control.Monad.Catch            ( MonadThrow(..) )
import qualified Text.Show

data NixLevel = Fatal | Error | Warning | Info | Debug
  deriving (Eq NixLevel
Eq NixLevel =>
(NixLevel -> NixLevel -> Ordering)
-> (NixLevel -> NixLevel -> Bool)
-> (NixLevel -> NixLevel -> Bool)
-> (NixLevel -> NixLevel -> Bool)
-> (NixLevel -> NixLevel -> Bool)
-> (NixLevel -> NixLevel -> NixLevel)
-> (NixLevel -> NixLevel -> NixLevel)
-> Ord NixLevel
NixLevel -> NixLevel -> Bool
NixLevel -> NixLevel -> Ordering
NixLevel -> NixLevel -> NixLevel
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
$ccompare :: NixLevel -> NixLevel -> Ordering
compare :: NixLevel -> NixLevel -> Ordering
$c< :: NixLevel -> NixLevel -> Bool
< :: NixLevel -> NixLevel -> Bool
$c<= :: NixLevel -> NixLevel -> Bool
<= :: NixLevel -> NixLevel -> Bool
$c> :: NixLevel -> NixLevel -> Bool
> :: NixLevel -> NixLevel -> Bool
$c>= :: NixLevel -> NixLevel -> Bool
>= :: NixLevel -> NixLevel -> Bool
$cmax :: NixLevel -> NixLevel -> NixLevel
max :: NixLevel -> NixLevel -> NixLevel
$cmin :: NixLevel -> NixLevel -> NixLevel
min :: NixLevel -> NixLevel -> NixLevel
Ord, NixLevel -> NixLevel -> Bool
(NixLevel -> NixLevel -> Bool)
-> (NixLevel -> NixLevel -> Bool) -> Eq NixLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NixLevel -> NixLevel -> Bool
== :: NixLevel -> NixLevel -> Bool
$c/= :: NixLevel -> NixLevel -> Bool
/= :: NixLevel -> NixLevel -> Bool
Eq, NixLevel
NixLevel -> NixLevel -> Bounded NixLevel
forall a. a -> a -> Bounded a
$cminBound :: NixLevel
minBound :: NixLevel
$cmaxBound :: NixLevel
maxBound :: NixLevel
Bounded, Int -> NixLevel
NixLevel -> Int
NixLevel -> [NixLevel]
NixLevel -> NixLevel
NixLevel -> NixLevel -> [NixLevel]
NixLevel -> NixLevel -> NixLevel -> [NixLevel]
(NixLevel -> NixLevel)
-> (NixLevel -> NixLevel)
-> (Int -> NixLevel)
-> (NixLevel -> Int)
-> (NixLevel -> [NixLevel])
-> (NixLevel -> NixLevel -> [NixLevel])
-> (NixLevel -> NixLevel -> [NixLevel])
-> (NixLevel -> NixLevel -> NixLevel -> [NixLevel])
-> Enum NixLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NixLevel -> NixLevel
succ :: NixLevel -> NixLevel
$cpred :: NixLevel -> NixLevel
pred :: NixLevel -> NixLevel
$ctoEnum :: Int -> NixLevel
toEnum :: Int -> NixLevel
$cfromEnum :: NixLevel -> Int
fromEnum :: NixLevel -> Int
$cenumFrom :: NixLevel -> [NixLevel]
enumFrom :: NixLevel -> [NixLevel]
$cenumFromThen :: NixLevel -> NixLevel -> [NixLevel]
enumFromThen :: NixLevel -> NixLevel -> [NixLevel]
$cenumFromTo :: NixLevel -> NixLevel -> [NixLevel]
enumFromTo :: NixLevel -> NixLevel -> [NixLevel]
$cenumFromThenTo :: NixLevel -> NixLevel -> NixLevel -> [NixLevel]
enumFromThenTo :: NixLevel -> NixLevel -> NixLevel -> [NixLevel]
Enum, Int -> NixLevel -> [Char] -> [Char]
[NixLevel] -> [Char] -> [Char]
NixLevel -> [Char]
(Int -> NixLevel -> [Char] -> [Char])
-> (NixLevel -> [Char])
-> ([NixLevel] -> [Char] -> [Char])
-> Show NixLevel
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> NixLevel -> [Char] -> [Char]
showsPrec :: Int -> NixLevel -> [Char] -> [Char]
$cshow :: NixLevel -> [Char]
show :: NixLevel -> [Char]
$cshowList :: [NixLevel] -> [Char] -> [Char]
showList :: [NixLevel] -> [Char] -> [Char]
Show)

data NixFrame =
  NixFrame
    { NixFrame -> NixLevel
frameLevel :: NixLevel
    , NixFrame -> SomeException
frame      :: SomeException
    }

instance Show NixFrame where
  show :: NixFrame -> [Char]
show (NixFrame NixLevel
level SomeException
f) =
    [Char]
"Nix frame at level " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> NixLevel -> [Char]
forall b a. (Show a, IsString b) => a -> b
show NixLevel
level [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SomeException -> [Char]
forall b a. (Show a, IsString b) => a -> b
show SomeException
f

type Frames = [NixFrame]

askFrames :: forall e m . (MonadReader e m, Has e Frames) => m Frames
askFrames :: forall e (m :: * -> *).
(MonadReader e m, Has e [NixFrame]) =>
m [NixFrame]
askFrames = m [NixFrame]
forall t (m :: * -> *) a. (MonadReader t m, Has t a) => m a
askLocal

type Framed e m = (MonadReader e m, Has e Frames, MonadThrow m)

newtype NixException = NixException Frames
  deriving Int -> NixException -> [Char] -> [Char]
[NixException] -> [Char] -> [Char]
NixException -> [Char]
(Int -> NixException -> [Char] -> [Char])
-> (NixException -> [Char])
-> ([NixException] -> [Char] -> [Char])
-> Show NixException
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> NixException -> [Char] -> [Char]
showsPrec :: Int -> NixException -> [Char] -> [Char]
$cshow :: NixException -> [Char]
show :: NixException -> [Char]
$cshowList :: [NixException] -> [Char] -> [Char]
showList :: [NixException] -> [Char] -> [Char]
Show

instance Exception NixException

withFrame
  :: forall s e m a . (Framed e m, Exception s) => NixLevel -> s -> m a -> m a
withFrame :: forall s e (m :: * -> *) a.
(Framed e m, Exception s) =>
NixLevel -> s -> m a -> m a
withFrame NixLevel
level s
f = (e -> e) -> m a -> m a
forall a. (e -> e) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((e -> e) -> m a -> m a) -> (e -> e) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Setter e e [NixFrame] [NixFrame]
-> ([NixFrame] -> [NixFrame]) -> e -> e
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over LensLike' f e [NixFrame]
forall a b. Has a b => Lens' a b
Lens' e [NixFrame]
Setter e e [NixFrame] [NixFrame]
hasLens (NixLevel -> SomeException -> NixFrame
NixFrame NixLevel
level (s -> SomeException
forall e. Exception e => e -> SomeException
toException s
f) NixFrame -> [NixFrame] -> [NixFrame]
forall a. a -> [a] -> [a]
:)

throwError
  :: forall s e m a . (Framed e m, Exception s, MonadThrow m) => s -> m a
throwError :: forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError s
err =
  do
    [NixFrame]
context <- m [NixFrame]
forall t (m :: * -> *) a. (MonadReader t m, Has t a) => m a
askLocal
    [Char] -> m ()
forall (m :: * -> *). Monad m => [Char] -> m ()
traceM [Char]
"Throwing fail..."
    NixException -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (NixException -> m a) -> NixException -> m a
forall a b. (a -> b) -> a -> b
$ [NixFrame] -> NixException
NixException ([NixFrame] -> NixException) -> [NixFrame] -> NixException
forall a b. (a -> b) -> a -> b
$ NixLevel -> SomeException -> NixFrame
NixFrame NixLevel
Error (s -> SomeException
forall e. Exception e => e -> SomeException
toException s
err) NixFrame -> [NixFrame] -> [NixFrame]
forall a. a -> [a] -> [a]
: [NixFrame]
context