module Pandora.IO (IO, module Exports) where

import Pandora.IO.ASCII as Exports
import Pandora.IO.Bytes as Exports

import "pandora" Pandora.Core.Interpreted (run, (<~))
import "pandora" Pandora.Pattern.Morphism.Straight (Straight (Straight))
import "pandora" Pandora.Pattern.Semigroupoid ((.))
import "pandora" Pandora.Pattern.Category ((<--))
import "pandora" Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))
import "pandora" Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))
import "pandora" Pandora.Pattern.Functor.Monoidal (Monoidal (unit))
import "pandora" Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))
import "pandora" Pandora.Pattern.Functor.Monad (Monad)
import "pandora" Pandora.Paradigm.Algebraic.Exponential (type (-->))
import "pandora" Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)))
import "pandora" Pandora.Paradigm.Algebraic.One (One (One))
import "pandora" Pandora.Paradigm.Algebraic ()

import "ghc-prim" GHC.Prim (State#, RealWorld)
import "ghc-prim" GHC.Types (IO (IO))

instance Covariant (->) (->) IO where
	a -> b
f <-|- :: (a -> b) -> IO a -> IO b
<-|- IO a
x = IO a -> (a -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
bindIO IO a
x (b -> IO b
forall a. a -> IO a
returnIO (b -> IO b) -> (a -> b) -> a -> IO b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. a -> b
f)

instance Semimonoidal (-->) (:*:) (:*:) IO where
	mult :: (IO a :*: IO b) --> IO (a :*: b)
mult = ((IO a :*: IO b) -> IO (a :*: b))
-> (IO a :*: IO b) --> IO (a :*: b)
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight (((IO a :*: IO b) -> IO (a :*: b))
 -> (IO a :*: IO b) --> IO (a :*: b))
-> ((IO a :*: IO b) -> IO (a :*: b))
-> (IO a :*: IO b) --> IO (a :*: b)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(IO a
x :*: IO b
y) -> IO a -> (a -> IO (a :*: b)) -> IO (a :*: b)
forall a b. IO a -> (a -> IO b) -> IO b
bindIO IO a
x (\a
x' -> IO b -> (b -> IO (a :*: b)) -> IO (a :*: b)
forall a b. IO a -> (a -> IO b) -> IO b
bindIO IO b
y (\b
y' -> (a :*: b) -> IO (a :*: b)
forall a. a -> IO a
returnIO (a
x' a -> b -> a :*: b
forall s a. s -> a -> s :*: a
:*: b
y')))

instance Monoidal (-->) (-->) (:*:) (:*:) IO where
	unit :: Proxy (:*:) -> (Unit (:*:) --> a) --> IO a
unit Proxy (:*:)
_ = (Straight (->) One a -> IO a)
-> Straight (->) (Straight (->) One a) (IO a)
forall (v :: * -> * -> *) a e. v a e -> Straight v a e
Straight ((Straight (->) One a -> IO a)
 -> Straight (->) (Straight (->) One a) (IO a))
-> (Straight (->) One a -> IO a)
-> Straight (->) (Straight (->) One a) (IO a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> IO a
forall a. a -> IO a
returnIO (a -> IO a)
-> (Straight (->) One a -> a) -> Straight (->) One a -> IO a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (Straight (->) One a -> One -> a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
<~ One
One)

instance Bindable (->) IO where
	a -> IO b
f =<< :: (a -> IO b) -> IO a -> IO b
=<< IO a
x = IO a -> (a -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
bindIO IO a
x a -> IO b
f

instance Monad (->) IO where

returnIO :: a -> IO a
returnIO :: a -> IO a
returnIO a
x = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\ State# RealWorld
s -> (# State# RealWorld
s, a
x #))

bindIO :: IO a -> (a -> IO b) -> IO b
bindIO :: IO a -> (a -> IO b) -> IO b
bindIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) a -> IO b
k = (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
s of (# State# RealWorld
new_s, a
a #) -> IO b -> State# RealWorld -> (# State# RealWorld, b #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (a -> IO b
k a
a) State# RealWorld
new_s)

thenIO :: IO a -> IO b -> IO b
thenIO :: IO a -> IO b -> IO b
thenIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) IO b
k = (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
s of (# State# RealWorld
new_s, a
_ #) -> IO b -> State# RealWorld -> (# State# RealWorld, b #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO IO b
k State# RealWorld
new_s)

unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
unIO :: IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IO State# RealWorld -> (# State# RealWorld, a #)
a) = State# RealWorld -> (# State# RealWorld, a #)
a