{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides configuration types.
module Navi.Config.Types
  ( -- * Config
    Config (..),
    ConfigErr (..),

    -- * Logging
    Logging (..),
    LogLoc (..),
    FilesSizeMode (..),
    defaultLogging,
    defaultSizeMode,

    -- * Note System
    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

-- | Log location configuration.
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)

-- | Determines what to do if the log file surpasses the given size
-- threshold.
data FilesSizeMode
  = -- | Print a warning.
    FilesSizeModeWarn (Bytes B Natural)
  | -- | Delete the file.
    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)

-- | Logging configuration.
data Logging = MkLogging
  { -- | Determines the log level.
    Logging -> Maybe LogLevel
severity :: Maybe LogLevel,
    -- | Determines the log location (i.e. file or stdout).
    Logging -> Maybe LogLoc
location :: Maybe LogLoc,
    -- | Determines whether to warn/delete large log files.
    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

-- | Configuration for notification systems.
type NoteSystem :: ConfigPhase -> Type
data NoteSystem p
  = -- | For use with osx.
    AppleScript
  | -- | For use with a running notification server that receives messages
    -- via DBus.
    DBus (DBusF p)
  | -- | For use with the notify-send tool.
    NotifySend

deriving stock instance Eq (NoteSystem ConfigPhaseToml)

deriving stock instance Show (NoteSystem ConfigPhaseToml)

-- | Default notification system i.e. DBus for linux, AppleScript for osx.
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

-- | Default logging i.e. log errors and use the default path.
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)

-- | @since 0.1
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

-- | 'Config' holds the data from 'Navi.Config.Toml.ConfigToml' once it has been processed
-- (e.g., all user defined Events are parsed).
data Config = MkConfig
  { -- | The notification events.
    Config -> NonEmpty AnyEvent
events :: NonEmpty AnyEvent,
    -- | Logging configuration.
    Config -> Logging
logging :: Logging,
    -- | The notification system to use.
    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

-- | 'ConfigErr' represents the errors we can encounter when attempting to
-- parse a config file.
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