diff options
author | joe <joe@jerkface.net> | 2016-08-20 02:19:25 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2016-08-20 02:19:25 -0400 |
commit | 0ab23a36da3949fb92a1a251a13854fcfb4be610 (patch) | |
tree | 2302f7da5303382eb7b834d9683aab59b7c30a02 /src/Network/BitTorrent/Client | |
parent | 7e3eb07aeca78004d7a6879ee846f8e349950292 (diff) |
Compatibility with monad-control-1.0.
Diffstat (limited to 'src/Network/BitTorrent/Client')
-rw-r--r-- | src/Network/BitTorrent/Client/Types.hs | 16 |
1 files changed, 15 insertions, 1 deletions
diff --git a/src/Network/BitTorrent/Client/Types.hs b/src/Network/BitTorrent/Client/Types.hs index 9bae7dc3..7f228276 100644 --- a/src/Network/BitTorrent/Client/Types.hs +++ b/src/Network/BitTorrent/Client/Types.hs | |||
@@ -1,3 +1,4 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
1 | {-# LANGUAGE FlexibleInstances #-} | 2 | {-# LANGUAGE FlexibleInstances #-} |
2 | {-# LANGUAGE TypeFamilies #-} | 3 | {-# LANGUAGE TypeFamilies #-} |
3 | {-# LANGUAGE MultiParamTypeClasses #-} | 4 | {-# LANGUAGE MultiParamTypeClasses #-} |
@@ -106,6 +107,18 @@ newtype BitTorrent a = BitTorrent | |||
106 | class MonadBitTorrent m where | 107 | class MonadBitTorrent m where |
107 | liftBT :: BitTorrent a -> m a | 108 | liftBT :: BitTorrent a -> m a |
108 | 109 | ||
110 | #if MIN_VERSION_monad_control(1,0,0) | ||
111 | newtype BTStM a = BTStM { unBTSt :: StM (ReaderT Client IO) a } | ||
112 | |||
113 | instance MonadBaseControl IO BitTorrent where | ||
114 | type StM BitTorrent a = BTStM a | ||
115 | liftBaseWith cc = BitTorrent $ liftBaseWith $ \ cc' -> | ||
116 | cc $ \ (BitTorrent m) -> BTStM <$> cc' m | ||
117 | {-# INLINE liftBaseWith #-} | ||
118 | |||
119 | restoreM = BitTorrent . restoreM . unBTSt | ||
120 | {-# INLINE restoreM #-} | ||
121 | #else | ||
109 | instance MonadBaseControl IO BitTorrent where | 122 | instance MonadBaseControl IO BitTorrent where |
110 | newtype StM BitTorrent a = StM { unSt :: StM (ReaderT Client IO) a } | 123 | newtype StM BitTorrent a = StM { unSt :: StM (ReaderT Client IO) a } |
111 | liftBaseWith cc = BitTorrent $ liftBaseWith $ \ cc' -> | 124 | liftBaseWith cc = BitTorrent $ liftBaseWith $ \ cc' -> |
@@ -114,6 +127,7 @@ instance MonadBaseControl IO BitTorrent where | |||
114 | 127 | ||
115 | restoreM = BitTorrent . restoreM . unSt | 128 | restoreM = BitTorrent . restoreM . unSt |
116 | {-# INLINE restoreM #-} | 129 | {-# INLINE restoreM #-} |
130 | #endif | ||
117 | 131 | ||
118 | -- | NOP. | 132 | -- | NOP. |
119 | instance MonadBitTorrent BitTorrent where | 133 | instance MonadBitTorrent BitTorrent where |
@@ -146,4 +160,4 @@ runBitTorrent client action = runReaderT (unBitTorrent action) client | |||
146 | 160 | ||
147 | getClient :: BitTorrent Client | 161 | getClient :: BitTorrent Client |
148 | getClient = BitTorrent ask | 162 | getClient = BitTorrent ask |
149 | {-# INLINE getClient #-} \ No newline at end of file | 163 | {-# INLINE getClient #-} |