Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- class (Monad m, MonadIdentity mark) => MonadTeletype mark m where
- class (Monad m, MonadIdentity mark) => MonadSystemClock mark m where
- getSystemTime :: m (mark SystemTime)
- newtype TeletypeTT (mark :: * -> *) (t :: (* -> *) -> * -> *) (m :: * -> *) (a :: *) = TeletypeTT {
- unTeletypeTT :: OverTT (ExceptT TeletypeError (mark IOException)) (PromptTT mark (TeletypeAction mark)) t m a
- runTeletypeTT :: (Monad m, MonadTrans t, MonadIdentity mark, Commutant mark) => Eval (TeletypeAction mark) m -> TeletypeTT mark t m a -> t m (Except TeletypeError (mark IOException) a)
- data TeletypeAction mark a where
- ReadLine :: TeletypeAction mark (Except TeletypeError (mark IOException) String)
- PrintLine :: String -> TeletypeAction mark (Except TeletypeError (mark IOException) ())
- data TeletypeError (a :: *) = TeletypeError {
- unTeletypeError :: a
- evalTeletypeStdIO :: MonadIdentity mark => TeletypeAction mark a -> IO a
- evalTeletypeHandleIO :: MonadIdentity mark => Handle -> Handle -> TeletypeAction mark a -> IO a
- newtype SystemClockTT (mark :: * -> *) (t :: (* -> *) -> * -> *) (m :: * -> *) (a :: *) = SystemClockTT {
- unSystemClockTT :: PromptTT mark (SystemClockAction mark) t m a
- runSystemClockTT :: (Monad m, MonadTrans t, MonadIdentity mark, Commutant mark) => Eval (SystemClockAction mark) m -> SystemClockTT mark t m a -> t m a
- data SystemClockAction (mark :: * -> *) a where
- GetSystemTime :: SystemClockAction mark SystemTime
- evalSystemTimeIO :: MonadIdentity mark => SystemClockAction mark a -> IO a
- data family InputTT (u :: ((Type -> Type) -> Type -> Type) -> (Type -> Type) -> Type -> Type) (m :: Type -> Type) :: Type
- data family OutputTT (u :: ((Type -> Type) -> Type -> Type) -> (Type -> Type) -> Type -> Type) a :: Type
- data family Context (t :: Type -> Type) :: Type
- data IOException
- data SystemTime
Effect Classes
class (Monad m, MonadIdentity mark) => MonadTeletype mark m where Source #
Class representing monads which can interact with a teletype-style interface. This is an effects-only typeclass with no laws, so lifting through any transformer is safe.
Nothing
readLine :: m (mark String) Source #
Read a line of input
readLine :: (Monad m1, MonadTrans t1, m ~ t1 m1, MonadTeletype mark m1) => m (mark String) Source #
Read a line of input
printLine :: mark String -> m () Source #
Print a line of output
printLine :: (Monad m1, MonadTrans t1, m ~ t1 m1, MonadTeletype mark m1) => mark String -> m () Source #
Print a line of output
Instances
class (Monad m, MonadIdentity mark) => MonadSystemClock mark m where Source #
Class representing monads which have access to the current time in UTC format.
Nothing
getSystemTime :: m (mark SystemTime) Source #
Get the current SystemTime
getSystemTime :: (Monad m1, MonadTrans t1, m ~ t1 m1, MonadSystemClock mark m1) => m (mark SystemTime) Source #
Get the current SystemTime
Instances
Concrete Types
Teletype
newtype TeletypeTT (mark :: * -> *) (t :: (* -> *) -> * -> *) (m :: * -> *) (a :: *) Source #
Teletype monad transformer transformer
TeletypeTT | |
|
Instances
runTeletypeTT :: (Monad m, MonadTrans t, MonadIdentity mark, Commutant mark) => Eval (TeletypeAction mark) m -> TeletypeTT mark t m a -> t m (Except TeletypeError (mark IOException) a) Source #
data TeletypeAction mark a where Source #
Type representing atomic teletype actions
ReadLine :: TeletypeAction mark (Except TeletypeError (mark IOException) String) | |
PrintLine :: String -> TeletypeAction mark (Except TeletypeError (mark IOException) ()) |
Instances
(MonadTrans t, MonadIdentity mark, Monad m) => MonadPrompt mark (TeletypeAction mark) (TeletypeTT mark t m) Source # | |
Defined in Control.FX.Monad.Trans.Trans.IO.TeletypeTT prompt :: mark (TeletypeAction mark a) -> TeletypeTT mark t m (mark a) # |
data TeletypeError (a :: *) Source #
Instances
evalTeletypeStdIO :: MonadIdentity mark => TeletypeAction mark a -> IO a Source #
Default IO
evaluator
:: MonadIdentity mark | |
=> Handle | Input |
-> Handle | Output |
-> TeletypeAction mark a | |
-> IO a |
System Clock
newtype SystemClockTT (mark :: * -> *) (t :: (* -> *) -> * -> *) (m :: * -> *) (a :: *) Source #
System clock monad transformer transformer
SystemClockTT | |
|
Instances
runSystemClockTT :: (Monad m, MonadTrans t, MonadIdentity mark, Commutant mark) => Eval (SystemClockAction mark) m -> SystemClockTT mark t m a -> t m a Source #
data SystemClockAction (mark :: * -> *) a where Source #
Type representing atomic system clock actions
GetSystemTime :: SystemClockAction mark SystemTime |
Instances
(MonadTrans t, MonadIdentity mark, Monad m) => MonadPrompt mark (SystemClockAction mark) (SystemClockTT mark t m) Source # | |
Defined in Control.FX.Monad.Trans.Trans.IO.SystemClockTT prompt :: mark (SystemClockAction mark a) -> SystemClockTT mark t m (mark a) # |
evalSystemTimeIO :: MonadIdentity mark => SystemClockAction mark a -> IO a Source #
Default IO
evaluator
Values in Context
data family InputTT (u :: ((Type -> Type) -> Type -> Type) -> (Type -> Type) -> Type -> Type) (m :: Type -> Type) :: Type #
Instances
data family OutputTT (u :: ((Type -> Type) -> Type -> Type) -> (Type -> Type) -> Type -> Type) a :: Type #
Instances
data family Context (t :: Type -> Type) :: Type #
Instances
Misc
data IOException #
Exceptions that occur in the IO
monad.
An IOException
records a more specific error type, a descriptive
string and maybe the handle that was used when the error was
flagged.
Instances
Eq IOException | Since: base-4.1.0.0 |
Defined in GHC.IO.Exception (==) :: IOException -> IOException -> Bool # (/=) :: IOException -> IOException -> Bool # | |
Show IOException | Since: base-4.1.0.0 |
Defined in GHC.IO.Exception showsPrec :: Int -> IOException -> ShowS # show :: IOException -> String # showList :: [IOException] -> ShowS # | |
Exception IOException | Since: base-4.1.0.0 |
Defined in GHC.IO.Exception | |
(Monad m, MonadTrans t, MonadIdentity mark) => MonadExcept TeletypeError (mark IOException) (TeletypeTT mark t m) Source # | |
Defined in Control.FX.Monad.Trans.Trans.IO.TeletypeTT throw :: TeletypeError (mark IOException) -> TeletypeTT mark t m a # catch :: TeletypeTT mark t m a -> (TeletypeError (mark IOException) -> TeletypeTT mark t m a) -> TeletypeTT mark t m a # |
data SystemTime #
SystemTime
is time returned by system clock functions.
Its semantics depends on the clock function, but the epoch is typically the beginning of 1970.
Note that systemNanoseconds
of 1E9 to 2E9-1 can be used to represent leap seconds.
Instances
Eq SystemTime | |
Defined in Data.Time.Clock.Internal.SystemTime (==) :: SystemTime -> SystemTime -> Bool # (/=) :: SystemTime -> SystemTime -> Bool # | |
Ord SystemTime | |
Defined in Data.Time.Clock.Internal.SystemTime compare :: SystemTime -> SystemTime -> Ordering # (<) :: SystemTime -> SystemTime -> Bool # (<=) :: SystemTime -> SystemTime -> Bool # (>) :: SystemTime -> SystemTime -> Bool # (>=) :: SystemTime -> SystemTime -> Bool # max :: SystemTime -> SystemTime -> SystemTime # min :: SystemTime -> SystemTime -> SystemTime # | |
Show SystemTime | |
Defined in Data.Time.Clock.Internal.SystemTime showsPrec :: Int -> SystemTime -> ShowS # show :: SystemTime -> String # showList :: [SystemTime] -> ShowS # | |
NFData SystemTime | |
Defined in Data.Time.Clock.Internal.SystemTime rnf :: SystemTime -> () # |