{-# LANGUAGE QuasiQuotes #-}

-- | This module provides functionality for retrieving memory usage using Free.
--
-- @since 0.1
module Pythia.Services.Memory.Free
  ( -- * Query
    memoryShellApp,
    supported,

    -- * Misc
    FreeParseError (..),
    parseMemory,
  )
where

import Data.Bytes (Bytes (MkBytes))
import Data.Char qualified as Char
import Data.Text qualified as T
import Pythia.Internal.ShellApp
  ( SimpleShell
      ( MkSimpleShell,
        command,
        isSupported,
        parser
      ),
  )
import Pythia.Internal.ShellApp qualified as ShellApp
import Pythia.Prelude
import Pythia.Services.Memory.Types
  ( Memory (MkMemory),
    SystemMemory (MkSystemMemory),
  )
import Pythia.Utils qualified as U
import Text.Megaparsec (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 acpi.
--
-- ==== __Examples__
--
-- >>> displayException $ MkFreeParseError "parse error"
-- "Could not parse memory from: parse error"
--
-- @since 0.1
type FreeParseError :: Type
newtype FreeParseError = MkFreeParseError Text
  deriving stock
    ( -- | @since 0.1
      FreeParseError -> FreeParseError -> Bool
(FreeParseError -> FreeParseError -> Bool)
-> (FreeParseError -> FreeParseError -> Bool) -> Eq FreeParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FreeParseError -> FreeParseError -> Bool
== :: FreeParseError -> FreeParseError -> Bool
$c/= :: FreeParseError -> FreeParseError -> Bool
/= :: FreeParseError -> FreeParseError -> Bool
Eq,
      -- | @since 0.1
      Int -> FreeParseError -> ShowS
[FreeParseError] -> ShowS
FreeParseError -> String
(Int -> FreeParseError -> ShowS)
-> (FreeParseError -> String)
-> ([FreeParseError] -> ShowS)
-> Show FreeParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FreeParseError -> ShowS
showsPrec :: Int -> FreeParseError -> ShowS
$cshow :: FreeParseError -> String
show :: FreeParseError -> String
$cshowList :: [FreeParseError] -> ShowS
showList :: [FreeParseError] -> ShowS
Show
    )

-- | @since 0.1
instance Exception FreeParseError where
  displayException :: FreeParseError -> String
displayException (MkFreeParseError Text
e) =
    (String
"Could not parse memory from: " 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

-- | Free query for 'Memory'.
--
-- @since 0.1
memoryShellApp ::
  ( MonadPathReader m,
    MonadThrow m,
    MonadTypedProcess m
  ) =>
  m SystemMemory
memoryShellApp :: forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m, MonadTypedProcess m) =>
m SystemMemory
memoryShellApp = SimpleShell m FreeParseError SystemMemory -> m SystemMemory
forall (m :: Type -> Type) err result.
(Exception err, MonadThrow m, MonadTypedProcess m) =>
SimpleShell m err result -> m result
ShellApp.runSimple SimpleShell m FreeParseError SystemMemory
shell
  where
    shell :: SimpleShell m FreeParseError SystemMemory
shell =
      MkSimpleShell
        { $sel:command:MkSimpleShell :: Command
command = Command
"free --bytes",
          $sel:isSupported:MkSimpleShell :: m Bool
isSupported = m Bool
forall (m :: Type -> Type). MonadPathReader m => m Bool
supported,
          $sel:parser:MkSimpleShell :: Text -> Either FreeParseError SystemMemory
parser = Text -> Either FreeParseError SystemMemory
parseMemory
        }
{-# INLINEABLE memoryShellApp #-}

-- | 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|free|]
{-# INLINEABLE supported #-}

-- | Attempts to parse the output of free.
--
-- @since 0.1
parseMemory :: Text -> Either FreeParseError SystemMemory
parseMemory :: Text -> Either FreeParseError SystemMemory
parseMemory Text
txt = case (Text -> Maybe SystemMemory) -> [Text] -> Maybe SystemMemory
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Alternative f) =>
(a -> f b) -> t a -> f b
U.foldAlt Text -> Maybe SystemMemory
parseLine [Text]
ts of
  Maybe SystemMemory
Nothing -> FreeParseError -> Either FreeParseError SystemMemory
forall a b. a -> Either a b
Left (FreeParseError -> Either FreeParseError SystemMemory)
-> FreeParseError -> Either FreeParseError SystemMemory
forall a b. (a -> b) -> a -> b
$ Text -> FreeParseError
MkFreeParseError Text
txt
  Just SystemMemory
mem -> SystemMemory -> Either FreeParseError SystemMemory
forall a b. b -> Either a b
Right SystemMemory
mem
  where
    ts :: [Text]
ts = Text -> [Text]
T.lines Text
txt
{-# INLINEABLE parseMemory #-}

parseLine :: Text -> Maybe SystemMemory
parseLine :: Text -> Maybe SystemMemory
parseLine Text
ln = case Parsec Void Text SystemMemory
-> String
-> Text
-> Either (ParseErrorBundle Text Void) SystemMemory
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text SystemMemory
mparseMemory String
"Memory.hs" Text
ln of
  Right SystemMemory
mem -> SystemMemory -> Maybe SystemMemory
forall a. a -> Maybe a
Just SystemMemory
mem
  Left ParseErrorBundle Text Void
_ -> Maybe SystemMemory
forall a. Maybe a
Nothing
{-# INLINEABLE parseLine #-}

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

mparseMemory :: MParser SystemMemory
mparseMemory :: Parsec Void Text SystemMemory
mparseMemory = do
  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
"Mem:"
  Natural
total <- ParsecT Void Text Identity Natural
parsePos
  Natural
used <- ParsecT Void Text Identity Natural
parseNat
  ParsecT Void Text Identity Natural
parseNat
  Natural
shared <- ParsecT Void Text Identity Natural
parseNat
  pure $ Memory -> Memory -> SystemMemory
MkSystemMemory (Bytes 'B Natural -> Memory
MkMemory (Natural -> Bytes 'B Natural
forall (s :: Size) n. n -> Bytes s n
MkBytes Natural
total)) (Bytes 'B Natural -> Memory
MkMemory (Natural -> Bytes 'B Natural
forall (s :: Size) n. n -> Bytes s n
MkBytes (Natural
used Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
shared)))
  where
    parseNat :: ParsecT Void Text Identity Natural
parseNat = (Tokens Text -> Maybe Natural)
-> ParsecT Void Text Identity Natural
forall {s} {m :: Type -> Type} {e} {a}.
(Token s ~ Char, MonadParsec e s m) =>
(Tokens s -> Maybe a) -> m a
parseBytes Text -> Maybe Natural
Tokens Text -> Maybe Natural
readNat
    parsePos :: ParsecT Void Text Identity Natural
parsePos = (Tokens Text -> Maybe Natural)
-> ParsecT Void Text Identity Natural
forall {s} {m :: Type -> Type} {e} {a}.
(Token s ~ Char, MonadParsec e s m) =>
(Tokens s -> Maybe a) -> m a
parseBytes Text -> Maybe Natural
Tokens Text -> Maybe Natural
readPos
    parseBytes :: (Tokens s -> Maybe a) -> m a
parseBytes Tokens s -> Maybe a
parseFn = do
      m ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space1
      Tokens s
num <- Maybe String -> (Token s -> Bool) -> m (Tokens s)
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 s -> Bool
Char.isDigit
      m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
forall a. m a
forall (f :: Type -> Type) a. Alternative f => f a
empty a -> m a
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Tokens s -> Maybe a
parseFn Tokens s
num)
    readNat :: Text -> Maybe Natural
readNat = String -> Maybe Natural
forall a. Read a => String -> Maybe a
TR.readMaybe (String -> Maybe Natural)
-> (Text -> String) -> Text -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    readPos :: Text -> Maybe Natural
readPos = String -> Maybe Natural
forall a. Read a => String -> Maybe a
TR.readMaybe (String -> Maybe Natural)
-> (Text -> String) -> Text -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
{-# INLINEABLE mparseMemory #-}