{-# LANGUAGE QuasiQuotes #-}

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

    -- * Misc
    SysFsDirNotFound (..),
    SysFsBatteryDirNotFound (..),
    SysFsFileNotFound (..),
    SysFsBatteryParseError (..),
  )
where

import Data.Text qualified as T
import Effects.FileSystem.PathReader qualified as Dir
import Pythia.Data.Percentage (Percentage)
import Pythia.Data.Percentage qualified as Percentage
import Pythia.Prelude
import Pythia.Services.Battery.Types
  ( Battery (MkBattery),
    BatteryStatus
      ( Charging,
        Discharging,
        Full,
        Pending
      ),
  )
import Text.Read qualified as TR

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

sysDir :: OsPath
sysDir :: OsPath
sysDir = [osp|/sys/class/power_supply|]

sysfsDir :: OsPath
sysfsDir :: OsPath
sysfsDir = [osp|/sysfs/class/power_supply|]

-- | Sysfs dir not found error.
--
-- ==== __Examples__
--
-- >>> displayException MkSysFsDirNotFound
-- "Could not find either sysfs dirs: /sys/class/power_supply, /sysfs/class/power_supply"
--
-- @since 0.1
type SysFsDirNotFound :: Type
data SysFsDirNotFound = MkSysFsDirNotFound
  deriving stock
    ( -- | @since 0.1
      SysFsDirNotFound -> SysFsDirNotFound -> Bool
(SysFsDirNotFound -> SysFsDirNotFound -> Bool)
-> (SysFsDirNotFound -> SysFsDirNotFound -> Bool)
-> Eq SysFsDirNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SysFsDirNotFound -> SysFsDirNotFound -> Bool
== :: SysFsDirNotFound -> SysFsDirNotFound -> Bool
$c/= :: SysFsDirNotFound -> SysFsDirNotFound -> Bool
/= :: SysFsDirNotFound -> SysFsDirNotFound -> Bool
Eq,
      -- | @since 0.1
      Int -> SysFsDirNotFound -> ShowS
[SysFsDirNotFound] -> ShowS
SysFsDirNotFound -> String
(Int -> SysFsDirNotFound -> ShowS)
-> (SysFsDirNotFound -> String)
-> ([SysFsDirNotFound] -> ShowS)
-> Show SysFsDirNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SysFsDirNotFound -> ShowS
showsPrec :: Int -> SysFsDirNotFound -> ShowS
$cshow :: SysFsDirNotFound -> String
show :: SysFsDirNotFound -> String
$cshowList :: [SysFsDirNotFound] -> ShowS
showList :: [SysFsDirNotFound] -> ShowS
Show
    )

-- | @since 0.1
instance Exception SysFsDirNotFound where
  displayException :: SysFsDirNotFound -> String
displayException SysFsDirNotFound
_ =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Could not find either sysfs dirs: '",
        OsPath -> String
decodeOsToFpShow OsPath
sysDir,
        String
"', '",
        OsPath -> String
decodeOsToFpShow OsPath
sysfsDir,
        String
"'"
      ]

-- | Sysfs battery dir not found.
--
-- ==== __Examples__
--
-- >>> displayException MkSysFsBatteryDirNotFound
-- "Could not find BAT[0-5]? subdirectory under /sys(fs)/class/power_supply"
--
-- @since 0.1
type SysFsBatteryDirNotFound :: Type
data SysFsBatteryDirNotFound = MkSysFsBatteryDirNotFound
  deriving stock
    ( -- | @since 0.1
      SysFsBatteryDirNotFound -> SysFsBatteryDirNotFound -> Bool
(SysFsBatteryDirNotFound -> SysFsBatteryDirNotFound -> Bool)
-> (SysFsBatteryDirNotFound -> SysFsBatteryDirNotFound -> Bool)
-> Eq SysFsBatteryDirNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SysFsBatteryDirNotFound -> SysFsBatteryDirNotFound -> Bool
== :: SysFsBatteryDirNotFound -> SysFsBatteryDirNotFound -> Bool
$c/= :: SysFsBatteryDirNotFound -> SysFsBatteryDirNotFound -> Bool
/= :: SysFsBatteryDirNotFound -> SysFsBatteryDirNotFound -> Bool
Eq,
      -- | @since 0.1
      Int -> SysFsBatteryDirNotFound -> ShowS
[SysFsBatteryDirNotFound] -> ShowS
SysFsBatteryDirNotFound -> String
(Int -> SysFsBatteryDirNotFound -> ShowS)
-> (SysFsBatteryDirNotFound -> String)
-> ([SysFsBatteryDirNotFound] -> ShowS)
-> Show SysFsBatteryDirNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SysFsBatteryDirNotFound -> ShowS
showsPrec :: Int -> SysFsBatteryDirNotFound -> ShowS
$cshow :: SysFsBatteryDirNotFound -> String
show :: SysFsBatteryDirNotFound -> String
$cshowList :: [SysFsBatteryDirNotFound] -> ShowS
showList :: [SysFsBatteryDirNotFound] -> ShowS
Show
    )

-- | @since 0.1
instance Exception SysFsBatteryDirNotFound where
  displayException :: SysFsBatteryDirNotFound -> String
displayException SysFsBatteryDirNotFound
_ =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Could not find BAT[0-5]? subdirectory under ",
        String
"/sys(fs)/class/power_supply"
      ]

-- | Sysfs file not found.
--
-- ==== __Examples__
--
-- >>> displayException $ MkSysFsFileNotFound "foo"
-- "Could not find sysfs file: foo"
--
-- @since 0.1
type SysFsFileNotFound :: Type
newtype SysFsFileNotFound = MkSysFsFileNotFound OsPath
  deriving stock
    ( -- | @since 0.1
      SysFsFileNotFound -> SysFsFileNotFound -> Bool
(SysFsFileNotFound -> SysFsFileNotFound -> Bool)
-> (SysFsFileNotFound -> SysFsFileNotFound -> Bool)
-> Eq SysFsFileNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SysFsFileNotFound -> SysFsFileNotFound -> Bool
== :: SysFsFileNotFound -> SysFsFileNotFound -> Bool
$c/= :: SysFsFileNotFound -> SysFsFileNotFound -> Bool
/= :: SysFsFileNotFound -> SysFsFileNotFound -> Bool
Eq,
      -- | @since 0.1
      Int -> SysFsFileNotFound -> ShowS
[SysFsFileNotFound] -> ShowS
SysFsFileNotFound -> String
(Int -> SysFsFileNotFound -> ShowS)
-> (SysFsFileNotFound -> String)
-> ([SysFsFileNotFound] -> ShowS)
-> Show SysFsFileNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SysFsFileNotFound -> ShowS
showsPrec :: Int -> SysFsFileNotFound -> ShowS
$cshow :: SysFsFileNotFound -> String
show :: SysFsFileNotFound -> String
$cshowList :: [SysFsFileNotFound] -> ShowS
showList :: [SysFsFileNotFound] -> ShowS
Show
    )

-- | @since 0.1
instance Exception SysFsFileNotFound where
  displayException :: SysFsFileNotFound -> String
displayException (MkSysFsFileNotFound OsPath
e) =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Could not find sysfs file: '",
        OsPath -> String
decodeOsToFpShow OsPath
e,
        String
"'"
      ]

-- | Sysfs battery parse error.
--
-- ==== __Examples__
--
-- >>> displayException $ MkSysFsBatteryParseError "bad"
-- "SysFs parse error: bad"
--
-- @since 0.1
type SysFsBatteryParseError :: Type
newtype SysFsBatteryParseError = MkSysFsBatteryParseError Text
  deriving stock
    ( -- | @since 0.1
      SysFsBatteryParseError -> SysFsBatteryParseError -> Bool
(SysFsBatteryParseError -> SysFsBatteryParseError -> Bool)
-> (SysFsBatteryParseError -> SysFsBatteryParseError -> Bool)
-> Eq SysFsBatteryParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SysFsBatteryParseError -> SysFsBatteryParseError -> Bool
== :: SysFsBatteryParseError -> SysFsBatteryParseError -> Bool
$c/= :: SysFsBatteryParseError -> SysFsBatteryParseError -> Bool
/= :: SysFsBatteryParseError -> SysFsBatteryParseError -> Bool
Eq,
      -- | @since 0.1
      Int -> SysFsBatteryParseError -> ShowS
[SysFsBatteryParseError] -> ShowS
SysFsBatteryParseError -> String
(Int -> SysFsBatteryParseError -> ShowS)
-> (SysFsBatteryParseError -> String)
-> ([SysFsBatteryParseError] -> ShowS)
-> Show SysFsBatteryParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SysFsBatteryParseError -> ShowS
showsPrec :: Int -> SysFsBatteryParseError -> ShowS
$cshow :: SysFsBatteryParseError -> String
show :: SysFsBatteryParseError -> String
$cshowList :: [SysFsBatteryParseError] -> ShowS
showList :: [SysFsBatteryParseError] -> ShowS
Show
    )

-- | @since 0.1
instance Exception SysFsBatteryParseError where
  displayException :: SysFsBatteryParseError -> String
displayException (MkSysFsBatteryParseError Text
e) =
    (String
"SysFs 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

-- | @\/sys\/class@ query for 'Battery'.
--
-- @since 0.1
batteryQuery ::
  ( MonadFileReader m,
    MonadPathReader m,
    MonadThrow m
  ) =>
  m Battery
batteryQuery :: forall (m :: Type -> Type).
(MonadFileReader m, MonadPathReader m, MonadThrow m) =>
m Battery
batteryQuery = m Battery
forall (m :: Type -> Type).
(MonadFileReader m, MonadPathReader m, MonadThrow m) =>
m Battery
queryBattery

-- | Returns a boolean determining if this program is supported on the
-- current system. In particular, we return 'True' if the directory
--
-- @\/sys(fs)\/class\/power_supply\/BAT[0-5]+@ exists.
--
-- Example valid paths:
--
-- * @\/sys\/class\/power_supply\/BAT0@
-- * @\/sysfs\/class\/power_supply\/BAT3@
-- * @\/sys\/class\/power_supply\/BAT@
--
-- @since 0.1
supported :: (MonadCatch m, MonadPathReader m) => m Bool
supported :: forall (m :: Type -> Type).
(MonadCatch m, MonadPathReader m) =>
m Bool
supported = do
  Either SomeException OsPath
efp <- m OsPath -> m (Either SomeException OsPath)
forall (m :: Type -> Type) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny m OsPath
forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m) =>
m OsPath
findSysBatDir
  case Either SomeException OsPath
efp of
    Left SomeException
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False
    Right OsPath
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True

queryBattery ::
  ( MonadFileReader m,
    MonadPathReader m,
    MonadThrow m
  ) =>
  m Battery
queryBattery :: forall (m :: Type -> Type).
(MonadFileReader m, MonadPathReader m, MonadThrow m) =>
m Battery
queryBattery = do
  OsPath
batDir <- m OsPath
forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m) =>
m OsPath
findSysBatDir

  let statusPath :: OsPath
statusPath = OsPath
batDir OsPath -> OsPath -> OsPath
</> [osp|status|]
  Bool
statusPathExists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
Dir.doesFileExist OsPath
statusPath
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
statusPathExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ SysFsFileNotFound -> m ()
forall (m :: Type -> Type) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (SysFsFileNotFound -> m ()) -> SysFsFileNotFound -> m ()
forall a b. (a -> b) -> a -> b
$ OsPath -> SysFsFileNotFound
MkSysFsFileNotFound OsPath
statusPath

  let percentPath :: OsPath
percentPath = OsPath
batDir OsPath -> OsPath -> OsPath
</> [osp|capacity|]
  Bool
percentPathExists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
Dir.doesFileExist OsPath
percentPath
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
percentPathExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ SysFsFileNotFound -> m ()
forall (m :: Type -> Type) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (SysFsFileNotFound -> m ()) -> SysFsFileNotFound -> m ()
forall a b. (a -> b) -> a -> b
$ OsPath -> SysFsFileNotFound
MkSysFsFileNotFound OsPath
percentPath

  BatteryStatus
status <- OsPath -> m BatteryStatus
forall (m :: Type -> Type).
(MonadFileReader m, MonadThrow m) =>
OsPath -> m BatteryStatus
parseStatus OsPath
statusPath
  Percentage
percentage <- OsPath -> m Percentage
forall (m :: Type -> Type).
(MonadFileReader m, MonadThrow m) =>
OsPath -> m Percentage
parsePercentage OsPath
percentPath
  pure $ Percentage -> BatteryStatus -> Battery
MkBattery Percentage
percentage BatteryStatus
status

findSysBatDir :: (MonadPathReader m, MonadThrow m) => m OsPath
findSysBatDir :: forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m) =>
m OsPath
findSysBatDir = do
  Bool
sysExists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
Dir.doesDirectoryExist OsPath
sysDir
  OsPath
sysBase <-
    if Bool
sysExists
      then OsPath -> m OsPath
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OsPath
sysDir
      else do
        Bool
sysFsExists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
Dir.doesDirectoryExist OsPath
sysfsDir
        if Bool
sysFsExists
          then OsPath -> m OsPath
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OsPath
sysfsDir
          else SysFsDirNotFound -> m OsPath
forall (m :: Type -> Type) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS SysFsDirNotFound
MkSysFsDirNotFound
  OsPath -> m OsPath
forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m) =>
OsPath -> m OsPath
findBatteryDir OsPath
sysBase

findBatteryDir :: (MonadPathReader m, MonadThrow m) => OsPath -> m OsPath
findBatteryDir :: forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m) =>
OsPath -> m OsPath
findBatteryDir OsPath
sysBase = do
  Maybe OsPath
mResult <- (OsPath -> m (Maybe OsPath) -> m (Maybe OsPath))
-> m (Maybe OsPath) -> [OsPath] -> m (Maybe OsPath)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OsPath -> m (Maybe OsPath) -> m (Maybe OsPath)
firstExists (Maybe OsPath -> m (Maybe OsPath)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe OsPath
forall a. Maybe a
Nothing) [OsPath]
batDirs
  case Maybe OsPath
mResult of
    Maybe OsPath
Nothing -> SysFsBatteryDirNotFound -> m OsPath
forall (m :: Type -> Type) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS SysFsBatteryDirNotFound
MkSysFsBatteryDirNotFound
    Just OsPath
result -> OsPath -> m OsPath
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OsPath
result
  where
    firstExists :: OsPath -> m (Maybe OsPath) -> m (Maybe OsPath)
firstExists OsPath
batDir m (Maybe OsPath)
acc = do
      Maybe OsPath
e <- OsPath -> m (Maybe OsPath)
forall (m :: Type -> Type).
MonadPathReader m =>
OsPath -> m (Maybe OsPath)
maybeDirExists (OsPath
sysBase OsPath -> OsPath -> OsPath
</> OsPath
batDir)
      case Maybe OsPath
e of
        Maybe OsPath
Nothing -> m (Maybe OsPath)
acc
        Just OsPath
e' -> Maybe OsPath -> m (Maybe OsPath)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe OsPath -> m (Maybe OsPath))
-> Maybe OsPath -> m (Maybe OsPath)
forall a b. (a -> b) -> a -> b
$ OsPath -> Maybe OsPath
forall a. a -> Maybe a
Just OsPath
e'
    batDirs :: [OsPath]
batDirs =
      [ [osp|BAT0|],
        [osp|BAT1|],
        [osp|BAT2|],
        [osp|BAT3|],
        [osp|BAT4|],
        [osp|BAT5|],
        [osp|BAT|]
      ]

maybeDirExists :: (MonadPathReader m) => OsPath -> m (Maybe OsPath)
maybeDirExists :: forall (m :: Type -> Type).
MonadPathReader m =>
OsPath -> m (Maybe OsPath)
maybeDirExists OsPath
fp = do
  Bool
b <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
Dir.doesDirectoryExist OsPath
fp
  pure
    $ if Bool
b
      then OsPath -> Maybe OsPath
forall a. a -> Maybe a
Just OsPath
fp
      else Maybe OsPath
forall a. Maybe a
Nothing

parseStatus :: (MonadFileReader m, MonadThrow m) => OsPath -> m BatteryStatus
parseStatus :: forall (m :: Type -> Type).
(MonadFileReader m, MonadThrow m) =>
OsPath -> m BatteryStatus
parseStatus OsPath
fp = do
  Text
statusTxt <-
    Text -> Text
T.toLower
      (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip
      (Text -> Text) -> m Text -> m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m Text
forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m) =>
OsPath -> m Text
readFileUtf8Lenient OsPath
fp
  case Text
statusTxt of
    Text
"charging" -> BatteryStatus -> m BatteryStatus
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure BatteryStatus
Charging
    Text
"discharging" -> BatteryStatus -> m BatteryStatus
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure BatteryStatus
Discharging
    Text
"not charging" -> BatteryStatus -> m BatteryStatus
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure BatteryStatus
Pending
    Text
"full" -> BatteryStatus -> m BatteryStatus
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure BatteryStatus
Full
    Text
bad -> SysFsBatteryParseError -> m BatteryStatus
forall (m :: Type -> Type) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (SysFsBatteryParseError -> m BatteryStatus)
-> SysFsBatteryParseError -> m BatteryStatus
forall a b. (a -> b) -> a -> b
$ Text -> SysFsBatteryParseError
MkSysFsBatteryParseError (Text -> SysFsBatteryParseError) -> Text -> SysFsBatteryParseError
forall a b. (a -> b) -> a -> b
$ Text
"Unknown status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bad

parsePercentage :: (MonadFileReader m, MonadThrow m) => OsPath -> m Percentage
parsePercentage :: forall (m :: Type -> Type).
(MonadFileReader m, MonadThrow m) =>
OsPath -> m Percentage
parsePercentage OsPath
fp = do
  Text
percentTxt <- OsPath -> m Text
forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m) =>
OsPath -> m Text
readFileUtf8Lenient OsPath
fp
  case Text -> Maybe Percentage
readPercentage Text
percentTxt of
    Maybe Percentage
Nothing -> SysFsBatteryParseError -> m Percentage
forall (m :: Type -> Type) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (SysFsBatteryParseError -> m Percentage)
-> SysFsBatteryParseError -> m Percentage
forall a b. (a -> b) -> a -> b
$ Text -> SysFsBatteryParseError
MkSysFsBatteryParseError Text
percentTxt
    Just Percentage
bs -> Percentage -> m Percentage
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Percentage
bs
  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