{-# LANGUAGE QuasiQuotes #-}

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

    -- * Misc
    UPowerParseError (..),
    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.Read qualified as TR

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

-- | Errors that can occur with upower.
--
-- ==== __Examples__
--
-- >>> displayException $ UPowerParseErrorPercentage "output"
-- "No percentage found in upower output: output"
--
-- >>> displayException $ UPowerParseErrorStatus "output"
-- "No status found in upower output: output"
--
-- @since 0.1
type UPowerParseError :: Type
data UPowerParseError
  = -- | Did not find percentage.
    --
    -- @since 0.1
    UPowerParseErrorPercentage Text
  | -- | Did not find status.
    --
    -- @since 0.1
    UPowerParseErrorStatus Text
  deriving stock
    ( -- | @since 0.1
      UPowerParseError -> UPowerParseError -> Bool
(UPowerParseError -> UPowerParseError -> Bool)
-> (UPowerParseError -> UPowerParseError -> Bool)
-> Eq UPowerParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UPowerParseError -> UPowerParseError -> Bool
== :: UPowerParseError -> UPowerParseError -> Bool
$c/= :: UPowerParseError -> UPowerParseError -> Bool
/= :: UPowerParseError -> UPowerParseError -> Bool
Eq,
      -- | @since 0.1
      Int -> UPowerParseError -> ShowS
[UPowerParseError] -> ShowS
UPowerParseError -> String
(Int -> UPowerParseError -> ShowS)
-> (UPowerParseError -> String)
-> ([UPowerParseError] -> ShowS)
-> Show UPowerParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UPowerParseError -> ShowS
showsPrec :: Int -> UPowerParseError -> ShowS
$cshow :: UPowerParseError -> String
show :: UPowerParseError -> String
$cshowList :: [UPowerParseError] -> ShowS
showList :: [UPowerParseError] -> ShowS
Show
    )

-- | @since 0.1
instance Exception UPowerParseError where
  displayException :: UPowerParseError -> String
displayException (UPowerParseErrorPercentage Text
s) =
    String
"No percentage found in upower output: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
  displayException (UPowerParseErrorStatus Text
s) =
    String
"No status found in upower output: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s

-- | UPower 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 UPowerParseError 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 UPowerParseError Battery
shell
  where
    shell :: SimpleShell m UPowerParseError Battery
shell =
      MkSimpleShell
        { $sel:command:MkSimpleShell :: Command
command = Command
"upower -i `upower -e | grep 'BAT'`",
          $sel:isSupported:MkSimpleShell :: m Bool
isSupported = m Bool
forall (m :: Type -> Type). MonadPathReader m => m Bool
supported,
          $sel:parser:MkSimpleShell :: Text -> Either UPowerParseError Battery
parser = Text -> Either UPowerParseError 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|upower|]
{-# INLINEABLE supported #-}

-- | Attempts to parse the output of UPower.
--
-- ==== __Examples__
--
-- >>> parseBattery "state: fully-charged\npercentage: 100%"
-- Right (MkBattery {percentage = MkPercentage {unPercentage = UnsafeLRInterval 100}, status = Full})
--
-- >>> parseBattery "state: discharging\npercentage: 70%"
-- Right (MkBattery {percentage = MkPercentage {unPercentage = UnsafeLRInterval 70}, status = Discharging})
--
-- >>> parseBattery "state: charging\npercentage: 40%"
-- Right (MkBattery {percentage = MkPercentage {unPercentage = UnsafeLRInterval 40}, status = Charging})
--
-- >>> parseBattery "state: pending-charge\npercentage: 40%"
-- Right (MkBattery {percentage = MkPercentage {unPercentage = UnsafeLRInterval 40}, status = Pending})
--
-- >>> parseBattery "state: bad\npercentage: 40%"
-- Left (UPowerParseErrorStatus "state: bad\npercentage: 40%")
--
-- >>> parseBattery "state: fully-charged"
-- Left (UPowerParseErrorPercentage "state: fully-charged")
--
-- >>> parseBattery "percentage: 80%"
-- Left (UPowerParseErrorStatus "percentage: 80%")
--
-- >>> parseBattery "nothing"
-- Left (UPowerParseErrorStatus "nothing")
--
-- @since 0.1
parseBattery :: Text -> Either UPowerParseError Battery
parseBattery :: Text -> Either UPowerParseError Battery
parseBattery Text
txt = case (Text -> BatteryResult) -> [Text] -> BatteryResult
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> BatteryResult
parseLine [Text]
ts of
  BatteryResult
None -> UPowerParseError -> Either UPowerParseError Battery
forall a b. a -> Either a b
Left (UPowerParseError -> Either UPowerParseError Battery)
-> UPowerParseError -> Either UPowerParseError Battery
forall a b. (a -> b) -> a -> b
$ Text -> UPowerParseError
UPowerParseErrorStatus Text
txt
  Percent Percentage
_ -> UPowerParseError -> Either UPowerParseError Battery
forall a b. a -> Either a b
Left (UPowerParseError -> Either UPowerParseError Battery)
-> UPowerParseError -> Either UPowerParseError Battery
forall a b. (a -> b) -> a -> b
$ Text -> UPowerParseError
UPowerParseErrorStatus Text
txt
  Status BatteryStatus
_ -> UPowerParseError -> Either UPowerParseError Battery
forall a b. a -> Either a b
Left (UPowerParseError -> Either UPowerParseError Battery)
-> UPowerParseError -> Either UPowerParseError Battery
forall a b. (a -> b) -> a -> b
$ Text -> UPowerParseError
UPowerParseErrorPercentage Text
txt
  Both Battery
bs -> Battery -> Either UPowerParseError Battery
forall a b. b -> Either a b
Right Battery
bs
  where
    ts :: [Text]
ts = Text -> [Text]
T.lines Text
txt
{-# INLINEABLE parseBattery #-}

type BatteryResult :: Type
data BatteryResult
  = None
  | Percent Percentage
  | Status BatteryStatus
  | Both Battery
  deriving stock (Int -> BatteryResult -> ShowS
[BatteryResult] -> ShowS
BatteryResult -> String
(Int -> BatteryResult -> ShowS)
-> (BatteryResult -> String)
-> ([BatteryResult] -> ShowS)
-> Show BatteryResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BatteryResult -> ShowS
showsPrec :: Int -> BatteryResult -> ShowS
$cshow :: BatteryResult -> String
show :: BatteryResult -> String
$cshowList :: [BatteryResult] -> ShowS
showList :: [BatteryResult] -> ShowS
Show)

instance Semigroup BatteryResult where
  Both Battery
s <> :: BatteryResult -> BatteryResult -> BatteryResult
<> BatteryResult
_ = Battery -> BatteryResult
Both Battery
s
  BatteryResult
_ <> Both Battery
s = Battery -> BatteryResult
Both Battery
s
  BatteryResult
None <> BatteryResult
r = BatteryResult
r
  BatteryResult
l <> BatteryResult
None = BatteryResult
l
  Percent Percentage
n <> Status BatteryStatus
s = Battery -> BatteryResult
Both (Battery -> BatteryResult) -> Battery -> BatteryResult
forall a b. (a -> b) -> a -> b
$ Percentage -> BatteryStatus -> Battery
MkBattery Percentage
n BatteryStatus
s
  Status BatteryStatus
s <> Percent Percentage
n = Battery -> BatteryResult
Both (Battery -> BatteryResult) -> Battery -> BatteryResult
forall a b. (a -> b) -> a -> b
$ Percentage -> BatteryStatus -> Battery
MkBattery Percentage
n BatteryStatus
s
  BatteryResult
l <> BatteryResult
_ = BatteryResult
l
  {-# INLINEABLE (<>) #-}

instance Monoid BatteryResult where
  mempty :: BatteryResult
mempty = BatteryResult
None
  {-# INLINEABLE mempty #-}

parseLine :: Text -> BatteryResult
parseLine :: Text -> BatteryResult
parseLine Text
ln = case Parsec Void Text BatteryStatus
-> String
-> Text
-> Either (ParseErrorBundle Text Void) BatteryStatus
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text BatteryStatus
parseStatus String
"Pythia.Services.battery.UPower" Text
ln of
  Right BatteryStatus
s -> BatteryStatus -> BatteryResult
Status BatteryStatus
s
  Left ParseErrorBundle Text Void
_ -> case Parsec Void Text Percentage
-> String -> Text -> Either (ParseErrorBundle Text Void) Percentage
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Percentage
parsePercent String
"Pythia.Services.battery.UPower" Text
ln of
    Right Percentage
n -> Percentage -> BatteryResult
Percent Percentage
n
    Left ParseErrorBundle Text Void
_ -> BatteryResult
None
{-# INLINEABLE parseLine #-}

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

parsePercent :: MParser Percentage
parsePercent :: Parsec Void Text Percentage
parsePercent = do
  ParsecT Void Text Identity ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
  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
"percentage:"
  ParsecT Void Text Identity ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space1
  Percentage
nn <- Parsec Void Text Percentage
parseNN
  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
  pure Percentage
nn
  where
    parseNN :: Parsec Void Text Percentage
parseNN = do
      Text
num <- 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 Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
Char.isDigit
      Parsec Void Text Percentage
-> (Percentage -> Parsec Void Text Percentage)
-> Maybe Percentage
-> Parsec Void Text Percentage
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parsec Void Text Percentage
forall a. ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a
empty Percentage -> Parsec Void Text 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
num)

    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 parsePercent #-}

parseStatus :: MParser BatteryStatus
parseStatus :: Parsec Void Text BatteryStatus
parseStatus = do
  ParsecT Void Text Identity ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
  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
"state:"
  ParsecT Void Text Identity ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space1
  Parsec Void Text BatteryStatus -> Parsec Void Text 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 Parsec Void Text BatteryStatus
discharging
    Parsec Void Text BatteryStatus
-> Parsec Void Text BatteryStatus -> Parsec Void Text 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
<|> Parsec Void Text BatteryStatus -> Parsec Void Text 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 Parsec Void Text BatteryStatus
charging
    Parsec Void Text BatteryStatus
-> Parsec Void Text BatteryStatus -> Parsec Void Text 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
<|> Parsec Void Text BatteryStatus -> Parsec Void Text 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 Parsec Void Text BatteryStatus
full
    Parsec Void Text BatteryStatus
-> Parsec Void Text BatteryStatus -> Parsec Void Text 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
<|> Parsec Void Text BatteryStatus -> Parsec Void Text 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 Parsec Void Text BatteryStatus
pending
    Parsec Void Text BatteryStatus
-> Parsec Void Text BatteryStatus -> Parsec Void Text 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) -> Parsec Void Text 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"])
  where
    discharging :: Parsec Void Text 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 -> Parsec Void Text BatteryStatus
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> BatteryStatus
Discharging
    charging :: Parsec Void Text 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 -> Parsec Void Text BatteryStatus
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> BatteryStatus
Charging Parsec Void Text BatteryStatus
-> ParsecT Void Text Identity () -> Parsec Void Text BatteryStatus
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
rest
    full :: Parsec Void Text 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
"fully-charged" ParsecT Void Text Identity (Tokens Text)
-> BatteryStatus -> Parsec Void Text BatteryStatus
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> BatteryStatus
Full Parsec Void Text BatteryStatus
-> ParsecT Void Text Identity () -> Parsec Void Text BatteryStatus
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
rest
    pending :: Parsec Void Text 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
"pending-charge" ParsecT Void Text Identity (Tokens Text)
-> BatteryStatus -> Parsec Void Text BatteryStatus
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> BatteryStatus
Pending Parsec Void Text BatteryStatus
-> ParsecT Void Text Identity () -> Parsec Void Text BatteryStatus
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
rest
    rest :: ParsecT Void Text Identity ()
rest = ParsecT Void Text Identity ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: Type -> Type). MonadParsec e s m => m ()
MP.eof
{-# INLINEABLE parseStatus #-}