{-# LANGUAGE UndecidableInstances #-}

-- | This module provides the core types describing the memory.
--
-- @since 0.1
module Pythia.Services.Memory.Types
  ( MemoryApp (..),
    Memory (..),
    SystemMemory (..),
  )
where

import Data.Bytes (Bytes, Size (B))
import Data.Bytes qualified as Bytes
import Data.Bytes.Formatting
  ( FloatingFormatter (MkFloatingFormatter),
    formatSized,
    sizedFormatterUnix,
  )
import Pythia.Prelude

-- $setup
-- >>> import Pythia.Prelude

-- | Determines how we should query the system for memory usage.
--
-- @since 0.1
type MemoryApp :: Type
data MemoryApp
  = -- | Uses the free utility.
    --
    -- @since 0.1
    MemoryAppFree
  deriving stock
    ( -- | @since 0.1
      MemoryApp
MemoryApp -> MemoryApp -> Bounded MemoryApp
forall a. a -> a -> Bounded a
$cminBound :: MemoryApp
minBound :: MemoryApp
$cmaxBound :: MemoryApp
maxBound :: MemoryApp
Bounded,
      -- | @since 0.1
      Int -> MemoryApp
MemoryApp -> Int
MemoryApp -> [MemoryApp]
MemoryApp -> MemoryApp
MemoryApp -> MemoryApp -> [MemoryApp]
MemoryApp -> MemoryApp -> MemoryApp -> [MemoryApp]
(MemoryApp -> MemoryApp)
-> (MemoryApp -> MemoryApp)
-> (Int -> MemoryApp)
-> (MemoryApp -> Int)
-> (MemoryApp -> [MemoryApp])
-> (MemoryApp -> MemoryApp -> [MemoryApp])
-> (MemoryApp -> MemoryApp -> [MemoryApp])
-> (MemoryApp -> MemoryApp -> MemoryApp -> [MemoryApp])
-> Enum MemoryApp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MemoryApp -> MemoryApp
succ :: MemoryApp -> MemoryApp
$cpred :: MemoryApp -> MemoryApp
pred :: MemoryApp -> MemoryApp
$ctoEnum :: Int -> MemoryApp
toEnum :: Int -> MemoryApp
$cfromEnum :: MemoryApp -> Int
fromEnum :: MemoryApp -> Int
$cenumFrom :: MemoryApp -> [MemoryApp]
enumFrom :: MemoryApp -> [MemoryApp]
$cenumFromThen :: MemoryApp -> MemoryApp -> [MemoryApp]
enumFromThen :: MemoryApp -> MemoryApp -> [MemoryApp]
$cenumFromTo :: MemoryApp -> MemoryApp -> [MemoryApp]
enumFromTo :: MemoryApp -> MemoryApp -> [MemoryApp]
$cenumFromThenTo :: MemoryApp -> MemoryApp -> MemoryApp -> [MemoryApp]
enumFromThenTo :: MemoryApp -> MemoryApp -> MemoryApp -> [MemoryApp]
Enum,
      -- | @since 0.1
      MemoryApp -> MemoryApp -> Bool
(MemoryApp -> MemoryApp -> Bool)
-> (MemoryApp -> MemoryApp -> Bool) -> Eq MemoryApp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryApp -> MemoryApp -> Bool
== :: MemoryApp -> MemoryApp -> Bool
$c/= :: MemoryApp -> MemoryApp -> Bool
/= :: MemoryApp -> MemoryApp -> Bool
Eq,
      -- | @since 0.1
      (forall x. MemoryApp -> Rep MemoryApp x)
-> (forall x. Rep MemoryApp x -> MemoryApp) -> Generic MemoryApp
forall x. Rep MemoryApp x -> MemoryApp
forall x. MemoryApp -> Rep MemoryApp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MemoryApp -> Rep MemoryApp x
from :: forall x. MemoryApp -> Rep MemoryApp x
$cto :: forall x. Rep MemoryApp x -> MemoryApp
to :: forall x. Rep MemoryApp x -> MemoryApp
Generic,
      -- | @since 0.1
      Eq MemoryApp
Eq MemoryApp =>
(MemoryApp -> MemoryApp -> Ordering)
-> (MemoryApp -> MemoryApp -> Bool)
-> (MemoryApp -> MemoryApp -> Bool)
-> (MemoryApp -> MemoryApp -> Bool)
-> (MemoryApp -> MemoryApp -> Bool)
-> (MemoryApp -> MemoryApp -> MemoryApp)
-> (MemoryApp -> MemoryApp -> MemoryApp)
-> Ord MemoryApp
MemoryApp -> MemoryApp -> Bool
MemoryApp -> MemoryApp -> Ordering
MemoryApp -> MemoryApp -> MemoryApp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MemoryApp -> MemoryApp -> Ordering
compare :: MemoryApp -> MemoryApp -> Ordering
$c< :: MemoryApp -> MemoryApp -> Bool
< :: MemoryApp -> MemoryApp -> Bool
$c<= :: MemoryApp -> MemoryApp -> Bool
<= :: MemoryApp -> MemoryApp -> Bool
$c> :: MemoryApp -> MemoryApp -> Bool
> :: MemoryApp -> MemoryApp -> Bool
$c>= :: MemoryApp -> MemoryApp -> Bool
>= :: MemoryApp -> MemoryApp -> Bool
$cmax :: MemoryApp -> MemoryApp -> MemoryApp
max :: MemoryApp -> MemoryApp -> MemoryApp
$cmin :: MemoryApp -> MemoryApp -> MemoryApp
min :: MemoryApp -> MemoryApp -> MemoryApp
Ord,
      -- | @since 0.1
      Int -> MemoryApp -> ShowS
[MemoryApp] -> ShowS
MemoryApp -> [Char]
(Int -> MemoryApp -> ShowS)
-> (MemoryApp -> [Char])
-> ([MemoryApp] -> ShowS)
-> Show MemoryApp
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryApp -> ShowS
showsPrec :: Int -> MemoryApp -> ShowS
$cshow :: MemoryApp -> [Char]
show :: MemoryApp -> [Char]
$cshowList :: [MemoryApp] -> ShowS
showList :: [MemoryApp] -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1.0.0
      MemoryApp -> ()
(MemoryApp -> ()) -> NFData MemoryApp
forall a. (a -> ()) -> NFData a
$crnf :: MemoryApp -> ()
rnf :: MemoryApp -> ()
NFData
    )

-- | Represents the current memory usage. The type parameter is some wrapper
-- around the memory intended to enforce an invariant e.g. non-negative.
--
-- @since 0.1
type Memory :: Type
newtype Memory = MkMemory {Memory -> Bytes 'B Natural
unMemory :: Bytes B Natural}
  deriving stock
    ( -- | @since 0.1
      Memory -> Memory -> Bool
(Memory -> Memory -> Bool)
-> (Memory -> Memory -> Bool) -> Eq Memory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Memory -> Memory -> Bool
== :: Memory -> Memory -> Bool
$c/= :: Memory -> Memory -> Bool
/= :: Memory -> Memory -> Bool
Eq,
      -- | @since 0.1
      (forall x. Memory -> Rep Memory x)
-> (forall x. Rep Memory x -> Memory) -> Generic Memory
forall x. Rep Memory x -> Memory
forall x. Memory -> Rep Memory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Memory -> Rep Memory x
from :: forall x. Memory -> Rep Memory x
$cto :: forall x. Rep Memory x -> Memory
to :: forall x. Rep Memory x -> Memory
Generic,
      -- | @since 0.1
      Int -> Memory -> ShowS
[Memory] -> ShowS
Memory -> [Char]
(Int -> Memory -> ShowS)
-> (Memory -> [Char]) -> ([Memory] -> ShowS) -> Show Memory
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Memory -> ShowS
showsPrec :: Int -> Memory -> ShowS
$cshow :: Memory -> [Char]
show :: Memory -> [Char]
$cshowList :: [Memory] -> ShowS
showList :: [Memory] -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      Memory -> ()
(Memory -> ()) -> NFData Memory
forall a. (a -> ()) -> NFData a
$crnf :: Memory -> ()
rnf :: Memory -> ()
NFData
    )

-- | @since 0.1
instance
  (k ~ An_Iso, a ~ Bytes 'B Natural, b ~ Bytes B Natural) =>
  LabelOptic "unMemory" k Memory Memory a b
  where
  labelOptic :: Optic k NoIx Memory Memory a b
labelOptic = (Memory -> a) -> (b -> Memory) -> Iso Memory Memory a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(MkMemory Bytes 'B Natural
p) -> a
Bytes 'B Natural
p) b -> Memory
Bytes 'B Natural -> Memory
MkMemory
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance Display Memory where
  displayBuilder :: Memory -> Builder
displayBuilder (MkMemory Bytes 'B Natural
bytes) = Text -> Builder
forall a. Display a => a -> Builder
displayBuilder Text
formatted
    where
      bytes' :: Norm (Bytes 'B Double)
bytes' = Bytes 'B Double -> Norm (Bytes 'B Double)
forall a. Normalize a => a -> Norm a
Bytes.normalize (Bytes 'B Double -> Norm (Bytes 'B Double))
-> Bytes 'B Double -> Norm (Bytes 'B Double)
forall a b. (a -> b) -> a -> b
$ (Natural -> Double) -> Bytes 'B Natural -> Bytes 'B Double
forall a b. (a -> b) -> Bytes 'B a -> Bytes 'B b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> Double
natToDouble Bytes 'B Natural
bytes
      formatted :: Text
formatted = BaseFormatter (Unwrapped (SomeSize Double))
-> SizedFormatter -> SomeSize Double -> Text
forall a.
(Formatter (BaseFormatter (Unwrapped a)), PrintfArg (Unwrapped a),
 Sized a, Unwrapper a) =>
BaseFormatter (Unwrapped a) -> SizedFormatter -> a -> Text
formatSized (Maybe Word8 -> FloatingFormatter
MkFloatingFormatter (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
2)) SizedFormatter
sizedFormatterUnix Norm (Bytes 'B Double)
SomeSize Double
bytes'

-- | Represents the current memory usage.
--
-- @since 0.1
type SystemMemory :: Type
data SystemMemory = MkSystemMemory
  { -- | The total memory on this system.
    --
    -- @since 0.1
    SystemMemory -> Memory
total :: Memory,
    -- | The memory currently in use. This does not include the
    -- cache.
    --
    -- @since 0.1
    SystemMemory -> Memory
used :: Memory
  }
  deriving stock
    ( -- | @since 0.1
      SystemMemory -> SystemMemory -> Bool
(SystemMemory -> SystemMemory -> Bool)
-> (SystemMemory -> SystemMemory -> Bool) -> Eq SystemMemory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SystemMemory -> SystemMemory -> Bool
== :: SystemMemory -> SystemMemory -> Bool
$c/= :: SystemMemory -> SystemMemory -> Bool
/= :: SystemMemory -> SystemMemory -> Bool
Eq,
      -- | @since 0.1
      (forall x. SystemMemory -> Rep SystemMemory x)
-> (forall x. Rep SystemMemory x -> SystemMemory)
-> Generic SystemMemory
forall x. Rep SystemMemory x -> SystemMemory
forall x. SystemMemory -> Rep SystemMemory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SystemMemory -> Rep SystemMemory x
from :: forall x. SystemMemory -> Rep SystemMemory x
$cto :: forall x. Rep SystemMemory x -> SystemMemory
to :: forall x. Rep SystemMemory x -> SystemMemory
Generic,
      -- | @since 0.1
      Int -> SystemMemory -> ShowS
[SystemMemory] -> ShowS
SystemMemory -> [Char]
(Int -> SystemMemory -> ShowS)
-> (SystemMemory -> [Char])
-> ([SystemMemory] -> ShowS)
-> Show SystemMemory
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SystemMemory -> ShowS
showsPrec :: Int -> SystemMemory -> ShowS
$cshow :: SystemMemory -> [Char]
show :: SystemMemory -> [Char]
$cshowList :: [SystemMemory] -> ShowS
showList :: [SystemMemory] -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      SystemMemory -> ()
(SystemMemory -> ()) -> NFData SystemMemory
forall a. (a -> ()) -> NFData a
$crnf :: SystemMemory -> ()
rnf :: SystemMemory -> ()
NFData
    )

-- | @since 0.1
instance Display SystemMemory where
  displayBuilder :: SystemMemory -> Builder
displayBuilder SystemMemory
mem =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ Memory -> Builder
forall a. Display a => a -> Builder
displayBuilder Memory
u,
        Builder
" / ",
        Memory -> Builder
forall a. Display a => a -> Builder
displayBuilder Memory
t
      ]
    where
      t :: Memory
t = SystemMemory
mem SystemMemory -> Optic' A_Lens NoIx SystemMemory Memory -> Memory
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SystemMemory Memory
#total
      u :: Memory
u = SystemMemory
mem SystemMemory -> Optic' A_Lens NoIx SystemMemory Memory -> Memory
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SystemMemory Memory
#used

-- | @since 0.1
instance
  (k ~ A_Lens, a ~ Memory, b ~ Memory) =>
  LabelOptic "total" k SystemMemory SystemMemory a b
  where
  labelOptic :: Optic k NoIx SystemMemory SystemMemory a b
labelOptic = LensVL SystemMemory SystemMemory a b
-> Lens SystemMemory SystemMemory a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL SystemMemory SystemMemory a b
 -> Lens SystemMemory SystemMemory a b)
-> LensVL SystemMemory SystemMemory a b
-> Lens SystemMemory SystemMemory a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkSystemMemory Memory
_total Memory
_used) ->
    (Memory -> SystemMemory) -> f Memory -> f SystemMemory
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Memory -> Memory -> SystemMemory
`MkSystemMemory` Memory
_used) (a -> f b
f a
Memory
_total)
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance
  (k ~ A_Lens, a ~ Memory, b ~ Memory) =>
  LabelOptic "used" k SystemMemory SystemMemory a b
  where
  labelOptic :: Optic k NoIx SystemMemory SystemMemory a b
labelOptic = LensVL SystemMemory SystemMemory a b
-> Lens SystemMemory SystemMemory a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL SystemMemory SystemMemory a b
 -> Lens SystemMemory SystemMemory a b)
-> LensVL SystemMemory SystemMemory a b
-> Lens SystemMemory SystemMemory a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkSystemMemory Memory
_total Memory
_used) ->
    (Memory -> SystemMemory) -> f Memory -> f SystemMemory
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Memory -> Memory -> SystemMemory
MkSystemMemory Memory
_total) (a -> f b
f a
Memory
_used)
  {-# INLINE labelOptic #-}