{-# 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
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
min :: NixLevel -> NixLevel -> NixLevel
$cmin :: NixLevel -> NixLevel -> NixLevel
max :: NixLevel -> NixLevel -> NixLevel
$cmax :: NixLevel -> NixLevel -> NixLevel
>= :: NixLevel -> NixLevel -> Bool
$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
compare :: NixLevel -> NixLevel -> Ordering
$ccompare :: NixLevel -> NixLevel -> Ordering
Ord, NixLevel -> NixLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixLevel -> NixLevel -> Bool
$c/= :: NixLevel -> NixLevel -> Bool
== :: NixLevel -> NixLevel -> Bool
$c== :: NixLevel -> NixLevel -> Bool
Eq, NixLevel
forall a. a -> a -> Bounded a
maxBound :: NixLevel
$cmaxBound :: NixLevel
minBound :: NixLevel
$cminBound :: NixLevel
Bounded, Int -> NixLevel
NixLevel -> Int
NixLevel -> [NixLevel]
NixLevel -> NixLevel
NixLevel -> NixLevel -> [NixLevel]
NixLevel -> NixLevel -> NixLevel -> [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
enumFromThenTo :: NixLevel -> NixLevel -> NixLevel -> [NixLevel]
$cenumFromThenTo :: NixLevel -> NixLevel -> NixLevel -> [NixLevel]
enumFromTo :: NixLevel -> NixLevel -> [NixLevel]
$cenumFromTo :: NixLevel -> NixLevel -> [NixLevel]
enumFromThen :: NixLevel -> NixLevel -> [NixLevel]
$cenumFromThen :: NixLevel -> NixLevel -> [NixLevel]
enumFrom :: NixLevel -> [NixLevel]
$cenumFrom :: NixLevel -> [NixLevel]
fromEnum :: NixLevel -> Int
$cfromEnum :: NixLevel -> Int
toEnum :: Int -> NixLevel
$ctoEnum :: Int -> NixLevel
pred :: NixLevel -> NixLevel
$cpred :: NixLevel -> NixLevel
succ :: NixLevel -> NixLevel
$csucc :: NixLevel -> NixLevel
Enum, Int -> NixLevel -> ShowS
[NixLevel] -> ShowS
NixLevel -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NixLevel] -> ShowS
$cshowList :: [NixLevel] -> ShowS
show :: NixLevel -> [Char]
$cshow :: NixLevel -> [Char]
showsPrec :: Int -> NixLevel -> ShowS
$cshowsPrec :: Int -> NixLevel -> ShowS
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 " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NixLevel
level forall a. Semigroup a => a -> a -> a
<> [Char]
": " forall a. Semigroup a => a -> a -> a
<> 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 = 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 -> ShowS
[NixException] -> ShowS
NixException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NixException] -> ShowS
$cshowList :: [NixException] -> ShowS
show :: NixException -> [Char]
$cshow :: NixException -> [Char]
showsPrec :: Int -> NixException -> ShowS
$cshowsPrec :: Int -> NixException -> ShowS
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 = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over forall a b. Has a b => Lens' a b
hasLens (NixLevel -> SomeException -> NixFrame
NixFrame NixLevel
level (forall e. Exception e => e -> SomeException
toException s
f) 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 <- forall t (m :: * -> *) a. (MonadReader t m, Has t a) => m a
askLocal
    forall (m :: * -> *). Monad m => [Char] -> m ()
traceM [Char]
"Throwing fail..."
    forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ [NixFrame] -> NixException
NixException forall a b. (a -> b) -> a -> b
$ NixLevel -> SomeException -> NixFrame
NixFrame NixLevel
Error (forall e. Exception e => e -> SomeException
toException s
err) forall a. a -> [a] -> [a]
: [NixFrame]
context