{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
module GHC.IO.Device (
RawIO(..),
IODevice(..),
IODeviceType(..),
SeekMode(..)
) where
import GHC.Base
import GHC.Word
import GHC.Arr
import GHC.Enum
import GHC.Read
import GHC.Show
import GHC.Ptr
import GHC.Num
import GHC.IO
import {-# SOURCE #-} GHC.IO.Exception ( unsupportedOperation )
class RawIO a where
read :: a -> Ptr Word8 -> Word64 -> Int -> IO Int
readNonBlocking :: a -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
write :: a -> Ptr Word8 -> Word64 -> Int -> IO ()
writeNonBlocking :: a -> Ptr Word8 -> Word64 -> Int -> IO Int
class IODevice a where
ready :: a -> Bool -> Int -> IO Bool
close :: a -> IO ()
isTerminal :: a -> IO Bool
isTerminal a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isSeekable :: a -> IO Bool
isSeekable a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
seek :: a -> SeekMode -> Integer -> IO Integer
seek a
_ SeekMode
_ Integer
_ = forall a. IO a
ioe_unsupportedOperation
tell :: a -> IO Integer
tell a
_ = forall a. IO a
ioe_unsupportedOperation
getSize :: a -> IO Integer
getSize a
_ = forall a. IO a
ioe_unsupportedOperation
setSize :: a -> Integer -> IO ()
setSize a
_ Integer
_ = forall a. IO a
ioe_unsupportedOperation
setEcho :: a -> Bool -> IO ()
setEcho a
_ Bool
_ = forall a. IO a
ioe_unsupportedOperation
getEcho :: a -> IO Bool
getEcho a
_ = forall a. IO a
ioe_unsupportedOperation
setRaw :: a -> Bool -> IO ()
setRaw a
_ Bool
_ = forall a. IO a
ioe_unsupportedOperation
devType :: a -> IO IODeviceType
dup :: a -> IO a
dup a
_ = forall a. IO a
ioe_unsupportedOperation
dup2 :: a -> a -> IO a
dup2 a
_ a
_ = forall a. IO a
ioe_unsupportedOperation
ioe_unsupportedOperation :: IO a
ioe_unsupportedOperation :: forall a. IO a
ioe_unsupportedOperation = forall e a. Exception e => e -> IO a
throwIO IOError
unsupportedOperation
data IODeviceType
= Directory
| Stream
| RegularFile
| RawDevice
deriving ( IODeviceType -> IODeviceType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IODeviceType -> IODeviceType -> Bool
$c/= :: IODeviceType -> IODeviceType -> Bool
== :: IODeviceType -> IODeviceType -> Bool
$c== :: IODeviceType -> IODeviceType -> Bool
Eq
)
data SeekMode
= AbsoluteSeek
| RelativeSeek
| SeekFromEnd
deriving ( SeekMode -> SeekMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeekMode -> SeekMode -> Bool
$c/= :: SeekMode -> SeekMode -> Bool
== :: SeekMode -> SeekMode -> Bool
$c== :: SeekMode -> SeekMode -> Bool
Eq
, Eq SeekMode
SeekMode -> SeekMode -> Bool
SeekMode -> SeekMode -> Ordering
SeekMode -> SeekMode -> SeekMode
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 :: SeekMode -> SeekMode -> SeekMode
$cmin :: SeekMode -> SeekMode -> SeekMode
max :: SeekMode -> SeekMode -> SeekMode
$cmax :: SeekMode -> SeekMode -> SeekMode
>= :: SeekMode -> SeekMode -> Bool
$c>= :: SeekMode -> SeekMode -> Bool
> :: SeekMode -> SeekMode -> Bool
$c> :: SeekMode -> SeekMode -> Bool
<= :: SeekMode -> SeekMode -> Bool
$c<= :: SeekMode -> SeekMode -> Bool
< :: SeekMode -> SeekMode -> Bool
$c< :: SeekMode -> SeekMode -> Bool
compare :: SeekMode -> SeekMode -> Ordering
$ccompare :: SeekMode -> SeekMode -> Ordering
Ord
, Ord SeekMode
(SeekMode, SeekMode) -> Int
(SeekMode, SeekMode) -> [SeekMode]
(SeekMode, SeekMode) -> SeekMode -> Bool
(SeekMode, SeekMode) -> SeekMode -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (SeekMode, SeekMode) -> Int
$cunsafeRangeSize :: (SeekMode, SeekMode) -> Int
rangeSize :: (SeekMode, SeekMode) -> Int
$crangeSize :: (SeekMode, SeekMode) -> Int
inRange :: (SeekMode, SeekMode) -> SeekMode -> Bool
$cinRange :: (SeekMode, SeekMode) -> SeekMode -> Bool
unsafeIndex :: (SeekMode, SeekMode) -> SeekMode -> Int
$cunsafeIndex :: (SeekMode, SeekMode) -> SeekMode -> Int
index :: (SeekMode, SeekMode) -> SeekMode -> Int
$cindex :: (SeekMode, SeekMode) -> SeekMode -> Int
range :: (SeekMode, SeekMode) -> [SeekMode]
$crange :: (SeekMode, SeekMode) -> [SeekMode]
Ix
, Int -> SeekMode
SeekMode -> Int
SeekMode -> [SeekMode]
SeekMode -> SeekMode
SeekMode -> SeekMode -> [SeekMode]
SeekMode -> SeekMode -> SeekMode -> [SeekMode]
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 :: SeekMode -> SeekMode -> SeekMode -> [SeekMode]
$cenumFromThenTo :: SeekMode -> SeekMode -> SeekMode -> [SeekMode]
enumFromTo :: SeekMode -> SeekMode -> [SeekMode]
$cenumFromTo :: SeekMode -> SeekMode -> [SeekMode]
enumFromThen :: SeekMode -> SeekMode -> [SeekMode]
$cenumFromThen :: SeekMode -> SeekMode -> [SeekMode]
enumFrom :: SeekMode -> [SeekMode]
$cenumFrom :: SeekMode -> [SeekMode]
fromEnum :: SeekMode -> Int
$cfromEnum :: SeekMode -> Int
toEnum :: Int -> SeekMode
$ctoEnum :: Int -> SeekMode
pred :: SeekMode -> SeekMode
$cpred :: SeekMode -> SeekMode
succ :: SeekMode -> SeekMode
$csucc :: SeekMode -> SeekMode
Enum
, ReadPrec [SeekMode]
ReadPrec SeekMode
Int -> ReadS SeekMode
ReadS [SeekMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SeekMode]
$creadListPrec :: ReadPrec [SeekMode]
readPrec :: ReadPrec SeekMode
$creadPrec :: ReadPrec SeekMode
readList :: ReadS [SeekMode]
$creadList :: ReadS [SeekMode]
readsPrec :: Int -> ReadS SeekMode
$creadsPrec :: Int -> ReadS SeekMode
Read
, Int -> SeekMode -> ShowS
[SeekMode] -> ShowS
SeekMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeekMode] -> ShowS
$cshowList :: [SeekMode] -> ShowS
show :: SeekMode -> String
$cshow :: SeekMode -> String
showsPrec :: Int -> SeekMode -> ShowS
$cshowsPrec :: Int -> SeekMode -> ShowS
Show
)