{-# Language GeneralizedNewtypeDeriving, RankNTypes, RecordWildCards #-}
module Client.CApi
(
ActiveExtension(..)
, extensionSymbol
, openExtension
, startExtension
, stopExtension
, notifyExtension
, commandExtension
, chatExtension
, ThreadEntry(..)
, threadFinish
, popTimer
, pushTimer
, cancelTimer
, evalNestedIO
, withChat
, withRawIrcMsg
) where
import Client.CApi.Types
import Client.Configuration (ExtensionConfiguration, extensionPath, extensionRtldFlags, extensionArgs)
import Control.Lens (view)
import Control.Monad (guard, unless)
import Control.Monad.Codensity (Codensity(Codensity), lowerCodensity)
import Control.Monad.IO.Class (MonadIO(..))
import Data.IntPSQ (IntPSQ)
import Data.IntPSQ qualified as IntPSQ
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (UTCTime)
import Foreign.C (peekCString, withCString)
import Foreign.Marshal (withArray, withArrayLen, with)
import Foreign.Ptr (Ptr, FunPtr, castFunPtrToPtr, nullFunPtr, nullPtr)
import Foreign.Storable (Storable(peek))
import Irc.Identifier (idText)
import Irc.RawIrcMsg (RawIrcMsg(..), TagEntry(..))
import Irc.UserInfo (UserInfo(userHost, userNick, userName))
import System.Posix.DynamicLinker (dlopen, dlclose, dlsym, DL)
extensionSymbol :: String
extensionSymbol :: FilePath
extensionSymbol = FilePath
"extension"
data ActiveExtension = ActiveExtension
{ ActiveExtension -> FgnExtension
aeFgn :: !FgnExtension
, ActiveExtension -> DL
aeDL :: !DL
, ActiveExtension -> Ptr ()
aeSession :: !(Ptr ())
, ActiveExtension -> Text
aeName :: !Text
, ActiveExtension -> Int
aeMajorVersion, ActiveExtension -> Int
aeMinorVersion :: !Int
, ActiveExtension -> IntPSQ UTCTime TimerEntry
aeTimers :: !(IntPSQ UTCTime TimerEntry)
, ActiveExtension -> Int
aeNextTimer :: !Int
, ActiveExtension -> Int
aeThreads :: !Int
, ActiveExtension -> Bool
aeLive :: !Bool
}
data TimerEntry = TimerEntry !(FunPtr TimerCallback) !(Ptr ())
data ThreadEntry = ThreadEntry !(FunPtr ThreadFinish) !(Ptr ())
popTimer ::
ActiveExtension ->
Maybe (UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
popTimer :: ActiveExtension
-> Maybe
(UTCTime, TimerId, FunPtr TimerCallback, Ptr (), ActiveExtension)
popTimer ActiveExtension
ae =
do let timers :: IntPSQ UTCTime TimerEntry
timers = ActiveExtension -> IntPSQ UTCTime TimerEntry
aeTimers ActiveExtension
ae
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ActiveExtension -> Bool
aeLive ActiveExtension
ae)
(Int
timerId, UTCTime
time, TimerEntry FunPtr TimerCallback
fun Ptr ()
ptr, IntPSQ UTCTime TimerEntry
timers') <- forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
IntPSQ.minView IntPSQ UTCTime TimerEntry
timers
let ae' :: ActiveExtension
ae' = ActiveExtension
ae { aeTimers :: IntPSQ UTCTime TimerEntry
aeTimers = IntPSQ UTCTime TimerEntry
timers' }
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
time, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timerId, FunPtr TimerCallback
fun, Ptr ()
ptr, ActiveExtension
ae')
pushTimer ::
UTCTime ->
FunPtr TimerCallback ->
Ptr () ->
ActiveExtension ->
(Int,ActiveExtension)
pushTimer :: UTCTime
-> FunPtr TimerCallback
-> Ptr ()
-> ActiveExtension
-> (Int, ActiveExtension)
pushTimer UTCTime
time FunPtr TimerCallback
fun Ptr ()
ptr ActiveExtension
ae = TimerEntry
entry seq :: forall a b. a -> b -> b
`seq` ActiveExtension
ae' seq :: forall a b. a -> b -> b
`seq` (Int
i, ActiveExtension
ae')
where
entry :: TimerEntry
entry = FunPtr TimerCallback -> Ptr () -> TimerEntry
TimerEntry FunPtr TimerCallback
fun Ptr ()
ptr
i :: Int
i = ActiveExtension -> Int
aeNextTimer ActiveExtension
ae
ae' :: ActiveExtension
ae' = ActiveExtension
ae { aeTimers :: IntPSQ UTCTime TimerEntry
aeTimers = forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.insert Int
i UTCTime
time TimerEntry
entry (ActiveExtension -> IntPSQ UTCTime TimerEntry
aeTimers ActiveExtension
ae)
, aeNextTimer :: Int
aeNextTimer = Int
i forall a. Num a => a -> a -> a
+ Int
1 }
cancelTimer ::
Int ->
ActiveExtension ->
Maybe (Ptr (), ActiveExtension)
cancelTimer :: Int -> ActiveExtension -> Maybe (Ptr (), ActiveExtension)
cancelTimer Int
timerId ActiveExtension
ae =
do (UTCTime
_, TimerEntry FunPtr TimerCallback
_ Ptr ()
ptr) <- forall p v. Int -> IntPSQ p v -> Maybe (p, v)
IntPSQ.lookup Int
timerId (ActiveExtension -> IntPSQ UTCTime TimerEntry
aeTimers ActiveExtension
ae)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
ptr, ActiveExtension
ae { aeTimers :: IntPSQ UTCTime TimerEntry
aeTimers = forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v
IntPSQ.delete Int
timerId (ActiveExtension -> IntPSQ UTCTime TimerEntry
aeTimers ActiveExtension
ae)})
openExtension ::
ExtensionConfiguration ->
IO ActiveExtension
openExtension :: ExtensionConfiguration -> IO ActiveExtension
openExtension ExtensionConfiguration
config =
do DL
dl <- FilePath -> [RTLDFlags] -> IO DL
dlopen (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExtensionConfiguration FilePath
extensionPath ExtensionConfiguration
config)
(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExtensionConfiguration [RTLDFlags]
extensionRtldFlags ExtensionConfiguration
config)
FunPtr Any
p <- forall a. DL -> FilePath -> IO (FunPtr a)
dlsym DL
dl FilePath
extensionSymbol
FgnExtension
fgn <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr Any
p)
FilePath
name <- CString -> IO FilePath
peekCString (FgnExtension -> CString
fgnName FgnExtension
fgn)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ActiveExtension
{ aeFgn :: FgnExtension
aeFgn = FgnExtension
fgn
, aeDL :: DL
aeDL = DL
dl
, aeSession :: Ptr ()
aeSession = forall a. Ptr a
nullPtr
, aeName :: Text
aeName = FilePath -> Text
Text.pack FilePath
name
, aeTimers :: IntPSQ UTCTime TimerEntry
aeTimers = forall p v. IntPSQ p v
IntPSQ.empty
, aeMajorVersion :: Int
aeMajorVersion = forall a b. (Integral a, Num b) => a -> b
fromIntegral (FgnExtension -> CInt
fgnMajorVersion FgnExtension
fgn)
, aeMinorVersion :: Int
aeMinorVersion = forall a b. (Integral a, Num b) => a -> b
fromIntegral (FgnExtension -> CInt
fgnMinorVersion FgnExtension
fgn)
, aeNextTimer :: Int
aeNextTimer = Int
1
, aeThreads :: Int
aeThreads = Int
0
, aeLive :: Bool
aeLive = Bool
True
}
startExtension ::
Ptr () ->
ExtensionConfiguration ->
ActiveExtension ->
IO (Ptr ())
startExtension :: Ptr () -> ExtensionConfiguration -> ActiveExtension -> IO (Ptr ())
startExtension Ptr ()
stab ExtensionConfiguration
config ActiveExtension
ae =
do let f :: FunPtr StartExtension
f = FgnExtension -> FunPtr StartExtension
fgnStart (ActiveExtension -> FgnExtension
aeFgn ActiveExtension
ae)
if forall a. FunPtr a
nullFunPtr forall a. Eq a => a -> a -> Bool
== FunPtr StartExtension
f
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr
else forall a. NestedIO a -> IO a
evalNestedIO forall a b. (a -> b) -> a -> b
$
do CString
extPath <- forall a. (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 (forall a. FilePath -> (CString -> IO a) -> IO a
withCString (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExtensionConfiguration FilePath
extensionPath ExtensionConfiguration
config))
[FgnStringLen]
args <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> NestedIO FgnStringLen
withText
forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExtensionConfiguration [Text]
extensionArgs ExtensionConfiguration
config
Ptr FgnStringLen
argsArray <- forall a. (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 (forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [FgnStringLen]
args)
let len :: CSize
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [FgnStringLen]
args)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Dynamic StartExtension
runStartExtension FunPtr StartExtension
f Ptr ()
stab CString
extPath Ptr FgnStringLen
argsArray CSize
len)
stopExtension :: ActiveExtension -> IO ()
stopExtension :: ActiveExtension -> IO ()
stopExtension ActiveExtension
ae =
do let f :: FunPtr StopExtension
f = FgnExtension -> FunPtr StopExtension
fgnStop (ActiveExtension -> FgnExtension
aeFgn ActiveExtension
ae)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. FunPtr a
nullFunPtr forall a. Eq a => a -> a -> Bool
== FunPtr StopExtension
f) forall a b. (a -> b) -> a -> b
$
Dynamic StopExtension
runStopExtension FunPtr StopExtension
f (ActiveExtension -> Ptr ()
aeSession ActiveExtension
ae)
DL -> IO ()
dlclose (ActiveExtension -> DL
aeDL ActiveExtension
ae)
chatExtension ::
ActiveExtension ->
Ptr FgnChat ->
IO Bool
chatExtension :: ActiveExtension -> Ptr FgnChat -> IO Bool
chatExtension ActiveExtension
ae Ptr FgnChat
chat =
do let f :: FunPtr ProcessChat
f = FgnExtension -> FunPtr ProcessChat
fgnChat (ActiveExtension -> FgnExtension
aeFgn ActiveExtension
ae)
if FunPtr ProcessChat
f forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else (ProcessResult
passMessage forall a. Eq a => a -> a -> Bool
==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic ProcessChat
runProcessChat FunPtr ProcessChat
f (ActiveExtension -> Ptr ()
aeSession ActiveExtension
ae) Ptr FgnChat
chat
notifyExtension ::
ActiveExtension ->
Ptr FgnMsg ->
IO Bool
notifyExtension :: ActiveExtension -> Ptr FgnMsg -> IO Bool
notifyExtension ActiveExtension
ae Ptr FgnMsg
msg =
do let f :: FunPtr ProcessMessage
f = FgnExtension -> FunPtr ProcessMessage
fgnMessage (ActiveExtension -> FgnExtension
aeFgn ActiveExtension
ae)
if FunPtr ProcessMessage
f forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else (ProcessResult
passMessage forall a. Eq a => a -> a -> Bool
==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic ProcessMessage
runProcessMessage FunPtr ProcessMessage
f (ActiveExtension -> Ptr ()
aeSession ActiveExtension
ae) Ptr FgnMsg
msg
commandExtension ::
Text ->
ActiveExtension ->
IO ()
commandExtension :: Text -> ActiveExtension -> IO ()
commandExtension Text
command ActiveExtension
ae = forall a. NestedIO a -> IO a
evalNestedIO forall a b. (a -> b) -> a -> b
$
do Ptr FgnCmd
cmd <- Text -> NestedIO (Ptr FgnCmd)
withCommand Text
command
let f :: FunPtr ProcessCommand
f = FgnExtension -> FunPtr ProcessCommand
fgnCommand (ActiveExtension -> FgnExtension
aeFgn ActiveExtension
ae)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr ProcessCommand
f forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr)
forall a b. (a -> b) -> a -> b
$ Dynamic ProcessCommand
runProcessCommand FunPtr ProcessCommand
f (ActiveExtension -> Ptr ()
aeSession ActiveExtension
ae) Ptr FgnCmd
cmd
threadFinish :: ThreadEntry -> IO ()
threadFinish :: ThreadEntry -> IO ()
threadFinish (ThreadEntry FunPtr StopExtension
f Ptr ()
x) = Dynamic StopExtension
runThreadFinish FunPtr StopExtension
f Ptr ()
x
withRawIrcMsg ::
Text ->
RawIrcMsg ->
NestedIO (Ptr FgnMsg)
withRawIrcMsg :: Text -> RawIrcMsg -> NestedIO (Ptr FgnMsg)
withRawIrcMsg Text
network RawIrcMsg{[Text]
[TagEntry]
Maybe UserInfo
Text
_msgTags :: RawIrcMsg -> [TagEntry]
_msgPrefix :: RawIrcMsg -> Maybe UserInfo
_msgCommand :: RawIrcMsg -> Text
_msgParams :: RawIrcMsg -> [Text]
_msgParams :: [Text]
_msgCommand :: Text
_msgPrefix :: Maybe UserInfo
_msgTags :: [TagEntry]
..} =
do FgnStringLen
net <- Text -> NestedIO FgnStringLen
withText Text
network
FgnStringLen
pfxN <- Text -> NestedIO FgnStringLen
withText forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
Text.empty (Identifier -> Text
idTextforall b c a. (b -> c) -> (a -> b) -> a -> c
.UserInfo -> Identifier
userNick) Maybe UserInfo
_msgPrefix
FgnStringLen
pfxU <- Text -> NestedIO FgnStringLen
withText forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
Text.empty UserInfo -> Text
userName Maybe UserInfo
_msgPrefix
FgnStringLen
pfxH <- Text -> NestedIO FgnStringLen
withText forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
Text.empty UserInfo -> Text
userHost Maybe UserInfo
_msgPrefix
FgnStringLen
cmd <- Text -> NestedIO FgnStringLen
withText Text
_msgCommand
[FgnStringLen]
prms <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> NestedIO FgnStringLen
withText [Text]
_msgParams
[(FgnStringLen, FgnStringLen)]
tags <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TagEntry -> NestedIO (FgnStringLen, FgnStringLen)
withTag [TagEntry]
_msgTags
let ([FgnStringLen]
keys,[FgnStringLen]
vals) = forall a b. [(a, b)] -> ([a], [b])
unzip [(FgnStringLen, FgnStringLen)]
tags
(Int
tagN,Ptr FgnStringLen
keysPtr) <- forall a b. (forall r. (a -> b -> IO r) -> IO r) -> NestedIO (a, b)
nest2 forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [FgnStringLen]
keys
Ptr FgnStringLen
valsPtr <- forall a. (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [FgnStringLen]
vals
(Int
prmN,Ptr FgnStringLen
prmPtr) <- forall a b. (forall r. (a -> b -> IO r) -> IO r) -> NestedIO (a, b)
nest2 forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [FgnStringLen]
prms
forall a. (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with forall a b. (a -> b) -> a -> b
$ FgnStringLen
-> FgnStringLen
-> FgnStringLen
-> FgnStringLen
-> FgnStringLen
-> Ptr FgnStringLen
-> CSize
-> Ptr FgnStringLen
-> Ptr FgnStringLen
-> CSize
-> FgnMsg
FgnMsg FgnStringLen
net FgnStringLen
pfxN FgnStringLen
pfxU FgnStringLen
pfxH FgnStringLen
cmd Ptr FgnStringLen
prmPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
prmN)
Ptr FgnStringLen
keysPtr Ptr FgnStringLen
valsPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tagN)
withChat ::
Text ->
Text ->
Text ->
NestedIO (Ptr FgnChat)
withChat :: Text -> Text -> Text -> NestedIO (Ptr FgnChat)
withChat Text
net Text
tgt Text
msg =
do FgnStringLen
net' <- Text -> NestedIO FgnStringLen
withText Text
net
FgnStringLen
tgt' <- Text -> NestedIO FgnStringLen
withText Text
tgt
FgnStringLen
msg' <- Text -> NestedIO FgnStringLen
withText Text
msg
forall a. (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with forall a b. (a -> b) -> a -> b
$ FgnStringLen -> FgnStringLen -> FgnStringLen -> FgnChat
FgnChat FgnStringLen
net' FgnStringLen
tgt' FgnStringLen
msg'
withCommand ::
Text ->
NestedIO (Ptr FgnCmd)
withCommand :: Text -> NestedIO (Ptr FgnCmd)
withCommand Text
command =
do FgnStringLen
cmd <- Text -> NestedIO FgnStringLen
withText Text
command
forall a. (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with forall a b. (a -> b) -> a -> b
$ FgnStringLen -> FgnCmd
FgnCmd FgnStringLen
cmd
withTag :: TagEntry -> NestedIO (FgnStringLen, FgnStringLen)
withTag :: TagEntry -> NestedIO (FgnStringLen, FgnStringLen)
withTag (TagEntry Text
k Text
v) =
do FgnStringLen
pk <- Text -> NestedIO FgnStringLen
withText Text
k
FgnStringLen
pv <- Text -> NestedIO FgnStringLen
withText Text
v
forall (m :: * -> *) a. Monad m => a -> m a
return (FgnStringLen
pk,FgnStringLen
pv)
withText :: Text -> NestedIO FgnStringLen
withText :: Text -> NestedIO FgnStringLen
withText Text
txt =
do (CString
ptr,Int
len) <- forall a. (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 forall a b. (a -> b) -> a -> b
$ forall a. Text -> ((CString, Int) -> IO a) -> IO a
withText0 Text
txt
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CString -> CSize -> FgnStringLen
FgnStringLen CString
ptr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
newtype NestedIO a = NestedIO (Codensity IO a)
deriving (forall a b. a -> NestedIO b -> NestedIO a
forall a b. (a -> b) -> NestedIO a -> NestedIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> NestedIO b -> NestedIO a
$c<$ :: forall a b. a -> NestedIO b -> NestedIO a
fmap :: forall a b. (a -> b) -> NestedIO a -> NestedIO b
$cfmap :: forall a b. (a -> b) -> NestedIO a -> NestedIO b
Functor, Functor NestedIO
forall a. a -> NestedIO a
forall a b. NestedIO a -> NestedIO b -> NestedIO a
forall a b. NestedIO a -> NestedIO b -> NestedIO b
forall a b. NestedIO (a -> b) -> NestedIO a -> NestedIO b
forall a b c.
(a -> b -> c) -> NestedIO a -> NestedIO b -> NestedIO c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. NestedIO a -> NestedIO b -> NestedIO a
$c<* :: forall a b. NestedIO a -> NestedIO b -> NestedIO a
*> :: forall a b. NestedIO a -> NestedIO b -> NestedIO b
$c*> :: forall a b. NestedIO a -> NestedIO b -> NestedIO b
liftA2 :: forall a b c.
(a -> b -> c) -> NestedIO a -> NestedIO b -> NestedIO c
$cliftA2 :: forall a b c.
(a -> b -> c) -> NestedIO a -> NestedIO b -> NestedIO c
<*> :: forall a b. NestedIO (a -> b) -> NestedIO a -> NestedIO b
$c<*> :: forall a b. NestedIO (a -> b) -> NestedIO a -> NestedIO b
pure :: forall a. a -> NestedIO a
$cpure :: forall a. a -> NestedIO a
Applicative, Applicative NestedIO
forall a. a -> NestedIO a
forall a b. NestedIO a -> NestedIO b -> NestedIO b
forall a b. NestedIO a -> (a -> NestedIO b) -> NestedIO b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> NestedIO a
$creturn :: forall a. a -> NestedIO a
>> :: forall a b. NestedIO a -> NestedIO b -> NestedIO b
$c>> :: forall a b. NestedIO a -> NestedIO b -> NestedIO b
>>= :: forall a b. NestedIO a -> (a -> NestedIO b) -> NestedIO b
$c>>= :: forall a b. NestedIO a -> (a -> NestedIO b) -> NestedIO b
Monad, Monad NestedIO
forall a. IO a -> NestedIO a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> NestedIO a
$cliftIO :: forall a. IO a -> NestedIO a
MonadIO)
evalNestedIO :: NestedIO a -> IO a
evalNestedIO :: forall a. NestedIO a -> IO a
evalNestedIO (NestedIO Codensity IO a
m) = forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity Codensity IO a
m
nest1 :: (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 :: forall a. (forall r. (a -> IO r) -> IO r) -> NestedIO a
nest1 forall r. (a -> IO r) -> IO r
f = forall a. Codensity IO a -> NestedIO a
NestedIO (forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity forall r. (a -> IO r) -> IO r
f)
nest2 :: (forall r. (a -> b -> IO r) -> IO r) -> NestedIO (a,b)
nest2 :: forall a b. (forall r. (a -> b -> IO r) -> IO r) -> NestedIO (a, b)
nest2 forall r. (a -> b -> IO r) -> IO r
f = forall a. Codensity IO a -> NestedIO a
NestedIO (forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity (forall r. (a -> b -> IO r) -> IO r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. ((a, b) -> c) -> a -> b -> c
curry))