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

-- | This module provides functionality for decoding data from a toml
-- configuration file.
module Navi.Config.Toml
  ( ConfigToml (..),
  )
where

import Data.Bytes (SomeSize)
import Data.Bytes qualified as Bytes
import Data.Char qualified as Ch
import Data.Text qualified as T
import FileSystem.OsPath (encodeFail)
import GHC.Real (truncate)
import Navi.Config.Phase (ConfigPhase (ConfigPhaseToml))
import Navi.Config.Types
  ( FilesSizeMode (FilesSizeModeDelete, FilesSizeModeWarn),
    LogLoc (DefPath, File, Stdout),
    Logging (MkLogging),
    NoteSystem (AppleScript, DBus, NotifySend),
  )
import Navi.Prelude
import Navi.Services.Battery.Percentage.Toml (BatteryPercentageToml)
import Navi.Services.Battery.Status.Toml (BatteryStatusToml)
import Navi.Services.Custom.Toml (CustomToml)
import Navi.Services.Network.NetInterfaces.Toml (NetInterfacesToml)
import Navi.Utils (getFieldOptArrayOf)

-- | 'ConfigToml' holds the data that is defined in the configuration file.
data ConfigToml = MkConfigToml
  { ConfigToml -> Maybe BatteryPercentageToml
batteryPercentageToml :: Maybe BatteryPercentageToml,
    ConfigToml -> Maybe BatteryStatusToml
batteryStatusToml :: Maybe BatteryStatusToml,
    ConfigToml -> [CustomToml]
customToml :: [CustomToml],
    ConfigToml -> Maybe Logging
logToml :: Maybe Logging,
    ConfigToml -> [NetInterfacesToml]
netInterfacesToml :: [NetInterfacesToml],
    ConfigToml -> Maybe (NoteSystem 'ConfigPhaseToml)
noteSystemToml :: Maybe (NoteSystem ConfigPhaseToml)
  }
  deriving stock (ConfigToml -> ConfigToml -> Bool
(ConfigToml -> ConfigToml -> Bool)
-> (ConfigToml -> ConfigToml -> Bool) -> Eq ConfigToml
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigToml -> ConfigToml -> Bool
== :: ConfigToml -> ConfigToml -> Bool
$c/= :: ConfigToml -> ConfigToml -> Bool
/= :: ConfigToml -> ConfigToml -> Bool
Eq, Int -> ConfigToml -> ShowS
[ConfigToml] -> ShowS
ConfigToml -> String
(Int -> ConfigToml -> ShowS)
-> (ConfigToml -> String)
-> ([ConfigToml] -> ShowS)
-> Show ConfigToml
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigToml -> ShowS
showsPrec :: Int -> ConfigToml -> ShowS
$cshow :: ConfigToml -> String
show :: ConfigToml -> String
$cshowList :: [ConfigToml] -> ShowS
showList :: [ConfigToml] -> ShowS
Show)

makeFieldLabelsNoPrefix ''ConfigToml

-- | @since 0.1
instance DecodeTOML ConfigToml where
  tomlDecoder :: Decoder ConfigToml
tomlDecoder = do
    Maybe BatteryPercentageToml
batteryPercentageToml <- Decoder BatteryPercentageToml
-> Text -> Decoder (Maybe BatteryPercentageToml)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder BatteryPercentageToml
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"battery-percentage"
    Maybe BatteryStatusToml
batteryStatusToml <- Decoder BatteryStatusToml
-> Text -> Decoder (Maybe BatteryStatusToml)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder BatteryStatusToml
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"battery-status"
    [CustomToml]
customToml <- Text -> Decoder [CustomToml]
forall a. DecodeTOML a => Text -> Decoder [a]
getFieldOptArrayOf Text
"custom"
    Maybe Logging
logToml <- Decoder (Maybe Logging)
logDecoderOpt
    [NetInterfacesToml]
netInterfacesToml <- Text -> Decoder [NetInterfacesToml]
forall a. DecodeTOML a => Text -> Decoder [a]
getFieldOptArrayOf Text
"net-interface"
    Maybe (NoteSystem 'ConfigPhaseToml)
noteSystemToml <- Decoder (NoteSystem 'ConfigPhaseToml)
-> Text -> Decoder (Maybe (NoteSystem 'ConfigPhaseToml))
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder (NoteSystem 'ConfigPhaseToml)
noteSystemDecoder Text
"note-system"

    pure
      $ MkConfigToml
        { Maybe BatteryPercentageToml
batteryPercentageToml :: Maybe BatteryPercentageToml
batteryPercentageToml :: Maybe BatteryPercentageToml
batteryPercentageToml,
          Maybe BatteryStatusToml
batteryStatusToml :: Maybe BatteryStatusToml
batteryStatusToml :: Maybe BatteryStatusToml
batteryStatusToml,
          [CustomToml]
customToml :: [CustomToml]
customToml :: [CustomToml]
customToml,
          Maybe Logging
logToml :: Maybe Logging
logToml :: Maybe Logging
logToml,
          [NetInterfacesToml]
netInterfacesToml :: [NetInterfacesToml]
netInterfacesToml :: [NetInterfacesToml]
netInterfacesToml,
          Maybe (NoteSystem 'ConfigPhaseToml)
noteSystemToml :: Maybe (NoteSystem 'ConfigPhaseToml)
noteSystemToml :: Maybe (NoteSystem 'ConfigPhaseToml)
noteSystemToml
        }

logDecoderOpt :: Decoder (Maybe Logging)
logDecoderOpt :: Decoder (Maybe Logging)
logDecoderOpt = Decoder Logging -> Text -> Decoder (Maybe Logging)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder Logging
logDecoder Text
"logging"

logDecoder :: Decoder Logging
logDecoder :: Decoder Logging
logDecoder =
  Maybe LogLevel -> Maybe LogLoc -> Maybe FilesSizeMode -> Logging
MkLogging
    (Maybe LogLevel -> Maybe LogLoc -> Maybe FilesSizeMode -> Logging)
-> Decoder (Maybe LogLevel)
-> Decoder (Maybe LogLoc -> Maybe FilesSizeMode -> Logging)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Maybe LogLevel)
severityDecoderOpt
    Decoder (Maybe LogLoc -> Maybe FilesSizeMode -> Logging)
-> Decoder (Maybe LogLoc)
-> Decoder (Maybe FilesSizeMode -> Logging)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe LogLoc)
locationDecoderOpt
    Decoder (Maybe FilesSizeMode -> Logging)
-> Decoder (Maybe FilesSizeMode) -> Decoder Logging
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe FilesSizeMode)
sizeModeDecoderOpt

severityDecoderOpt :: Decoder (Maybe LogLevel)
severityDecoderOpt :: Decoder (Maybe LogLevel)
severityDecoderOpt = Maybe (Maybe LogLevel) -> Maybe LogLevel
setDef (Maybe (Maybe LogLevel) -> Maybe LogLevel)
-> Decoder (Maybe (Maybe LogLevel)) -> Decoder (Maybe LogLevel)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Maybe LogLevel)
-> Text -> Decoder (Maybe (Maybe LogLevel))
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder (Maybe LogLevel)
severityDecoder Text
"severity"
  where
    -- NOTE: We want the following semantics:
    --
    -- 1. User sets a log-level, use it.
    -- 2. User can disable logging w/ 'none'.
    -- 3. If no option is given, default to LevelError.
    --
    -- Hence 'getFieldOptWith severityDecoder' returns Maybe (Maybe LogLevel),
    -- where the outer maybe refers to the field existence, and the inner
    -- maybe handle 'none'.
    --
    -- Here we join the levels, so that Nothing means 'none', o/w logging is
    -- on.
    setDef :: Maybe (Maybe LogLevel) -> Maybe LogLevel
setDef Maybe (Maybe LogLevel)
Nothing = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelError
    setDef (Just Maybe LogLevel
l) = Maybe LogLevel
l

severityDecoder :: Decoder (Maybe LogLevel)
severityDecoder :: Decoder (Maybe LogLevel)
severityDecoder =
  Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Text
-> (Text -> Decoder (Maybe LogLevel)) -> Decoder (Maybe LogLevel)
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"debug" -> Maybe LogLevel -> Decoder (Maybe LogLevel)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe LogLevel -> Decoder (Maybe LogLevel))
-> Maybe LogLevel -> Decoder (Maybe LogLevel)
forall a b. (a -> b) -> a -> b
$ LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelDebug
    Text
"info" -> Maybe LogLevel -> Decoder (Maybe LogLevel)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe LogLevel -> Decoder (Maybe LogLevel))
-> Maybe LogLevel -> Decoder (Maybe LogLevel)
forall a b. (a -> b) -> a -> b
$ LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelInfo
    Text
"error" -> Maybe LogLevel -> Decoder (Maybe LogLevel)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe LogLevel -> Decoder (Maybe LogLevel))
-> Maybe LogLevel -> Decoder (Maybe LogLevel)
forall a b. (a -> b) -> a -> b
$ LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelError
    Text
"none" -> Maybe LogLevel -> Decoder (Maybe LogLevel)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe LogLevel
forall a. Maybe a
Nothing
    Text
bad -> String -> Decoder (Maybe LogLevel)
forall a. String -> Decoder a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Decoder (Maybe LogLevel))
-> String -> Decoder (Maybe LogLevel)
forall a b. (a -> b) -> a -> b
$ Text -> String
unpackText (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Unsupported severity: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bad

locationDecoderOpt :: Decoder (Maybe LogLoc)
locationDecoderOpt :: Decoder (Maybe LogLoc)
locationDecoderOpt = Decoder LogLoc -> Text -> Decoder (Maybe LogLoc)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder LogLoc
locationDecoder Text
"location"

locationDecoder :: Decoder LogLoc
locationDecoder :: Decoder LogLoc
locationDecoder =
  Decoder String
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder String -> (String -> Decoder LogLoc) -> Decoder LogLoc
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    String
"default" -> LogLoc -> Decoder LogLoc
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure LogLoc
DefPath
    String
"stdout" -> LogLoc -> Decoder LogLoc
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure LogLoc
Stdout
    String
f -> OsPath -> LogLoc
File (OsPath -> LogLoc) -> Decoder OsPath -> Decoder LogLoc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Decoder OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadFail m) =>
String -> m OsPath
encodeFail String
f

noteSystemDecoder :: Decoder (NoteSystem ConfigPhaseToml)
noteSystemDecoder :: Decoder (NoteSystem 'ConfigPhaseToml)
noteSystemDecoder =
  Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Text
-> (Text -> Decoder (NoteSystem 'ConfigPhaseToml))
-> Decoder (NoteSystem 'ConfigPhaseToml)
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"apple-script" -> NoteSystem 'ConfigPhaseToml
-> Decoder (NoteSystem 'ConfigPhaseToml)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure NoteSystem 'ConfigPhaseToml
forall (p :: ConfigPhase). NoteSystem p
AppleScript
    Text
"dbus" -> NoteSystem 'ConfigPhaseToml
-> Decoder (NoteSystem 'ConfigPhaseToml)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (NoteSystem 'ConfigPhaseToml
 -> Decoder (NoteSystem 'ConfigPhaseToml))
-> NoteSystem 'ConfigPhaseToml
-> Decoder (NoteSystem 'ConfigPhaseToml)
forall a b. (a -> b) -> a -> b
$ DBusF 'ConfigPhaseToml -> NoteSystem 'ConfigPhaseToml
forall (p :: ConfigPhase). DBusF p -> NoteSystem p
DBus ()
    Text
"notify-send" -> NoteSystem 'ConfigPhaseToml
-> Decoder (NoteSystem 'ConfigPhaseToml)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure NoteSystem 'ConfigPhaseToml
forall (p :: ConfigPhase). NoteSystem p
NotifySend
    Text
bad -> String -> Decoder (NoteSystem 'ConfigPhaseToml)
forall a. String -> Decoder a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Decoder (NoteSystem 'ConfigPhaseToml))
-> String -> Decoder (NoteSystem 'ConfigPhaseToml)
forall a b. (a -> b) -> a -> b
$ Text -> String
unpackText (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Unsupported NoteSystem: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bad

sizeModeDecoderOpt :: Decoder (Maybe FilesSizeMode)
sizeModeDecoderOpt :: Decoder (Maybe FilesSizeMode)
sizeModeDecoderOpt = Decoder FilesSizeMode -> Text -> Decoder (Maybe FilesSizeMode)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder FilesSizeMode
sizeModeDecoder Text
"size-mode"

sizeModeDecoder :: Decoder FilesSizeMode
sizeModeDecoder :: Decoder FilesSizeMode
sizeModeDecoder = do
  Text
txt <- Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder
  let (Text
m, Text
byteTxt) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
Ch.isSpace Text
txt
  Bytes 'B Natural -> FilesSizeMode
cons <- case Text
m of
    Text
"warn" -> (Bytes 'B Natural -> FilesSizeMode)
-> Decoder (Bytes 'B Natural -> FilesSizeMode)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bytes 'B Natural -> FilesSizeMode
FilesSizeModeWarn
    Text
"delete" -> (Bytes 'B Natural -> FilesSizeMode)
-> Decoder (Bytes 'B Natural -> FilesSizeMode)
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bytes 'B Natural -> FilesSizeMode
FilesSizeModeDelete
    Text
bad -> String -> Decoder (Bytes 'B Natural -> FilesSizeMode)
forall a. String -> Decoder a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Decoder (Bytes 'B Natural -> FilesSizeMode))
-> String -> Decoder (Bytes 'B Natural -> FilesSizeMode)
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized size-mode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpackText Text
bad
  case Text -> Either Text (Bytes 'B Natural)
parseByteText Text
byteTxt of
    Right Bytes 'B Natural
b -> FilesSizeMode -> Decoder FilesSizeMode
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (FilesSizeMode -> Decoder FilesSizeMode)
-> FilesSizeMode -> Decoder FilesSizeMode
forall a b. (a -> b) -> a -> b
$ Bytes 'B Natural -> FilesSizeMode
cons Bytes 'B Natural
b
    Left Text
err -> String -> Decoder FilesSizeMode
forall a. String -> Decoder a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Decoder FilesSizeMode)
-> String -> Decoder FilesSizeMode
forall a b. (a -> b) -> a -> b
$ String
"Could not parse size-mode size: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpackText Text
err
  where
    parseByteText :: Text -> Either Text (Bytes B Natural)
    parseByteText :: Text -> Either Text (Bytes 'B Natural)
parseByteText Text
txt =
      -- NOTE: Try conversion to natural first for more precision. Fall back
      -- to double if that fails.
      case forall a. Parser a => Text -> Either Text a
Bytes.parse @(SomeSize Natural) Text
txt of
        Right SomeSize Natural
b -> Converted 'B (SomeSize Natural)
-> Either Text (Converted 'B (SomeSize Natural))
forall a b. b -> Either a b
Right (Converted 'B (SomeSize Natural)
 -> Either Text (Converted 'B (SomeSize Natural)))
-> Converted 'B (SomeSize Natural)
-> Either Text (Converted 'B (SomeSize Natural))
forall a b. (a -> b) -> a -> b
$ forall a (t :: Size). (Conversion a, SingI t) => a -> Converted t a
Bytes.convert_ @_ @B SomeSize Natural
b
        Left Text
_ -> case forall a. Parser a => Text -> Either Text a
Bytes.parse @(SomeSize Double) Text
txt of
          Right SomeSize Double
b -> Bytes 'B Natural -> Either Text (Bytes 'B Natural)
forall a b. b -> Either a b
Right (Double -> Natural
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Natural) -> Bytes 'B Double -> Bytes 'B Natural
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (t :: Size). (Conversion a, SingI t) => a -> Converted t a
Bytes.convert_ @_ @B SomeSize Double
b)
          Left Text
err -> Text -> Either Text (Bytes 'B Natural)
forall a b. a -> Either a b
Left Text
err