История изменений

Исправление quasimoto, 21.08.13 11:13 (текущая версия) :

А к кому?

К общепринятым соглашениям, в том числе стандартным. Ещё раз:

unless :: Monad m => Bool -> m () -> m ()

forever :: Monad m => m a -> m b

При этом, например

> unless False []
[]
> unless True []
[()]
> unless True [(),()]
[()]
> unless False [(),()]
[(),()]

> forever []
[]
> forever [1]
  C-c C-cInterrupted.

-- и т.д.

казалось бы — нафига? Но эти инстансы Monad [], Monad Maybe, Monad ((->) r) и т.п. есть, весь код из Control.Monad для них тоже есть, законен и жить не мешает.

Если так посмотреть — весь код из <algorithm> и т.п. в C++ это одна сплошная «протекающая абстракция», потому что работает для чего угодно что претворяется итераторами, функторами и т.п., даже если это что-то совсем бессмысленное (и без концептов ситуация ещё хуже).

Также, должны быть

forever :: Monad m => m () -> m Void

но Void нет в стандарте.

Ещё, о чём речь была:

filter :: (a -> Bool) -> [a] -> [a]
--        ^ предикат

filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
--                          ^ сюда смотри

два варианта, аналогично synB и synM:

synB :: ((a -> a) -> b) -> (a -> Bool) -> (a -> a) -> b
--                         ^ предикат

synM :: Monad m => ((a -> m ()) -> t) -> (a -> m Bool) -> (a -> m ()) -> t
--                                             ^ и тут

Ну тогда тебе надо сделать свой собственный тайпкласс MyMonad

MyMonad не гарантирует, что инстансы для всего что Monad не появятся чудесным образом (как orphans).

Есть MonadIO. Пример — MonadIO, unless и замыкание на константные и мутабельные значения:

progressBar :: (MonadIO m, MonadIO m') => m () -> m () -> Int -> Int -> m' (Int -> m ())
progressBar drawCell drawEnd normedN n = do
  iRef <- liftIO $ newIORef 0
  return $ \di -> do
    i <- liftIO $ readIORef iRef
    let norm x = x * normedN `div` n
        i' = i + di
    unless (i < 0) $
      if i' >= n
      then do
        liftIO $ writeIORef iRef (-1)
        replicateM_ (normedN - norm i) drawCell
        drawEnd
      else do
        liftIO $ modifyIORef iRef (+ di)
        replicateM_ (norm i' - norm i) drawCell

test :: Int -> Int -> Int -> IO ()
test normedN n d = do
  draw <- progressBar (putChar '+') (putChar '\n') normedN n
  replicateM_ (2 * n) $ threadDelay 100000 >> draw d

Но MonadIO не покрывает ST, так что тут не годится.

А писать на каждый чих новый класс и париться с поддержкой 100500 инстансов неохота. Опять же, кому мешают «бессмысленные» (в строгом смысле у них есть «смысл», то есть интерпретация — «работает известным для каждой монады образом») варианты synM?

Нету ни одной монады кроме IO, в котором оно было бы осмысленно.

Давай считать. IO. Счётное количество обёрток над IO:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

newtype MyIO a
  = MyIO { runMyIO :: IO a }
  deriving ( Functor, Monad, MonadIO )

-- > runMyIO $ liftIO $ print 1
-- 1

-- synToMyIO_HT :: (Eq k, Functor m, Hashable k, HashTable h, MonadIO m) =>
--                 ((v -> m ()) -> t) -> (v -> k) -> IOHashTable h k v -> t
synToMyIO_HT :: (Eq k, Hashable k, HashTable h) =>
                ((v -> MyIO ()) -> t) -> (v -> k) -> IOHashTable h k v -> t
synToMyIO_HT sender key ht = synM
  sender
  (\val -> isJust <$> liftIO (HT.lookup ht (key val)))
  (\val -> liftIO $ HT.insert ht (key val) val)

ST (http://hackage.haskell.org/package/hashtables):

import qualified Data.HashTable.ST.Basic as ST_HT

synToST_HT :: (Eq k, Hashable k) =>
              ((v -> ST s ()) -> t) -> (v -> k) -> ST_HT.HashTable s k v -> t
synToST_HT sender key ht = synM
  sender
  (\val -> isJust <$> ST_HT.lookup ht (key val))
  (\val -> ST_HT.insert ht (key val) val)

Счётное количество обёрток над ST:

newtype MyST s a
  = MyST { runMyST :: ST s a }
  deriving ( Functor, Monad )

synToMyST_HT :: (Eq k, Hashable k) =>
                ((v -> MyST s ()) -> t) -> (v -> k) -> ST_HT.HashTable s k v -> t
synToMyST_HT sender key ht = synM
  sender
  (\val -> isJust <$> MyST (ST_HT.lookup ht (key val)))
  (\val -> MyST $ ST_HT.insert ht (key val) val)

Трансформеры — http://hackage.haskell.org/package/mtl, например http://hackage.haskell.org/packages/archive/mtl/latest/doc/html/Control-Monad...

data MyEnv = ...

instance IsString MyEnv where
  ...

type MyIOWithState a = StateT MyEnv IO a

-- synToMyIOWithState_HT
--   :: (Eq k, Functor m, IsString s, Hashable k, HashTable h, MonadIO m, MonadState s m) =>
--      ((v -> m ()) -> t) -> (v -> k) -> IOHashTable h k v -> t
synToMyIOWithState_HT :: (Eq k, Hashable k, HashTable h) =>
                         ((v -> MyIOWithState ()) -> t) -> (v -> k) -> IOHashTable h k v -> t
synToMyIOWithState_HT sender key ht = synM
  sender
  (\val -> isJust <$> liftIO (HT.lookup ht (key val)))
  (\val -> do
      put "insert..."
      liftIO $ HT.insert ht (key val) val)

тут надо обратить внимание на строчку с put которая аналогична строчке method POST из примера про ServerPart (который тоже некий StateT над IO) — она должна иметь эффект на _состояние_ которое разделяют все функции которые связанны вызовами в данном слое «монадического стека», если IO хватит всем, то нужно задаться вопросом — как реализовать такую строчу в IO (никак — либо таскать хэндлер, либо хаки с unsafePerformIO, либо опора на внешнее состояние в FFI, FS, DB, ...).

Прочие трансформеры из mtl и т.п. — тоже.

Обёртки над ними — тоже.

Ну и много ещё примеров может быть — как любые конструкции (классические трансформеры, iteratees, pipes) над IO, так и косвенно свободные от IO вещи вроде free (их можно интерпретировать в IO, так что смысл есть).

Исправь.

Читай моё последнее сообщение на которое отвечал — там найдёшь synB.

То есть задачу ты не решил - ведь если из кода нельзя вывести, что он делает Х, то значит, что код не делает Х.

Ты таки косишь под Тагора :) «Без ума стула нет!1», пофиг, что работает.

Вообще, если из всего сказанного мы к исходному варианту на CL ещё не приехали, то я ничем помочь не могу.

З.Ы. ещё раз попробую: должна быть «очевидна» эквивалентность реализаций

synB :: ((a -> Maybe b) -> t) -> (a -> Bool) -> (a -> b) -> t
synB s p = synA s (\v v' -> if not $ p v then Just v' else Nothing)
synB s p r = s $ \v -> if not $ p v then Just $ r v else Nothing
-- 
-- > synB (`map` [1, 2, 3]) odd (+1)
-- [Nothing,Just 3,Nothing]
-- 
-- аналогично
-- 
-- > (synchronize (lambda (f) (mapcar f '(1 2 3))) #'oddp #'1+)
-- (nil 3 nil)

synM :: Monad m => ((a -> m ()) -> t) -> (a -> m Bool) -> (a -> m ()) -> t
synM s p = synA s $ unlessM . p
synM s p = synA s $ \v v' -> unlessM (p v) v'
synM s p = synA s $ \v v' -> p v >>= (`unless` v')
synM s p = synA s $ \v v' -> p v >>= \b -> unless b v'
synM s p r = s $ \v -> p v >>= \b -> unless b $ r v

и то что наиболее общие сигнатуры у них именно такие, то есть что Applicative работает именно для ((->) r), иначе это просто незнание того что такое (<*>) и Applicative (вообще или в случае ((->) r)).

Исходная версия quasimoto, 21.08.13 11:07: