{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Hercules.CNix.Verbosity
  ( Verbosity (..),
    setVerbosity,
    getVerbosity,
    setShowTrace,
    getShowTrace,
  )
where

import Foreign (fromBool, toBool)
import Hercules.CNix.Store.Context (context)
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Inline.Cpp.Exception as C
import Protolude

C.context context

C.include "<nix/config.h>"
C.include "<nix/error.hh>"
C.include "<nix/globals.hh>"
C.include "<nix/logging.hh>"

data Verbosity
  = Error
  | Warn
  | Notice
  | Info
  | Talkative
  | Chatty
  | Debug
  | Vomit
  deriving (Verbosity -> Verbosity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Eq Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
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 :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
Ord, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
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 :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum, Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> [Char]
$cshow :: Verbosity -> [Char]
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show, ReadPrec [Verbosity]
ReadPrec Verbosity
Int -> ReadS Verbosity
ReadS [Verbosity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Verbosity]
$creadListPrec :: ReadPrec [Verbosity]
readPrec :: ReadPrec Verbosity
$creadPrec :: ReadPrec Verbosity
readList :: ReadS [Verbosity]
$creadList :: ReadS [Verbosity]
readsPrec :: Int -> ReadS Verbosity
$creadsPrec :: Int -> ReadS Verbosity
Read)

setVerbosity :: Verbosity -> IO ()
setVerbosity :: Verbosity -> IO ()
setVerbosity Verbosity
Error = [C.throwBlock| void { nix::verbosity = nix::lvlError; } |]
setVerbosity Verbosity
Warn = [C.throwBlock| void { nix::verbosity = nix::lvlWarn; } |]
setVerbosity Verbosity
Notice = [C.throwBlock| void { nix::verbosity = nix::lvlNotice; } |]
setVerbosity Verbosity
Info = [C.throwBlock| void { nix::verbosity = nix::lvlInfo; } |]
setVerbosity Verbosity
Talkative = [C.throwBlock| void { nix::verbosity = nix::lvlTalkative; } |]
setVerbosity Verbosity
Chatty = [C.throwBlock| void { nix::verbosity = nix::lvlChatty; } |]
setVerbosity Verbosity
Debug = [C.throwBlock| void { nix::verbosity = nix::lvlDebug; } |]
setVerbosity Verbosity
Vomit = [C.throwBlock| void { nix::verbosity = nix::lvlVomit; } |]

getVerbosity :: IO Verbosity
getVerbosity :: IO Verbosity
getVerbosity =
  [C.throwBlock| int { switch(nix::verbosity) {
    case nix::lvlError: return 1;
    case nix::lvlWarn: return 2;
    case nix::lvlNotice: return 3;
    case nix::lvlInfo: return 4;
    case nix::lvlTalkative: return 5;
    case nix::lvlChatty: return 6;
    case nix::lvlDebug: return 7;
    case nix::lvlVomit: return 8;
    default: return 0;
  } }|]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CInt
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Error
      CInt
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Warn
      CInt
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Notice
      CInt
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Info
      CInt
5 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Talkative
      CInt
6 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Chatty
      CInt
7 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Debug
      CInt
8 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Vomit
      CInt
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Text -> FatalError
FatalError Text
"Unknown nix::verbosity value")

getShowTrace :: IO Bool
getShowTrace :: IO Bool
getShowTrace =
  [C.throwBlock| bool { return nix::loggerSettings.showTrace.get(); }|]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. (Eq a, Num a) => a -> Bool
toBool

setShowTrace :: Bool -> IO ()
setShowTrace :: Bool -> IO ()
setShowTrace Bool
b =
  let b' :: CBool
b' = forall a. Num a => Bool -> a
fromBool Bool
b
   in [C.throwBlock| void { nix::loggerSettings.showTrace.assign($(bool b')); }|]