{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

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
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
$cp1Ord :: Eq NixLevel
Ord, NixLevel -> NixLevel -> Bool
(NixLevel -> NixLevel -> Bool)
-> (NixLevel -> NixLevel -> Bool) -> Eq NixLevel
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
NixLevel -> NixLevel -> Bounded 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]
(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
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 -> String
(Int -> NixLevel -> ShowS)
-> (NixLevel -> String) -> ([NixLevel] -> ShowS) -> Show NixLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixLevel] -> ShowS
$cshowList :: [NixLevel] -> ShowS
show :: NixLevel -> String
$cshow :: NixLevel -> String
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 -> String
show (NixFrame level :: NixLevel
level f :: SomeException
f) =
    "Nix frame at level " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NixLevel -> String
forall a. Show a => a -> String
show NixLevel
level String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
f

type Frames = [NixFrame]

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

newtype NixException = NixException Frames
    deriving Int -> NixException -> ShowS
[NixException] -> ShowS
NixException -> String
(Int -> NixException -> ShowS)
-> (NixException -> String)
-> ([NixException] -> ShowS)
-> Show NixException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixException] -> ShowS
$cshowList :: [NixException] -> ShowS
show :: NixException -> String
$cshow :: NixException -> String
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 :: NixLevel -> s -> m a -> m a
withFrame level :: NixLevel
level f :: s
f = (e -> e) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Setter e e [NixFrame] [NixFrame]
-> ([NixFrame] -> [NixFrame]) -> e -> e
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over forall a b. Has a b => Lens' a b
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 :: s -> m a
throwError err :: s
err = do
  [NixFrame]
context <- (e -> [NixFrame]) -> m [NixFrame]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike [NixFrame] e e [NixFrame] [NixFrame] -> e -> [NixFrame]
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike [NixFrame] e e [NixFrame] [NixFrame]
forall a b. Has a b => Lens' a b
hasLens)
  String -> m ()
forall (m :: * -> *). Monad m => String -> m ()
traceM "Throwing error..."
  NixException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (NixException -> m a) -> NixException -> m a
forall a b. (a -> b) -> a -> b
$ [NixFrame] -> NixException
NixException (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)