2018-04-24 11:14:27 +02:00
|
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
|
|
{-# LANGUAGE ExistentialQuantification #-}
|
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
|
2019-03-17 22:47:38 +01:00
|
|
|
module Nix.Frames
|
|
|
|
( NixLevel(..)
|
|
|
|
, Frames
|
|
|
|
, Framed
|
|
|
|
, NixFrame(..)
|
|
|
|
, NixException(..)
|
|
|
|
, withFrame
|
|
|
|
, throwError
|
|
|
|
, module Data.Typeable
|
|
|
|
, module Control.Exception
|
|
|
|
)
|
|
|
|
where
|
|
|
|
|
|
|
|
import Control.Exception hiding ( catch
|
|
|
|
, evaluate
|
|
|
|
)
|
|
|
|
import Control.Monad.Catch
|
|
|
|
import Control.Monad.Reader
|
|
|
|
import Data.Typeable hiding ( typeOf )
|
|
|
|
import Nix.Utils
|
2018-04-24 11:14:27 +02:00
|
|
|
|
|
|
|
data NixLevel = Fatal | Error | Warning | Info | Debug
|
|
|
|
deriving (Ord, Eq, Bounded, Enum, Show)
|
|
|
|
|
|
|
|
data NixFrame = NixFrame
|
|
|
|
{ frameLevel :: NixLevel
|
2018-05-02 02:33:17 +02:00
|
|
|
, frame :: SomeException
|
2018-04-24 11:14:27 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
instance Show NixFrame where
|
2019-03-17 22:47:38 +01:00
|
|
|
show (NixFrame level f) =
|
|
|
|
"Nix frame at level " ++ show level ++ ": " ++ show f
|
2018-04-24 11:14:27 +02:00
|
|
|
|
|
|
|
type Frames = [NixFrame]
|
|
|
|
|
|
|
|
type Framed e m = (MonadReader e m, Has e Frames, MonadThrow m)
|
|
|
|
|
|
|
|
newtype NixException = NixException Frames
|
|
|
|
deriving Show
|
|
|
|
|
|
|
|
instance Exception NixException
|
|
|
|
|
2019-03-17 22:47:38 +01:00
|
|
|
withFrame
|
|
|
|
:: forall s e m a . (Framed e m, Exception s) => NixLevel -> s -> m a -> m a
|
2018-05-02 02:33:17 +02:00
|
|
|
withFrame level f = local (over hasLens (NixFrame level (toException f) :))
|
2018-04-24 11:14:27 +02:00
|
|
|
|
2019-03-17 22:47:38 +01:00
|
|
|
throwError
|
|
|
|
:: forall s e m a . (Framed e m, Exception s, MonadThrow m) => s -> m a
|
2018-04-24 11:14:27 +02:00
|
|
|
throwError err = do
|
2019-03-17 22:47:38 +01:00
|
|
|
context <- asks (view hasLens)
|
|
|
|
traceM "Throwing error..."
|
|
|
|
throwM $ NixException (NixFrame Error (toException err) : context)
|