{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module SDL.Power
  ( -- * Power Status
    getPowerInfo
  , PowerState(..)
  , BatteryState(..)
  , Charge(..)
  ) where

import Control.Applicative
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Data (Data)
import Data.Typeable
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Storable
import GHC.Generics (Generic)

import qualified SDL.Raw as Raw

-- | Current power supply details.
--
-- Throws 'SDLException' if the current power state can not be determined.
--
-- See @<https://wiki.libsdl.org/SDL_GetPowerInfo SDL_GetPowerInfo>@ for C documentation.
getPowerInfo :: (Functor m, MonadIO m) => m PowerState
getPowerInfo :: m PowerState
getPowerInfo =
  IO PowerState -> m PowerState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PowerState -> m PowerState) -> IO PowerState -> m PowerState
forall a b. (a -> b) -> a -> b
$
  (Ptr CInt -> IO PowerState) -> IO PowerState
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO PowerState) -> IO PowerState)
-> (Ptr CInt -> IO PowerState) -> IO PowerState
forall a b. (a -> b) -> a -> b
$ \secsPtr :: Ptr CInt
secsPtr ->
  (Ptr CInt -> IO PowerState) -> IO PowerState
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO PowerState) -> IO PowerState)
-> (Ptr CInt -> IO PowerState) -> IO PowerState
forall a b. (a -> b) -> a -> b
$ \pctPtr :: Ptr CInt
pctPtr -> do
    PowerState
state <- Ptr CInt -> Ptr CInt -> IO PowerState
forall (m :: * -> *).
MonadIO m =>
Ptr CInt -> Ptr CInt -> m PowerState
Raw.getPowerInfo Ptr CInt
secsPtr Ptr CInt
pctPtr
    let peekCharge :: IO Charge
peekCharge = (Maybe CInt -> Maybe CInt -> Charge)
-> IO (Maybe CInt) -> IO (Maybe CInt) -> IO Charge
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Maybe CInt -> Maybe CInt -> Charge
Charge ((Ptr CInt -> IO CInt) -> Ptr CInt -> IO (Maybe CInt)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
secsPtr) ((Ptr CInt -> IO CInt) -> Ptr CInt -> IO (Maybe CInt)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pctPtr)
    case PowerState
state of
     Raw.SDL_POWERSTATE_ON_BATTERY -> (Charge -> PowerState) -> IO Charge -> IO PowerState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BatteryState -> Charge -> PowerState
Battery BatteryState
Draining) IO Charge
peekCharge
     Raw.SDL_POWERSTATE_CHARGING -> (Charge -> PowerState) -> IO Charge -> IO PowerState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BatteryState -> Charge -> PowerState
Battery BatteryState
Charging) IO Charge
peekCharge
     Raw.SDL_POWERSTATE_CHARGED -> (Charge -> PowerState) -> IO Charge -> IO PowerState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BatteryState -> Charge -> PowerState
Battery BatteryState
Charged) IO Charge
peekCharge
     Raw.SDL_POWERSTATE_NO_BATTERY -> PowerState -> IO PowerState
forall (f :: * -> *) a. Applicative f => a -> f a
pure PowerState
Mains
     _ -> PowerState -> IO PowerState
forall (f :: * -> *) a. Applicative f => a -> f a
pure PowerState
UnknownPowerState

-- | Information about the power supply for the user's environment
data PowerState
  = Battery BatteryState Charge
    -- ^ The user is on a battery powered device. See 'BatteryState' for charge information, and 'Charge' for charge information
  | Mains
    -- ^ The user is on a device connected to the mains.
  | UnknownPowerState
    -- ^ SDL could not determine the power for the device.
  deriving (PowerState -> PowerState -> Bool
(PowerState -> PowerState -> Bool)
-> (PowerState -> PowerState -> Bool) -> Eq PowerState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PowerState -> PowerState -> Bool
$c/= :: PowerState -> PowerState -> Bool
== :: PowerState -> PowerState -> Bool
$c== :: PowerState -> PowerState -> Bool
Eq, (forall x. PowerState -> Rep PowerState x)
-> (forall x. Rep PowerState x -> PowerState) -> Generic PowerState
forall x. Rep PowerState x -> PowerState
forall x. PowerState -> Rep PowerState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PowerState x -> PowerState
$cfrom :: forall x. PowerState -> Rep PowerState x
Generic, Eq PowerState
Eq PowerState =>
(PowerState -> PowerState -> Ordering)
-> (PowerState -> PowerState -> Bool)
-> (PowerState -> PowerState -> Bool)
-> (PowerState -> PowerState -> Bool)
-> (PowerState -> PowerState -> Bool)
-> (PowerState -> PowerState -> PowerState)
-> (PowerState -> PowerState -> PowerState)
-> Ord PowerState
PowerState -> PowerState -> Bool
PowerState -> PowerState -> Ordering
PowerState -> PowerState -> PowerState
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
min :: PowerState -> PowerState -> PowerState
$cmin :: PowerState -> PowerState -> PowerState
max :: PowerState -> PowerState -> PowerState
$cmax :: PowerState -> PowerState -> PowerState
>= :: PowerState -> PowerState -> Bool
$c>= :: PowerState -> PowerState -> Bool
> :: PowerState -> PowerState -> Bool
$c> :: PowerState -> PowerState -> Bool
<= :: PowerState -> PowerState -> Bool
$c<= :: PowerState -> PowerState -> Bool
< :: PowerState -> PowerState -> Bool
$c< :: PowerState -> PowerState -> Bool
compare :: PowerState -> PowerState -> Ordering
$ccompare :: PowerState -> PowerState -> Ordering
$cp1Ord :: Eq PowerState
Ord, ReadPrec [PowerState]
ReadPrec PowerState
Int -> ReadS PowerState
ReadS [PowerState]
(Int -> ReadS PowerState)
-> ReadS [PowerState]
-> ReadPrec PowerState
-> ReadPrec [PowerState]
-> Read PowerState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PowerState]
$creadListPrec :: ReadPrec [PowerState]
readPrec :: ReadPrec PowerState
$creadPrec :: ReadPrec PowerState
readList :: ReadS [PowerState]
$creadList :: ReadS [PowerState]
readsPrec :: Int -> ReadS PowerState
$creadsPrec :: Int -> ReadS PowerState
Read, Int -> PowerState -> ShowS
[PowerState] -> ShowS
PowerState -> String
(Int -> PowerState -> ShowS)
-> (PowerState -> String)
-> ([PowerState] -> ShowS)
-> Show PowerState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PowerState] -> ShowS
$cshowList :: [PowerState] -> ShowS
show :: PowerState -> String
$cshow :: PowerState -> String
showsPrec :: Int -> PowerState -> ShowS
$cshowsPrec :: Int -> PowerState -> ShowS
Show, Typeable)

-- | Information on battery consumption for battery powered devices
data BatteryState
  = Draining
    -- ^ The battery is currently being drained.
  | Charged
    -- ^ The battery is fully charged.
  | Charging
    -- ^ The device is plugged in and the battery is charging.
  deriving (BatteryState
BatteryState -> BatteryState -> Bounded BatteryState
forall a. a -> a -> Bounded a
maxBound :: BatteryState
$cmaxBound :: BatteryState
minBound :: BatteryState
$cminBound :: BatteryState
Bounded, Typeable BatteryState
DataType
Constr
Typeable BatteryState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BatteryState -> c BatteryState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BatteryState)
-> (BatteryState -> Constr)
-> (BatteryState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BatteryState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BatteryState))
-> ((forall b. Data b => b -> b) -> BatteryState -> BatteryState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BatteryState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BatteryState -> r)
-> (forall u. (forall d. Data d => d -> u) -> BatteryState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BatteryState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BatteryState -> m BatteryState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BatteryState -> m BatteryState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BatteryState -> m BatteryState)
-> Data BatteryState
BatteryState -> DataType
BatteryState -> Constr
(forall b. Data b => b -> b) -> BatteryState -> BatteryState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BatteryState -> c BatteryState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BatteryState
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BatteryState -> u
forall u. (forall d. Data d => d -> u) -> BatteryState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BatteryState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BatteryState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BatteryState -> m BatteryState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BatteryState -> m BatteryState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BatteryState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BatteryState -> c BatteryState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BatteryState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BatteryState)
$cCharging :: Constr
$cCharged :: Constr
$cDraining :: Constr
$tBatteryState :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BatteryState -> m BatteryState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BatteryState -> m BatteryState
gmapMp :: (forall d. Data d => d -> m d) -> BatteryState -> m BatteryState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BatteryState -> m BatteryState
gmapM :: (forall d. Data d => d -> m d) -> BatteryState -> m BatteryState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BatteryState -> m BatteryState
gmapQi :: Int -> (forall d. Data d => d -> u) -> BatteryState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BatteryState -> u
gmapQ :: (forall d. Data d => d -> u) -> BatteryState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BatteryState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BatteryState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BatteryState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BatteryState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BatteryState -> r
gmapT :: (forall b. Data b => b -> b) -> BatteryState -> BatteryState
$cgmapT :: (forall b. Data b => b -> b) -> BatteryState -> BatteryState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BatteryState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BatteryState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BatteryState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BatteryState)
dataTypeOf :: BatteryState -> DataType
$cdataTypeOf :: BatteryState -> DataType
toConstr :: BatteryState -> Constr
$ctoConstr :: BatteryState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BatteryState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BatteryState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BatteryState -> c BatteryState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BatteryState -> c BatteryState
$cp1Data :: Typeable BatteryState
Data, Int -> BatteryState
BatteryState -> Int
BatteryState -> [BatteryState]
BatteryState -> BatteryState
BatteryState -> BatteryState -> [BatteryState]
BatteryState -> BatteryState -> BatteryState -> [BatteryState]
(BatteryState -> BatteryState)
-> (BatteryState -> BatteryState)
-> (Int -> BatteryState)
-> (BatteryState -> Int)
-> (BatteryState -> [BatteryState])
-> (BatteryState -> BatteryState -> [BatteryState])
-> (BatteryState -> BatteryState -> [BatteryState])
-> (BatteryState -> BatteryState -> BatteryState -> [BatteryState])
-> Enum BatteryState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BatteryState -> BatteryState -> BatteryState -> [BatteryState]
$cenumFromThenTo :: BatteryState -> BatteryState -> BatteryState -> [BatteryState]
enumFromTo :: BatteryState -> BatteryState -> [BatteryState]
$cenumFromTo :: BatteryState -> BatteryState -> [BatteryState]
enumFromThen :: BatteryState -> BatteryState -> [BatteryState]
$cenumFromThen :: BatteryState -> BatteryState -> [BatteryState]
enumFrom :: BatteryState -> [BatteryState]
$cenumFrom :: BatteryState -> [BatteryState]
fromEnum :: BatteryState -> Int
$cfromEnum :: BatteryState -> Int
toEnum :: Int -> BatteryState
$ctoEnum :: Int -> BatteryState
pred :: BatteryState -> BatteryState
$cpred :: BatteryState -> BatteryState
succ :: BatteryState -> BatteryState
$csucc :: BatteryState -> BatteryState
Enum, BatteryState -> BatteryState -> Bool
(BatteryState -> BatteryState -> Bool)
-> (BatteryState -> BatteryState -> Bool) -> Eq BatteryState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatteryState -> BatteryState -> Bool
$c/= :: BatteryState -> BatteryState -> Bool
== :: BatteryState -> BatteryState -> Bool
$c== :: BatteryState -> BatteryState -> Bool
Eq, (forall x. BatteryState -> Rep BatteryState x)
-> (forall x. Rep BatteryState x -> BatteryState)
-> Generic BatteryState
forall x. Rep BatteryState x -> BatteryState
forall x. BatteryState -> Rep BatteryState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatteryState x -> BatteryState
$cfrom :: forall x. BatteryState -> Rep BatteryState x
Generic, Eq BatteryState
Eq BatteryState =>
(BatteryState -> BatteryState -> Ordering)
-> (BatteryState -> BatteryState -> Bool)
-> (BatteryState -> BatteryState -> Bool)
-> (BatteryState -> BatteryState -> Bool)
-> (BatteryState -> BatteryState -> Bool)
-> (BatteryState -> BatteryState -> BatteryState)
-> (BatteryState -> BatteryState -> BatteryState)
-> Ord BatteryState
BatteryState -> BatteryState -> Bool
BatteryState -> BatteryState -> Ordering
BatteryState -> BatteryState -> BatteryState
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
min :: BatteryState -> BatteryState -> BatteryState
$cmin :: BatteryState -> BatteryState -> BatteryState
max :: BatteryState -> BatteryState -> BatteryState
$cmax :: BatteryState -> BatteryState -> BatteryState
>= :: BatteryState -> BatteryState -> Bool
$c>= :: BatteryState -> BatteryState -> Bool
> :: BatteryState -> BatteryState -> Bool
$c> :: BatteryState -> BatteryState -> Bool
<= :: BatteryState -> BatteryState -> Bool
$c<= :: BatteryState -> BatteryState -> Bool
< :: BatteryState -> BatteryState -> Bool
$c< :: BatteryState -> BatteryState -> Bool
compare :: BatteryState -> BatteryState -> Ordering
$ccompare :: BatteryState -> BatteryState -> Ordering
$cp1Ord :: Eq BatteryState
Ord, ReadPrec [BatteryState]
ReadPrec BatteryState
Int -> ReadS BatteryState
ReadS [BatteryState]
(Int -> ReadS BatteryState)
-> ReadS [BatteryState]
-> ReadPrec BatteryState
-> ReadPrec [BatteryState]
-> Read BatteryState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatteryState]
$creadListPrec :: ReadPrec [BatteryState]
readPrec :: ReadPrec BatteryState
$creadPrec :: ReadPrec BatteryState
readList :: ReadS [BatteryState]
$creadList :: ReadS [BatteryState]
readsPrec :: Int -> ReadS BatteryState
$creadsPrec :: Int -> ReadS BatteryState
Read, Int -> BatteryState -> ShowS
[BatteryState] -> ShowS
BatteryState -> String
(Int -> BatteryState -> ShowS)
-> (BatteryState -> String)
-> ([BatteryState] -> ShowS)
-> Show BatteryState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatteryState] -> ShowS
$cshowList :: [BatteryState] -> ShowS
show :: BatteryState -> String
$cshow :: BatteryState -> String
showsPrec :: Int -> BatteryState -> ShowS
$cshowsPrec :: Int -> BatteryState -> ShowS
Show, Typeable)

-- | Information about how much charge a battery has.
data Charge =
  Charge {Charge -> Maybe CInt
chargeSecondsLeft :: Maybe CInt -- ^ How many seconds of battery life is left
         ,Charge -> Maybe CInt
chargePercent :: Maybe CInt -- ^ The percentage of battery charged
         }
  deriving (Charge -> Charge -> Bool
(Charge -> Charge -> Bool)
-> (Charge -> Charge -> Bool) -> Eq Charge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Charge -> Charge -> Bool
$c/= :: Charge -> Charge -> Bool
== :: Charge -> Charge -> Bool
$c== :: Charge -> Charge -> Bool
Eq, (forall x. Charge -> Rep Charge x)
-> (forall x. Rep Charge x -> Charge) -> Generic Charge
forall x. Rep Charge x -> Charge
forall x. Charge -> Rep Charge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Charge x -> Charge
$cfrom :: forall x. Charge -> Rep Charge x
Generic, Eq Charge
Eq Charge =>
(Charge -> Charge -> Ordering)
-> (Charge -> Charge -> Bool)
-> (Charge -> Charge -> Bool)
-> (Charge -> Charge -> Bool)
-> (Charge -> Charge -> Bool)
-> (Charge -> Charge -> Charge)
-> (Charge -> Charge -> Charge)
-> Ord Charge
Charge -> Charge -> Bool
Charge -> Charge -> Ordering
Charge -> Charge -> Charge
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
min :: Charge -> Charge -> Charge
$cmin :: Charge -> Charge -> Charge
max :: Charge -> Charge -> Charge
$cmax :: Charge -> Charge -> Charge
>= :: Charge -> Charge -> Bool
$c>= :: Charge -> Charge -> Bool
> :: Charge -> Charge -> Bool
$c> :: Charge -> Charge -> Bool
<= :: Charge -> Charge -> Bool
$c<= :: Charge -> Charge -> Bool
< :: Charge -> Charge -> Bool
$c< :: Charge -> Charge -> Bool
compare :: Charge -> Charge -> Ordering
$ccompare :: Charge -> Charge -> Ordering
$cp1Ord :: Eq Charge
Ord, ReadPrec [Charge]
ReadPrec Charge
Int -> ReadS Charge
ReadS [Charge]
(Int -> ReadS Charge)
-> ReadS [Charge]
-> ReadPrec Charge
-> ReadPrec [Charge]
-> Read Charge
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Charge]
$creadListPrec :: ReadPrec [Charge]
readPrec :: ReadPrec Charge
$creadPrec :: ReadPrec Charge
readList :: ReadS [Charge]
$creadList :: ReadS [Charge]
readsPrec :: Int -> ReadS Charge
$creadsPrec :: Int -> ReadS Charge
Read, Int -> Charge -> ShowS
[Charge] -> ShowS
Charge -> String
(Int -> Charge -> ShowS)
-> (Charge -> String) -> ([Charge] -> ShowS) -> Show Charge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Charge] -> ShowS
$cshowList :: [Charge] -> ShowS
show :: Charge -> String
$cshow :: Charge -> String
showsPrec :: Int -> Charge -> ShowS
$cshowsPrec :: Int -> Charge -> ShowS
Show, Typeable)