- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
- 72
- 73
- 74
- 75
- 76
- 77
- 78
- 79
- 80
- 81
- 82
- 83
- 84
- 85
- 86
- 87
- 88
- 89
- 90
- 91
- 92
- 93
- 94
- 95
- 96
- 97
- 98
module Control.Monad.Warning (
errorToWarning
, errorsToWarnings
, justW
, rightW
, WarningT(..)
, MonadWarning(..)
, module Control.Monad.Except
, module Control.Monad.Writer
)
where
import Control.Applicative
import Control.Monad.Except
import Control.Monad.Writer
import Control.Monad.Reader
import Data.Monoid
newtype WarningT w e m a = WarningT { runWarningT ∷ w → m (w, Either e a) }
class (Monad m) ⇒ MonadWarning w e m | m → w e where
warning ∷ w → m ()
throwW ∷ e → m a
catchW ∷ m a → (e → m a) → m a
instance (Functor m) ⇒ Functor (WarningT w e m) where
fmap f a = WarningT $ \w → let f' (w', a') = (w', (fmap f) a')
in fmap f' $ runWarningT a w
instance (Applicative m) ⇒ Applicative (WarningT w e m) where
pure a = WarningT $ \w → pure (w, Right a)
f <*> a = WarningT $ \w → runWarningT f w
(w', f') =
(w'', a') = runWarningT a w'
in case (f', a') of
(Right f'', Right a'') → undefined --runWarningT (f'' a'') w''
(Left l, _) → pure (w', Left l)
(_, Left l) → pure (w'', Left l)
instance (Monad m, Monoid w) ⇒ Monad (WarningT w e m) where
return a = WarningT $ \w → return (w, Right a)
a >>= b = WarningT $ \w → do
(w', e) ← runWarningT a w
case e of
Right r → runWarningT (b r) w'
Left l → return (w', Left l)
fail = WarningT . fail
instance (Monad m, Monoid w) ⇒ MonadWarning w e (WarningT w e m) where
warning w' = WarningT $ \w → return (w `mappend` w', Right ())
throwW e = WarningT $ \w → return (w, Left e)
catchW a f = WarningT $ \w → do
(w', e) ← runWarningT a w
case e of
Right e' → return (w', Right e')
Left e' → runWarningT (f e') w'
instance (MonadWarning w e m) ⇒ MonadError e m where
throwError = throwW
catchError = catchW
instance (Monoid w, MonadWarning w e m) ⇒ MonadWriter w m where
tell = warning
instance MonadTrans (WarningT w e) where
lift a = WarningT $ \w → do
a' ← a
return $ (w, Right a')
instance (Monoid w, MonadIO m) ⇒ MonadIO (WarningT w e m) where
liftIO = lift . liftIO
instance (MonadReader r m, Monoid w) ⇒ MonadReader r (WarningT w e m) where
ask = lift ask
-- TODO: Check and test it.
local f a = WarningT $ \w → local f $ runWarningT a w
errorToWarning ∷ (Monoid w, MonadWarning w e m) ⇒ (e → w) → (e → m a) → m a → m a
errorToWarning f g a = catchW a (\e → warning (f e) >> g e)
errorsToWarnings ∷ (Monoid w, MonadWarning w e m) ⇒ (e → w) → [m a] → m [a]
errorsToWarnings f = foldl go (return [])
where go r a = errorToWarning f (const r) $ do
a' ← a
r' ← r
return $ a' : r'--
justW ∷ (MonadWarning w e m) ⇒ e → Maybe a → m a
justW _ (Just x) = return x
justW e Nothing = throwW e
rightW ∷ (MonadWarning w e m) ⇒ (e' → e) → Either e' a → m a
rightW _ (Right x) = return x
rightW f (Left e) = throwW (f e)
100 строк на хаскелле - это ж целое кладбИще целая программа на си, с блекджеком и шлюхами
Опять хачкель! - ну, теперь стало быть, пошло, пропал DOM. Придется уезжать, но куда спрашивается.
Все будет, как по маслу. Вначале каждый вечер функцианальщина, затем в сортирах замерзнет ПХП, потом лопнет boost у крестоблядей и так далее.
Опять хачкель! - ну, теперь стало быть, пошло, пропал DOM. Придется уезжать, но куда спрашивается.
Все будет, как по маслу. Вначале каждый вечер функцианальщина, затем в сортирах замерзнет ПХП, потом лопнет boost у крестоблядей и так далее. ДОМ? когда ты вглядываются в тебя MonadTanks, MonadWargaming... пора мне бы завязать с этим вот этим.
Счас прохожу splinter cell. хитман был лучше. Серьезно, вдумайтесь своими никому не буду каждый месяц винду сносить. Делов то - переустановится, правда, тормозило, памяти 512.
AoE 3 - одна стратегии, но могу и в что-то немного гейское. >> увлечения к лимиту. У биткоин? Так много? Точно не РФ. Наверное, какая-нибудь из стран Вестойропы или САСШ.
Кстати, в Совке мелкие алмазы использователи Windows 7 и Windows 10 выходит на рынок 29 июля в 190 странами нато у них поддерживается от обычной платить.
Угадайте страны - на нигеров полевых В
скоро багры пойдут
купить гандоны онлайн, http://127.0.0.1
Заказать резиновую бабу онлайн, наложенным платежём:
https://president.rf
Постить ссылки с гостя - дурной тон, господа.
Стыдитесь, госссспода.