module Control.Wire.Classes
(
MonadClock(..),
MonadRandom(..),
ArrowKleisli(..),
arrIO
)
where
import Control.Applicative
import Control.Arrow
import Control.Arrow.Transformer
import Control.Arrow.Transformer.Automaton
import Control.Arrow.Transformer.Error
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Static
import Control.Arrow.Transformer.Writer
import Control.Monad.Trans (MonadIO(..))
import Data.Monoid
import Data.Time.Clock.POSIX
import System.Random
class Arrow (>~) => ArrowKleisli m (>~) | (>~) -> m where
arrM :: Monad m => m b >~ b
instance Monad m => ArrowKleisli m (Kleisli m) where
arrM = Kleisli id
instance ArrowKleisli m (>~) => ArrowKleisli m (Automaton (>~)) where
arrM = lift arrM
instance (ArrowChoice (>~), ArrowKleisli m (>~)) => ArrowKleisli m (ErrorArrow ex (>~)) where
arrM = lift arrM
instance ArrowKleisli m (>~) => ArrowKleisli m (ReaderArrow e (>~)) where
arrM = lift arrM
instance ArrowKleisli m (>~) => ArrowKleisli m (StateArrow s (>~)) where
arrM = lift arrM
instance (Applicative f, ArrowKleisli m (>~)) => ArrowKleisli m (StaticArrow f (>~)) where
arrM = lift arrM
instance (ArrowKleisli m (>~), Monoid l) => ArrowKleisli m (WriterArrow l (>~)) where
arrM = lift arrM
class Monad m => MonadClock t m | m -> t where
getTime :: m t
instance MonadClock Double IO where
getTime = fmap realToFrac getPOSIXTime
class Monad m => MonadRandom m where
getRandom :: Random a => m a
getRandomR :: Random a => (a, a) -> m a
instance MonadRandom IO where
getRandom = randomIO
getRandomR = randomRIO
arrIO :: (ArrowKleisli m (>~), MonadIO m) => IO b >~ b
arrIO = arrM <<^ liftIO