{-# LANGUAGE QuasiQuotes #-}

-- | This module provides functionality for retrieving battery information
-- using ACPI.
--
-- @since 0.1
module Pythia.Services.Battery.Acpi
  ( -- * Query
    batteryShellApp,
    supported,

    -- * Misc
    AcpiParseError (..),
    parseBattery,
  )
where

import Data.Char qualified as Char
import Data.Set qualified as Set
import Data.Text qualified as T
import Pythia.Data.Percentage (Percentage)
import Pythia.Data.Percentage qualified as Percentage
import Pythia.Internal.ShellApp
  ( SimpleShell
      ( MkSimpleShell,
        command,
        isSupported,
        parser
      ),
  )
import Pythia.Internal.ShellApp qualified as ShellApp
import Pythia.Prelude
import Pythia.Services.Battery.Types
  ( Battery (MkBattery),
    BatteryStatus
      ( Charging,
        Discharging,
        Full,
        Pending
      ),
  )
import Pythia.Utils qualified as U
import Text.Megaparsec (ErrorFancy (ErrorFail), Parsec, (<?>))
import Text.Megaparsec qualified as MP
import Text.Megaparsec.Char qualified as MPC
import Text.Megaparsec.Error qualified as MPE
import Text.Read qualified as TR

-- $setup
-- >>> import Control.Exception (displayException)
-- >>> import Pythia.Prelude

-- | Error parsing acpi output.
--
-- ==== __Examples__
--
-- >>> displayException $ MkAcpiParseError "parse error"
-- "Acpi parse error: parse error"
--
-- @since 0.1
type AcpiParseError :: Type
newtype AcpiParseError = MkAcpiParseError Text
  deriving stock
    ( -- | @since 0.1
      AcpiParseError -> AcpiParseError -> Bool
(AcpiParseError -> AcpiParseError -> Bool)
-> (AcpiParseError -> AcpiParseError -> Bool) -> Eq AcpiParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AcpiParseError -> AcpiParseError -> Bool
== :: AcpiParseError -> AcpiParseError -> Bool
$c/= :: AcpiParseError -> AcpiParseError -> Bool
/= :: AcpiParseError -> AcpiParseError -> Bool
Eq,
      -- | @since 0.1
      Int -> AcpiParseError -> ShowS
[AcpiParseError] -> ShowS
AcpiParseError -> String
(Int -> AcpiParseError -> ShowS)
-> (AcpiParseError -> String)
-> ([AcpiParseError] -> ShowS)
-> Show AcpiParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AcpiParseError -> ShowS
showsPrec :: Int -> AcpiParseError -> ShowS
$cshow :: AcpiParseError -> String
show :: AcpiParseError -> String
$cshowList :: [AcpiParseError] -> ShowS
showList :: [AcpiParseError] -> ShowS
Show
    )

-- | @since 0.1
instance Exception AcpiParseError where
  displayException :: AcpiParseError -> String
displayException (MkAcpiParseError Text
e) =
    (String
"Acpi parse error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)
      ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
      (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
e

-- | ACPI query for 'Battery'.
--
-- @since 0.1
batteryShellApp ::
  ( MonadPathReader m,
    MonadThrow m,
    MonadTypedProcess m
  ) =>
  m Battery
batteryShellApp :: forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m, MonadTypedProcess m) =>
m Battery
batteryShellApp = SimpleShell m AcpiParseError Battery -> m Battery
forall (m :: Type -> Type) err result.
(Exception err, MonadThrow m, MonadTypedProcess m) =>
SimpleShell m err result -> m result
ShellApp.runSimple SimpleShell m AcpiParseError Battery
shell
  where
    shell :: SimpleShell m AcpiParseError Battery
shell =
      MkSimpleShell
        { $sel:command:MkSimpleShell :: Command
command = Command
"acpi",
          $sel:isSupported:MkSimpleShell :: m Bool
isSupported = m Bool
forall (m :: Type -> Type). MonadPathReader m => m Bool
supported,
          $sel:parser:MkSimpleShell :: Text -> Either AcpiParseError Battery
parser = Text -> Either AcpiParseError Battery
parseBattery
        }
{-# INLINEABLE batteryShellApp #-}

-- | Returns a boolean determining if this program is supported on the
-- current system.
--
-- @since 0.1
supported :: (MonadPathReader m) => m Bool
supported :: forall (m :: Type -> Type). MonadPathReader m => m Bool
supported = OsPath -> m Bool
forall (m :: Type -> Type). MonadPathReader m => OsPath -> m Bool
U.exeSupported [osp|acpi|]
{-# INLINEABLE supported #-}

-- | Attempts to parse the output of acpi.
--
-- ==== __Examples__
--
-- >>> parseBattery "Battery 0: Full, 100%"
-- Right (MkBattery {percentage = MkPercentage {unPercentage = UnsafeLRInterval 100}, status = Full})
--
-- >>> parseBattery "Battery 0: Discharging, 80%"
-- Right (MkBattery {percentage = MkPercentage {unPercentage = UnsafeLRInterval 80}, status = Discharging})
--
-- >>> parseBattery "Battery 0: Charging, 40%"
-- Right (MkBattery {percentage = MkPercentage {unPercentage = UnsafeLRInterval 40}, status = Charging})
--
-- >>> parseBattery "Battery 0: bad status, 80%"
-- Left (MkAcpiParseError "Acpi.hs:1:12:\n  |\n1 | Battery 0: bad status, 80%\n  |            ^\nUnknown status\n")
--
-- >>> parseBattery "Battery 0: Discharging, 150%"
-- Left (MkAcpiParseError "Acpi.hs:1:28:\n  |\n1 | Battery 0: Discharging, 150%\n  |                            ^\nexpecting percentage\n")
--
-- @since 0.1
parseBattery :: Text -> Either AcpiParseError Battery
parseBattery :: Text -> Either AcpiParseError Battery
parseBattery Text
txt = (Text -> Either AcpiParseError Battery)
-> Text -> [Text] -> Either AcpiParseError Battery
forall (f :: Type -> Type) s a.
(Foldable f, Semigroup s) =>
(a -> s) -> a -> f a -> s
U.foldMap1 Text -> Either AcpiParseError Battery
parseLine Text
"<empty input>" [Text]
tlines
  where
    tlines :: [Text]
tlines = Text -> [Text]
T.lines Text
txt
{-# INLINEABLE parseBattery #-}

parseLine :: Text -> Either AcpiParseError Battery
parseLine :: Text -> Either AcpiParseError Battery
parseLine = (ParseErrorBundle Text Void -> AcpiParseError)
-> Either (ParseErrorBundle Text Void) Battery
-> Either AcpiParseError Battery
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text Void -> AcpiParseError
mkErr (Either (ParseErrorBundle Text Void) Battery
 -> Either AcpiParseError Battery)
-> (Text -> Either (ParseErrorBundle Text Void) Battery)
-> Text
-> Either AcpiParseError Battery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Battery
-> String -> Text -> Either (ParseErrorBundle Text Void) Battery
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Battery
mparseBattery String
"Acpi.hs"
  where
    mkErr :: ParseErrorBundle Text Void -> AcpiParseError
mkErr = Text -> AcpiParseError
MkAcpiParseError (Text -> AcpiParseError)
-> (ParseErrorBundle Text Void -> Text)
-> ParseErrorBundle Text Void
-> AcpiParseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MPE.errorBundlePretty
{-# INLINEABLE parseLine #-}

type MParser :: Type -> Type
type MParser = Parsec Void Text

mparseBattery :: MParser Battery
mparseBattery :: Parsec Void Text Battery
mparseBattery = do
  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"Battery"
  ParsecT Void Text Identity ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
  Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"decimal digits") Char -> Bool
Token Text -> Bool
Char.isDigit
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MPC.char Char
Token Text
':'
  ParsecT Void Text Identity ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
  BatteryStatus
state <- MParser BatteryStatus
mparseState
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MPC.char Char
Token Text
','
  ParsecT Void Text Identity ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
  Percentage
percentage <- MParser Percentage
mparsePercent
  pure $ Percentage -> BatteryStatus -> Battery
MkBattery Percentage
percentage BatteryStatus
state
{-# INLINEABLE mparseBattery #-}

mparseState :: MParser BatteryStatus
mparseState :: MParser BatteryStatus
mparseState =
  MParser BatteryStatus -> MParser BatteryStatus
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser BatteryStatus
discharging
    MParser BatteryStatus
-> MParser BatteryStatus -> MParser BatteryStatus
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser BatteryStatus -> MParser BatteryStatus
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser BatteryStatus
charging
    MParser BatteryStatus
-> MParser BatteryStatus -> MParser BatteryStatus
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser BatteryStatus -> MParser BatteryStatus
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser BatteryStatus
pending
    MParser BatteryStatus
-> MParser BatteryStatus -> MParser BatteryStatus
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser BatteryStatus -> MParser BatteryStatus
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser BatteryStatus
full
    MParser BatteryStatus
-> MParser BatteryStatus -> MParser BatteryStatus
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Set (ErrorFancy Void) -> MParser BatteryStatus
forall e s (m :: Type -> Type) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
MP.fancyFailure ([ErrorFancy Void] -> Set (ErrorFancy Void)
forall a. Ord a => [a] -> Set a
Set.fromList [String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail String
"Unknown status"])
    MParser BatteryStatus -> String -> MParser BatteryStatus
forall e s (m :: Type -> Type) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"<Discharging|Charging|Not charging|Full>"
  where
    discharging :: MParser BatteryStatus
discharging = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
MPC.string' Tokens Text
"Discharging" ParsecT Void Text Identity (Tokens Text)
-> BatteryStatus -> MParser BatteryStatus
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> BatteryStatus
Discharging
    charging :: MParser BatteryStatus
charging = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
MPC.string' Tokens Text
"Charging" ParsecT Void Text Identity (Tokens Text)
-> BatteryStatus -> MParser BatteryStatus
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> BatteryStatus
Charging
    full :: MParser BatteryStatus
full = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
MPC.string' Tokens Text
"Full" ParsecT Void Text Identity (Tokens Text)
-> BatteryStatus -> MParser BatteryStatus
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> BatteryStatus
Full
    pending :: MParser BatteryStatus
pending = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
MPC.string' Tokens Text
"Not charging" ParsecT Void Text Identity (Tokens Text)
-> BatteryStatus -> MParser BatteryStatus
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> BatteryStatus
Pending
{-# INLINEABLE mparseState #-}

mparsePercent :: MParser Percentage
mparsePercent :: MParser Percentage
mparsePercent = do
  Text
percent <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"percentage") Char -> Bool
Token Text -> Bool
Char.isDigit
  Percentage
percentage <- MParser Percentage
-> (Percentage -> MParser Percentage)
-> Maybe Percentage
-> MParser Percentage
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MParser Percentage
forall a. ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a
empty Percentage -> MParser Percentage
forall a. a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text -> Maybe Percentage
readPercentage Text
percent)
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MPC.char Char
Token Text
'%'
  pure Percentage
percentage
  where
    readPercentage :: Text -> Maybe Percentage
readPercentage = Word8 -> Maybe Percentage
Percentage.mkPercentage (Word8 -> Maybe Percentage)
-> (Text -> Maybe Word8) -> Text -> Maybe Percentage
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Maybe Word8
forall a. Read a => String -> Maybe a
TR.readMaybe (String -> Maybe Word8) -> (Text -> String) -> Text -> Maybe Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
{-# INLINEABLE mparsePercent #-}