{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

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

    -- * Logging
    Logging (..),
    LogLoc (..),
    _DefPath,
    _Stdout,
    _File,
    defaultLogging,

    -- * Note System
    NoteSystem (..),
    _DBus,
    _NotifySend,
    defaultNoteSystem,
  )
where

import Data.List.NonEmpty
import Navi.Event (AnyEvent (..))
import Navi.Prelude

-- | Log location configuration.
data LogLoc
  = DefPath
  | Stdout
  | File !Path
  deriving stock (LogLoc -> LogLoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLoc -> LogLoc -> Bool
$c/= :: LogLoc -> LogLoc -> Bool
== :: LogLoc -> LogLoc -> Bool
$c== :: LogLoc -> LogLoc -> Bool
Eq, Int -> LogLoc -> ShowS
[LogLoc] -> ShowS
LogLoc -> Path
forall a.
(Int -> a -> ShowS) -> (a -> Path) -> ([a] -> ShowS) -> Show a
showList :: [LogLoc] -> ShowS
$cshowList :: [LogLoc] -> ShowS
show :: LogLoc -> Path
$cshow :: LogLoc -> Path
showsPrec :: Int -> LogLoc -> ShowS
$cshowsPrec :: Int -> LogLoc -> ShowS
Show)

makePrisms ''LogLoc

-- | Logging configuration.
data Logging = MkLogging
  { -- | Determines the log level.
    Logging -> Maybe LogLevel
severity :: !(Maybe LogLevel),
    -- | Deterines the log location (i.e. file or stdout).
    Logging -> Maybe LogLoc
location :: !(Maybe LogLoc)
  }
  deriving stock (Logging -> Logging -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Logging -> Logging -> Bool
$c/= :: Logging -> Logging -> Bool
== :: Logging -> Logging -> Bool
$c== :: Logging -> Logging -> Bool
Eq, Int -> Logging -> ShowS
[Logging] -> ShowS
Logging -> Path
forall a.
(Int -> a -> ShowS) -> (a -> Path) -> ([a] -> ShowS) -> Show a
showList :: [Logging] -> ShowS
$cshowList :: [Logging] -> ShowS
show :: Logging -> Path
$cshow :: Logging -> Path
showsPrec :: Int -> Logging -> ShowS
$cshowsPrec :: Int -> Logging -> ShowS
Show)

makeFieldLabelsNoPrefix ''Logging

-- | Configuration for notification systems.
data NoteSystem
  = -- | For use with a running notification server that receives messages
    -- via DBus.
    DBus
  | -- | For use with the notify-send tool.
    NotifySend
  deriving stock (NoteSystem -> NoteSystem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteSystem -> NoteSystem -> Bool
$c/= :: NoteSystem -> NoteSystem -> Bool
== :: NoteSystem -> NoteSystem -> Bool
$c== :: NoteSystem -> NoteSystem -> Bool
Eq, Int -> NoteSystem -> ShowS
[NoteSystem] -> ShowS
NoteSystem -> Path
forall a.
(Int -> a -> ShowS) -> (a -> Path) -> ([a] -> ShowS) -> Show a
showList :: [NoteSystem] -> ShowS
$cshowList :: [NoteSystem] -> ShowS
show :: NoteSystem -> Path
$cshow :: NoteSystem -> Path
showsPrec :: Int -> NoteSystem -> ShowS
$cshowsPrec :: Int -> NoteSystem -> ShowS
Show)

makePrisms ''NoteSystem

-- | Default notification system i.e. DBus.
defaultNoteSystem :: NoteSystem
defaultNoteSystem :: NoteSystem
defaultNoteSystem = NoteSystem
DBus
{-# INLINEABLE defaultNoteSystem #-}

-- | Default logging i.e. log errors and use the default path.
defaultLogging :: Logging
defaultLogging :: Logging
defaultLogging = Maybe LogLevel -> Maybe LogLoc -> Logging
MkLogging (forall a. a -> Maybe a
Just LogLevel
LevelError) (forall a. a -> Maybe a
Just LogLoc
DefPath)
{-# INLINEABLE defaultLogging #-}

-- | '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
noteSystem :: !NoteSystem
  }

makeFieldLabelsNoPrefix ''Config

instance Show Config where
  show :: Config -> Path
show Config
config =
    Path
"MkConfig {events = "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Path
show (Config
config forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "events" a => a
#events)
      forall a. Semigroup a => a -> a -> a
<> Path
", logging = "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Path
show (Config
config forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "logging" a => a
#logging)
      forall a. Semigroup a => a -> a -> a
<> Path
"}"
  {-# INLINEABLE show #-}

-- | '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 -> Path
forall a.
(Int -> a -> ShowS) -> (a -> Path) -> ([a] -> ShowS) -> Show a
showList :: [ConfigErr] -> ShowS
$cshowList :: [ConfigErr] -> ShowS
show :: ConfigErr -> Path
$cshow :: ConfigErr -> Path
showsPrec :: Int -> ConfigErr -> ShowS
$cshowsPrec :: Int -> ConfigErr -> ShowS
Show)

instance Exception ConfigErr where
  displayException :: ConfigErr -> Path
displayException (FileErr SomeException
ex) = Path
"Error reading file: <" forall a. Semigroup a => a -> a -> a
<> forall e. Exception e => e -> Path
displayException SomeException
ex forall a. Semigroup a => a -> a -> a
<> Path
">"
  displayException ConfigErr
NoEvents = Path
"No events found"
  displayException (TomlError TOMLError
err) = Text -> Path
unpack forall a b. (a -> b) -> a -> b
$ TOMLError -> Text
renderTOMLError TOMLError
err
  {-# INLINEABLE displayException #-}

makePrisms ''ConfigErr