-- | This modules provides functionality for parsing configuration data
-- from a toml file.
module Navi.Config
  ( -- * Config
    readConfig,
    ConfigErr (..),
    Config (..),

    -- * Logging
    Logging (..),
    LogLoc (..),

    -- * Note System
    NoteSystem (..),
  )
where

import Data.Maybe (catMaybes)
import Navi.Config.Toml (ConfigToml)
import Navi.Config.Types
  ( Config (..),
    ConfigErr (..),
    LogLoc (..),
    Logging (..),
    NoteSystem (..),
    defaultLogging,
    defaultNoteSystem,
  )
import Navi.Prelude
import Navi.Services.Battery.Percentage qualified as BattState
import Navi.Services.Battery.Status qualified as BattChargeStatus
import Navi.Services.Custom qualified as Custom
import Navi.Services.Network.NetInterfaces qualified as NetConn

-- | Parses the provided toml file into a 'Config'. Throws 'ConfigErr' if
-- anything goes wrong.
readConfig ::
  ( HasCallStack,
    MonadFileReader m,
    MonadIORef m,
    MonadThrow m
  ) =>
  OsPath ->
  m Config
readConfig :: forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m, MonadIORef m, MonadThrow m) =>
OsPath -> m Config
readConfig =
  OsPath -> m Text
forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m, MonadThrow m) =>
OsPath -> m Text
readFileUtf8ThrowM (OsPath -> m Text) -> (Text -> m Config) -> OsPath -> m Config
forall (m :: Type -> Type) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Text
contents -> do
    -- FIXME: Unused keys do not cause errors. This should probably be addressed
    -- upstream. See https://github.com/brandonchinn178/toml-reader/issues/12
    case Text -> Either TOMLError ConfigToml
forall a. DecodeTOML a => Text -> Either TOMLError a
decode Text
contents of
      Left TOMLError
tomlErr -> ConfigErr -> m Config
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (ConfigErr -> m Config) -> ConfigErr -> m Config
forall a b. (a -> b) -> a -> b
$ TOMLError -> ConfigErr
TomlError TOMLError
tomlErr
      Right ConfigToml
cfg -> ConfigToml -> m Config
forall (m :: Type -> Type).
(HasCallStack, MonadIORef m, MonadThrow m) =>
ConfigToml -> m Config
tomlToConfig ConfigToml
cfg

tomlToConfig ::
  ( HasCallStack,
    MonadIORef m,
    MonadThrow m
  ) =>
  ConfigToml ->
  m Config
tomlToConfig :: forall (m :: Type -> Type).
(HasCallStack, MonadIORef m, MonadThrow m) =>
ConfigToml -> m Config
tomlToConfig ConfigToml
toml = do
  Maybe AnyEvent
mBatteryLevelEvt <- (BatteryPercentageToml -> m AnyEvent)
-> Maybe BatteryPercentageToml -> m (Maybe AnyEvent)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse BatteryPercentageToml -> m AnyEvent
forall (m :: Type -> Type).
MonadIORef m =>
BatteryPercentageToml -> m AnyEvent
BattState.toEvent Maybe BatteryPercentageToml
batteryPercentageToml
  Maybe AnyEvent
mBatteryStatusEvt <- (BatteryStatusToml -> m AnyEvent)
-> Maybe BatteryStatusToml -> m (Maybe AnyEvent)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse BatteryStatusToml -> m AnyEvent
forall (m :: Type -> Type).
MonadIORef m =>
BatteryStatusToml -> m AnyEvent
BattChargeStatus.toEvent Maybe BatteryStatusToml
batteryStatusToml
  [AnyEvent]
customEvents <- (CustomToml -> m AnyEvent) -> [CustomToml] -> m [AnyEvent]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse CustomToml -> m AnyEvent
forall (m :: Type -> Type).
MonadIORef m =>
CustomToml -> m AnyEvent
Custom.toEvent [CustomToml]
customToml
  [AnyEvent]
mNetInterfacesEvt <- (NetInterfacesToml -> m AnyEvent)
-> [NetInterfacesToml] -> m [AnyEvent]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse NetInterfacesToml -> m AnyEvent
forall (m :: Type -> Type).
MonadIORef m =>
NetInterfacesToml -> m AnyEvent
NetConn.toEvent [NetInterfacesToml]
netInterfacesToml
  let multipleEvts :: [AnyEvent]
multipleEvts = [AnyEvent]
customEvents [AnyEvent] -> [AnyEvent] -> [AnyEvent]
forall a. Semigroup a => a -> a -> a
<> [AnyEvent]
mNetInterfacesEvt
      maybeEvts :: [AnyEvent]
maybeEvts =
        [Maybe AnyEvent] -> [AnyEvent]
forall a. [Maybe a] -> [a]
catMaybes
          [ Maybe AnyEvent
mBatteryLevelEvt,
            Maybe AnyEvent
mBatteryStatusEvt
          ]
      allEvts :: [AnyEvent]
allEvts = [AnyEvent]
maybeEvts [AnyEvent] -> [AnyEvent] -> [AnyEvent]
forall a. Semigroup a => a -> a -> a
<> [AnyEvent]
multipleEvts

  case [AnyEvent]
allEvts of
    [] -> ConfigErr -> m Config
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM ConfigErr
NoEvents
    (AnyEvent
e : [AnyEvent]
es) ->
      Config -> m Config
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
        (Config -> m Config) -> Config -> m Config
forall a b. (a -> b) -> a -> b
$ MkConfig
          { events :: NonEmpty AnyEvent
events = AnyEvent
e AnyEvent -> [AnyEvent] -> NonEmpty AnyEvent
forall a. a -> [a] -> NonEmpty a
:| [AnyEvent]
es,
            logging :: Logging
logging = Logging
logCfg,
            noteSystem :: NoteSystem 'ConfigPhaseToml
noteSystem = NoteSystem 'ConfigPhaseToml
noteSysCfg
          }
  where
    logCfg :: Logging
logCfg = Logging -> Maybe Logging -> Logging
forall a. a -> Maybe a -> a
fromMaybe Logging
defaultLogging (ConfigToml
toml ConfigToml
-> Optic' A_Lens NoIx ConfigToml (Maybe Logging) -> Maybe Logging
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ConfigToml (Maybe Logging)
#logToml)
    noteSysCfg :: NoteSystem 'ConfigPhaseToml
noteSysCfg = NoteSystem 'ConfigPhaseToml
-> Maybe (NoteSystem 'ConfigPhaseToml)
-> NoteSystem 'ConfigPhaseToml
forall a. a -> Maybe a -> a
fromMaybe NoteSystem 'ConfigPhaseToml
defaultNoteSystem (ConfigToml
toml ConfigToml
-> Optic'
     A_Lens NoIx ConfigToml (Maybe (NoteSystem 'ConfigPhaseToml))
-> Maybe (NoteSystem 'ConfigPhaseToml)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ConfigToml (Maybe (NoteSystem 'ConfigPhaseToml))
#noteSystemToml)
    customToml :: [CustomToml]
customToml = ConfigToml
toml ConfigToml
-> Optic' A_Lens NoIx ConfigToml [CustomToml] -> [CustomToml]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ConfigToml [CustomToml]
#customToml
    batteryPercentageToml :: Maybe BatteryPercentageToml
batteryPercentageToml = ConfigToml
toml ConfigToml
-> Optic' A_Lens NoIx ConfigToml (Maybe BatteryPercentageToml)
-> Maybe BatteryPercentageToml
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ConfigToml (Maybe BatteryPercentageToml)
#batteryPercentageToml
    batteryStatusToml :: Maybe BatteryStatusToml
batteryStatusToml = ConfigToml
toml ConfigToml
-> Optic' A_Lens NoIx ConfigToml (Maybe BatteryStatusToml)
-> Maybe BatteryStatusToml
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ConfigToml (Maybe BatteryStatusToml)
#batteryStatusToml
    netInterfacesToml :: [NetInterfacesToml]
netInterfacesToml = ConfigToml
toml ConfigToml
-> Optic' A_Lens NoIx ConfigToml [NetInterfacesToml]
-> [NetInterfacesToml]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ConfigToml [NetInterfacesToml]
#netInterfacesToml