{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Navi.Config.Types
(
Config (..),
ConfigErr (..),
Logging (..),
LogLoc (..),
FilesSizeMode (..),
defaultLogging,
defaultSizeMode,
NoteSystem (..),
defaultNoteSystem,
)
where
import DBus.Client qualified as DBus
import Data.Bytes (Size (M))
import Data.Bytes qualified as Bytes
import Data.List.NonEmpty ()
import Navi.Config.Phase (ConfigPhase (ConfigPhaseEnv, ConfigPhaseToml))
import Navi.Event (AnyEvent)
import Navi.Prelude
data LogLoc
= DefPath
| Stdout
| File OsPath
deriving stock (LogLoc -> LogLoc -> Bool
(LogLoc -> LogLoc -> Bool)
-> (LogLoc -> LogLoc -> Bool) -> Eq LogLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLoc -> LogLoc -> Bool
== :: LogLoc -> LogLoc -> Bool
$c/= :: LogLoc -> LogLoc -> Bool
/= :: LogLoc -> LogLoc -> Bool
Eq, Int -> LogLoc -> ShowS
[LogLoc] -> ShowS
LogLoc -> String
(Int -> LogLoc -> ShowS)
-> (LogLoc -> String) -> ([LogLoc] -> ShowS) -> Show LogLoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLoc -> ShowS
showsPrec :: Int -> LogLoc -> ShowS
$cshow :: LogLoc -> String
show :: LogLoc -> String
$cshowList :: [LogLoc] -> ShowS
showList :: [LogLoc] -> ShowS
Show)
data FilesSizeMode
=
FilesSizeModeWarn (Bytes B Natural)
|
FilesSizeModeDelete (Bytes B Natural)
deriving stock (FilesSizeMode -> FilesSizeMode -> Bool
(FilesSizeMode -> FilesSizeMode -> Bool)
-> (FilesSizeMode -> FilesSizeMode -> Bool) -> Eq FilesSizeMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilesSizeMode -> FilesSizeMode -> Bool
== :: FilesSizeMode -> FilesSizeMode -> Bool
$c/= :: FilesSizeMode -> FilesSizeMode -> Bool
/= :: FilesSizeMode -> FilesSizeMode -> Bool
Eq, Int -> FilesSizeMode -> ShowS
[FilesSizeMode] -> ShowS
FilesSizeMode -> String
(Int -> FilesSizeMode -> ShowS)
-> (FilesSizeMode -> String)
-> ([FilesSizeMode] -> ShowS)
-> Show FilesSizeMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilesSizeMode -> ShowS
showsPrec :: Int -> FilesSizeMode -> ShowS
$cshow :: FilesSizeMode -> String
show :: FilesSizeMode -> String
$cshowList :: [FilesSizeMode] -> ShowS
showList :: [FilesSizeMode] -> ShowS
Show)
data Logging = MkLogging
{
Logging -> Maybe LogLevel
severity :: Maybe LogLevel,
Logging -> Maybe LogLoc
location :: Maybe LogLoc,
Logging -> Maybe FilesSizeMode
sizeMode :: Maybe FilesSizeMode
}
deriving stock (Logging -> Logging -> Bool
(Logging -> Logging -> Bool)
-> (Logging -> Logging -> Bool) -> Eq Logging
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Logging -> Logging -> Bool
== :: Logging -> Logging -> Bool
$c/= :: Logging -> Logging -> Bool
/= :: Logging -> Logging -> Bool
Eq, Int -> Logging -> ShowS
[Logging] -> ShowS
Logging -> String
(Int -> Logging -> ShowS)
-> (Logging -> String) -> ([Logging] -> ShowS) -> Show Logging
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Logging -> ShowS
showsPrec :: Int -> Logging -> ShowS
$cshow :: Logging -> String
show :: Logging -> String
$cshowList :: [Logging] -> ShowS
showList :: [Logging] -> ShowS
Show)
makeFieldLabelsNoPrefix ''Logging
type DBusF :: ConfigPhase -> Type
type family DBusF p where
DBusF ConfigPhaseToml = ()
DBusF ConfigPhaseEnv = DBus.Client
type NoteSystem :: ConfigPhase -> Type
data NoteSystem p
=
AppleScript
|
DBus (DBusF p)
|
NotifySend
deriving stock instance Eq (NoteSystem ConfigPhaseToml)
deriving stock instance Show (NoteSystem ConfigPhaseToml)
defaultNoteSystem :: NoteSystem ConfigPhaseToml
#if OSX
defaultNoteSystem = AppleScript
#else
defaultNoteSystem :: NoteSystem 'ConfigPhaseToml
defaultNoteSystem = DBusF 'ConfigPhaseToml -> NoteSystem 'ConfigPhaseToml
forall (p :: ConfigPhase). DBusF p -> NoteSystem p
DBus ()
#endif
defaultLogging :: Logging
defaultLogging :: Logging
defaultLogging =
Maybe LogLevel -> Maybe LogLoc -> Maybe FilesSizeMode -> Logging
MkLogging
(LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelError)
(LogLoc -> Maybe LogLoc
forall a. a -> Maybe a
Just LogLoc
DefPath)
(FilesSizeMode -> Maybe FilesSizeMode
forall a. a -> Maybe a
Just FilesSizeMode
defaultSizeMode)
defaultSizeMode :: FilesSizeMode
defaultSizeMode :: FilesSizeMode
defaultSizeMode = Bytes 'B Natural -> FilesSizeMode
FilesSizeModeDelete (Bytes 'B Natural -> FilesSizeMode)
-> Bytes 'B Natural -> FilesSizeMode
forall a b. (a -> b) -> a -> b
$ Bytes 'M Natural -> Converted 'B (Bytes 'M Natural)
forall a (t :: Size). (Conversion a, SingI t) => a -> Converted t a
forall (t :: Size).
SingI t =>
Bytes 'M Natural -> Converted t (Bytes 'M Natural)
Bytes.convert_ Bytes 'M Natural
fiftyMb
where
fiftyMb :: Bytes 'M Natural
fiftyMb = forall (s :: Size) n. n -> Bytes s n
MkBytes @M Natural
50
data Config = MkConfig
{
Config -> NonEmpty AnyEvent
events :: NonEmpty AnyEvent,
Config -> Logging
logging :: Logging,
Config -> NoteSystem 'ConfigPhaseToml
noteSystem :: NoteSystem ConfigPhaseToml
}
deriving stock (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)
makeFieldLabelsNoPrefix ''Config
data ConfigErr
= FileErr SomeException
| TomlError TOMLError
| NoEvents
deriving stock (Int -> ConfigErr -> ShowS
[ConfigErr] -> ShowS
ConfigErr -> String
(Int -> ConfigErr -> ShowS)
-> (ConfigErr -> String)
-> ([ConfigErr] -> ShowS)
-> Show ConfigErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigErr -> ShowS
showsPrec :: Int -> ConfigErr -> ShowS
$cshow :: ConfigErr -> String
show :: ConfigErr -> String
$cshowList :: [ConfigErr] -> ShowS
showList :: [ConfigErr] -> ShowS
Show)
instance Exception ConfigErr where
displayException :: ConfigErr -> String
displayException (FileErr SomeException
ex) = String
"Error reading file: <" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
ex String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">"
displayException ConfigErr
NoEvents = String
"No events found"
displayException (TomlError TOMLError
err) = Text -> String
unpackText (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ TOMLError -> Text
renderTOMLError TOMLError
err