Точное управление потоком в Haskell

Ответ 1

Библиотеки потока данных и функционального реактивного программирования в Haskell обычно записываются в терминах Applicative или Arrow. Это абстракции для вычислений, которые являются менее общими, чем Monad - классы Applicative и Arrow не выставляют способ, чтобы структура вычислений зависела от результатов других вычислений. В результате библиотеки, демонстрирующие только эти классы, могут рассуждать о структуре вычислений в библиотеке независимо от выполнения этих вычислений. Мы решим вашу проблему в терминах Applicative typeclass

class Functor f => Applicative f where
    -- | Lift a value.
    pure :: a -> f a    
    -- | Sequential application.
    (<*>) :: f (a -> b) -> f a -> f b

Applicative позволяет пользователю библиотеки выполнять новые вычисления с помощью pure, работать с существующими вычислениями с помощью fmap (from Functor) и составлять вычисления вместе с <*>, используя результат одного вычисления как вход для другого. Он не позволяет пользователю библиотеки делать вычисления, которые делают другое вычисление, а затем напрямую использовать результат этого вычисления; пользователь не может писать join :: f (f a) -> f a. Это ограничение позволит нашей библиотеке работать в проблеме описанной в моем другом ответе.

Трансформаторы, свободные и трансформатор ApT

Ваша примерная проблема довольно сложная, поэтому мы собираемся вытащить кучу высокоуровневых трюков Haskell и сделать несколько новых наших собственных. Первые два трюка, которые мы собираемся вытащить, transformers и free. Трансформаторы - это типы, которые принимают типы с типом типа Functor s, Applicative или Monad и производят новые типы с одинаковым видом.

Трансформаторы обычно выглядят следующим образом Double. Double может принимать любые Functor или Applicative или Monad и создавать его версию, которая всегда содержит два значения вместо одного

newtype Double f a = Double {runDouble :: f (a, a)}

Свободные типы данных - это трансформаторы, которые выполняют две функции. Во-первых, с учетом некоторого более простого свойства базового типа получить новые захватывающие свойства для преобразованного типа. Free Monad предоставляет Monad для любого Functor, а свободный Applicative, Ap делает Applicative из любого Functor. Другая вещь, которую делают "свободные", - это "бесплатно" реализовать интерпретатор как можно больше. Ниже приведены типы бесплатных Applicative, Ap, свободных Monad, Free и свободного трансформатора монады, FreeT. Свободный монадный трансформатор обеспечивает монадный трансформатор для "свободного" при условии Functor

-- Free Applicative
data Ap f a where
    Pure :: a -> Ap f a
    Ap   :: f a -> Ap f (a -> b) -> Ap f b

-- Base functor of the free monad transformer
data FreeF f a b
    = Pure a    
    | Free (f b)    

-- Free monad transformer
newtype FreeT f m a = FreeT {runFreeT :: m (FreeF f a (FreeT f m a)}

-- The free monad is the free monad transformer applied to the Identity monad
type Free f = FreeT f Identity

Здесь приведен пример нашей цели - мы хотим предоставить интерфейс Applicative для объединения вычислений, который в нижней части позволяет выполнять вычисления Monad ic. Мы хотим как можно больше "освободить" интерпретатора, чтобы он мог надеяться переупорядочить вычисления. Для этого мы будем комбинировать как бесплатный Applicative, так и свободный монадный трансформатор.

Нам нужен интерфейс Applicative, и самый простой способ - это тот, который мы можем получить для "бесплатного", который максимально подходит для цели "освобождения переводчика". Это говорит о том, что наш тип будет выглядеть как

Ap f a

для некоторого Functor f и любого a. Мы хотим, чтобы базовое вычисление было над некоторыми Monad, а Monad - функторы, но мы хотели бы "освободить" интерпретатор насколько это возможно. Мы возьмем свободный трансформатор монады как базовый функтор для Ap, предоставив нам

Ap (FreeT f m) a

для некоторого Functor f, некоторого Monad m и любого a. Мы знаем, что Monad m, вероятно, будет IO, но мы оставим наш код как можно более общим. Нам просто нужно предоставить Functor для FreeT. Все Applicatives являются Functors, поэтому Ap может использоваться для f, мы будем писать что-то вроде

type ApT m a = Ap (FreeT (ApT m) m) a

Это дает компилятор, поэтому вместо этого мы переместим Ap внутрь и определим

newtype ApT m a = ApT {unApT :: FreeT (Ap (ApT m)) m a}

Мы получим некоторые примеры для этого и обсудим его реальную мотивацию после интерлюдии.

Interlude

Чтобы запустить весь этот код, вам понадобится следующее. Map и Control.Concurrent нужны только для совместного использования вычислений, подробнее об этом гораздо позже.

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Main where

import Control.Monad.Trans.Class
import Control.Monad.IO.Class

import Control.Monad.Trans.Reader
import Control.Applicative

import Control.Applicative.Free hiding (Pure)
import qualified Control.Applicative.Free as Ap (Ap(Pure))
import Control.Monad.Trans.Free

import qualified Data.Map as Map
import Control.Concurrent

Наполнение его

Я вводил вас в заблуждение в предыдущем разделе и делал вид, что обнаружил ApT от резонанса относительно проблемы. Я фактически обнаружил ApT, попробовав что угодно и все, чтобы попытаться записать вычисления Monad ic в Applicative и иметь возможность контролировать их порядок, когда он вышел. В течение долгого времени я пытался решить, как реализовать mapApM (ниже), чтобы написать flipImage (моя замена для вашего blur). Здесь трансформатор ApT Monad во всей красе. Он предназначен для использования в качестве Functor для Ap, и, используя Ap как свой собственный Functor для FreeT, может магически вносить значения в Applicative, которые не должны казаться возможными.

newtype ApT m a = ApT {unApT :: FreeT (Ap (ApT m)) m a}
     deriving (Functor, Applicative, Monad, MonadIO)

Он мог получить еще больше экземпляров из FreeT, это только те, которые нам нужны. Он не может получить MonadTrans, но мы можем сделать это сами:

instance MonadTrans ApT where
    lift = ApT . lift

runApT :: ApT m a -> m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a))
runApT = runFreeT . unApT

Реальная красота ApT заключается в том, что мы можем написать какой-то, казалось бы, невозможный код, например

stuffM :: (Functor m, Monad m) => m (ApT m a) -> ApT m a
stuffMAp :: (Functor m, Monad m) => m (ApT m a) -> Ap (ApT m) a

m снаружи исчезает, даже в Ap, что просто Applicative.

Это работает из-за следующего цикла функций, каждый из которых может вывести вывод из функции над ним во входной функции ниже. Первая функция начинается с ApT m a, а последняя заканчивается на одну. (Эти определения не являются частью программы)

liftAp' :: ApT m a ->
           Ap (ApT m) a
liftAp' = liftAp

fmapReturn :: (Monad m) =>
               Ap (ApT m) a ->
               Ap (ApT m) (FreeT (Ap (ApT m)) m a)
fmapReturn = fmap return

free' :: Ap (ApT m) (FreeT (Ap (ApT m)) m a) ->
         FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)
free' = Free

pure' :: a ->
         FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)
pure' = Pure

return' :: (Monad m) =>
           FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a) ->
           m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a))
return' = return

freeT :: m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)) ->
         FreeT (Ap (ApT m)) m a
freeT = FreeT

apT :: FreeT (Ap (ApT m)) m a ->
       ApT m a
apT = ApT

Это позволяет нам писать

-- Get rid of an Ap by stuffing it into an ApT.
stuffAp :: (Monad m) => Ap (ApT m) a -> ApT m a
stuffAp = ApT . FreeT . return . Free . fmap return

-- Stuff ApT into Free
stuffApTFree :: (Monad m) => ApT m a -> FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)
stuffApTFree = Free . fmap return . liftAp

-- Get rid of an m by stuffing it into an ApT
stuffM :: (Functor m, Monad m) => m (ApT m a) -> ApT m a
stuffM = ApT . FreeT . fmap stuffApTFree

-- Get rid of an m by stuffing it into an Ap
stuffMAp :: (Functor m, Monad m) => m (ApT m a) -> Ap (ApT m) a
stuffMAp = liftAp . stuffM

И некоторые служебные функции для работы с стеком трансформатора

mapFreeT :: (Functor f, Functor m, Monad m) => (m a -> m b) -> FreeT f m a -> FreeT f m b
mapFreeT f fa = do
    a <- fa
    FreeT . fmap Pure . f . return $ a

mapApT :: (Functor m, Monad m) => (m a -> m b) -> ApT m a -> ApT m b
mapApT f = ApT . mapFreeT f . unApT

mapApM :: (Functor m, Monad m) => (m a -> m b) -> Ap (ApT m) a -> Ap (ApT m) b
mapApM f = liftAp . mapApT f . stuffAp

Мы хотели бы начать писать наши примерные процессоры изображений, но сначала нам нужно сделать еще один отвод для решения жесткого требования.

Жесткое требование - обмен данными

В первом примере показан

--               timeShift(*2) --
--              /                 \
-- readImage --                    addImages -> out
--              \                 /
--                blur ----------

подразумевая, что результат readImage должен делиться между blur и timeShift(*2). Я полагаю, это означает, что результаты readImage должны вычисляться только один раз за каждый раз.

Applicative недостаточно силен, чтобы зафиксировать это. Мы создадим новый класс для представления вычислений, выход которых можно разделить на несколько идентичных потоков.

-- The class of things where input can be shared and divided among multiple parts
class Applicative f => Divisible f where
    (<\>) :: (f a -> f b) -> f a -> f b

Мы сделаем трансформатор, который добавит эту возможность к существующим Applicative s

-- A transformer that adds input sharing
data LetT f a where
    NoLet :: f a -> LetT f a
    Let   :: LetT f b -> (LetT f b -> LetT f a) -> LetT f a

И предоставим для него некоторые служебные функции и экземпляры

-- A transformer that adds input sharing
data LetT f a where
    NoLet :: f a -> LetT f a
    Let   :: LetT f b -> (LetT f b -> LetT f a) -> LetT f a

liftLetT :: f a -> LetT f a
liftLetT = NoLet

mapLetT :: (f a -> f b) -> LetT f a -> LetT f b
mapLetT f = go
    where
        go (NoLet a) = NoLet (f a)
        go (Let b g) = Let b (go . g)

instance (Applicative f) => Functor (LetT f) where
    fmap f = mapLetT (fmap f)

-- I haven't checked that these obey the Applicative laws.
instance (Applicative f) => Applicative (LetT f) where
    pure = NoLet . pure
    NoLet f <*> a = mapLetT (f <*>) a
    Let c h <*> a = Let c ((<*> a) . h)   

instance (Applicative f) => Divisible (LetT f) where
    (<\>) = flip Let

Процессоры изображений

Со всеми нашими трансформаторами на месте мы можем начать писать наши процессоры изображений. В нижней части нашего стека у нас есть ApT из более раннего раздела

Ap (ApT IO)

Вычисления должны иметь возможность считывать время из среды, поэтому мы добавим ReaderT для этого

ReaderT Int (Ap (ApT IO))

Наконец, мы хотели бы иметь возможность делиться вычислениями, поэтому мы добавим трансформатор LetT сверху, давая весь тип IP для наших процессоров изображений

type Image = String
type IP = LetT (ReaderT Int (Ap (ApT IO)))

Мы будем читать изображения с IO. getLine делает забавные интерактивные примеры.

readImage :: Int -> IP Image
readImage n = liftLetT $ ReaderT (\t -> liftAp . liftIO $ do
    putStrLn $  "[" ++ show n ++ "] reading image for time: " ++ show t
    --getLine
    return $ "|image [" ++ show n ++ "] for time: " ++ show t ++ "|"
    )

Мы можем сдвинуть время ввода

timeShift :: (Int -> Int) -> IP a -> IP a
timeShift f = mapLetT shift
    where
        shift (ReaderT g) = ReaderT (g . f)  

Добавьте несколько изображений вместе

addImages :: Applicative f => [f Image] -> f Image
addImages = foldl (liftA2 (++)) (pure [])

И переверните изображения, притворяясь, что используете библиотеку, которая застряла в IO. Я не мог понять, как blur строка...

inIO :: (IO a -> IO b) -> IP a -> IP b
inIO = mapLetT . mapReaderT . mapApM        

flipImage :: IP [a] -> IP [a]
flipImage = inIO flip'
    where
        flip' ma = do
            a <- ma
            putStrLn "flipping"
            return . reverse $ a

Интерпретация LetT

Наши LetT для обмена результатами находятся в верхней части нашего стека трансформаторов. Нам нужно будет интерпретировать его, чтобы получить вычисления под ним. Для интерпретации LetT нам понадобится способ обмена результатами в IO, который предоставляет memoize, и интерпретатор, который удаляет трансформатор LetT из верхней части стека.

Чтобы совместно использовать вычисления, нам нужно их где-то их хранить, это memoize a IO вычисление в IO, убедившись, что это происходит только один раз даже через несколько потоков.

memoize :: (Ord k) => (k -> IO a) -> IO (k -> IO a)
memoize definition = do
    cache <- newMVar Map.empty
    let populateCache k map = do
        case Map.lookup k map of
            Just a -> return (map, a)
            Nothing -> do
                a <- definition k
                return (Map.insert k a map, a)        
    let fromCache k = do
        map <- readMVar cache
        case Map.lookup k map of
            Just a -> return a
            Nothing -> modifyMVar cache (populateCache k)
    return fromCache

Чтобы интерпретировать a Let, нам нужен оценщик для базового ApT IO для включения в определения привязок Let. Поскольку результат вычислений зависит от среды, считанной с ReaderT, мы будем включать дело с ReaderT на этот шаг. Более сложный подход будет использовать классы трансформаторов, но трансформаторные классы для Applicative являются темой для другого вопроса.

compileIP :: (forall x. ApT IO x -> IO x) ->  IP a -> IO (Int -> ApT IO a)
compileIP eval (NoLet (ReaderT f)) = return (stuffAp . f)
compileIP eval (Let b lf) = do
            cb <- compileIP eval b
            mb <- memoize (eval . cb)
            compileIP eval . lf . NoLet $ ReaderT (liftAp . lift . mb)

Интерпретация ApT

Наш интерпретатор использует следующий State, чтобы не заглядывать внутрь AsT, FreeT и FreeF все время.

data State m a where
    InPure :: a -> State m a
    InAp :: State m b -> State m (b -> State m a) -> State m a
    InM :: m a -> State m a

instance Functor m => Functor (State m) where
    fmap f (InPure a) = InPure (f a)
    fmap f (InAp b sa) = InAp b (fmap (fmap (fmap f)) sa)
    fmap f (InM  m)  = InM  (fmap f m)

Interpereting Ap сложнее, чем кажется. Цель состоит в том, чтобы взять данные в Ap.Pure и поместить их в InPure и данные, которые в Ap, и поместить их в InAp. interpretAp на самом деле нужно называть себя большим типом каждый раз, когда он переходит в более глубокий Ap; функция продолжает собирать еще один аргумент. Первый аргумент t обеспечивает способ упростить эти типы разломов.

interpretAp :: (Functor m) => (a -> State m b) -> Ap m a -> State m b
interpretAp t (Ap.Pure a) = t a
interpretAp t (Ap mb ap) = InAp sb sf
    where
        sb = InM mb
        sf = interpretAp (InPure . (t .)) $ ap

interperetApT получает данные из ApT, FreeT и FreeF и в State m

interpretApT :: (Functor m, Monad m) => ApT m a -> m (State (ApT m) a)
interpretApT = (fmap inAp) . runApT
    where
        inAp (Pure a) = InPure a
        inAp (Free ap) = interpretAp (InM . ApT) $ ap

С помощью этих простых интерпретационных произведений мы можем разработать стратегии для интерпретации результатов. Каждая стратегия - это функция от интерпретатора State до нового State, с возможным возможным побочным эффектом на пути. Порядок, выбранный стратегией для выполнения побочных эффектов, определяет порядок побочных эффектов. Мы создадим две примерные стратегии.

Первая стратегия выполняет только один шаг на все, что готово к вычислению, и объединяет результаты, когда они готовы. Это, вероятно, стратегия, которую вы хотите.

stepFB :: (Functor m, Monad m) => State (ApT m) a -> m (State (ApT m) a)
stepFB (InM ma)   = interpretApT ma
stepFB (InPure a) = return (InPure a)
stepFB (InAp b f) = do
    sf <- stepFB f
    sb <- stepFB b
    case (sf, sb) of
        (InPure f, InPure b) -> return (f b)
        otherwise            -> return (InAp sb sf)

Эта другая стратегия выполняет все вычисления, как только они узнают о них. Он выполняет их все за один проход.

allFB :: (Functor m, Monad m) => State (ApT m) a -> m (State (ApT m) a)
allFB (InM ma) = interpretApT ma
allFB (InPure a) = return (InPure a)
allFB (InAp b f) = do
    sf <- allFB f
    sb <- allFB b
    case (sf, sb) of
        (InPure f, InPure b) -> return (f b)
        otherwise            -> allFB (InAp sb sf)

Возможны многие, многие другие стратегии.

Мы можем оценить стратегию, запустив ее, пока не получим единственный результат.

untilPure :: (Monad m) => ((State f a) -> m (State f a)) -> State f a -> m a
untilPure s = go
    where
        go state =
            case state of
                (InPure a) -> return a
                otherwise  -> s state >>= go

Выполнение intrereter

Для выполнения интерпретатора нам нужны некоторые данные примера. Вот несколько интересных примеров.

example1  = (\i -> addImages [timeShift (*2) i, flipImage i]) <\> readImage 1
example1' = (\i -> addImages [timeShift (*2) i, flipImage i, flipImage . timeShift (*2) $ i]) <\> readImage 1
example1'' = (\i -> readImage 2) <\> readImage 1
example2 = addImages [timeShift (*2) . flipImage $ readImage 1, flipImage $ readImage 2]

Интерпретатор LetT должен знать, какой оценщик использовать для связанных значений, поэтому мы будем определять наш оценщик только один раз. Один interpretApT запускает оценку путем поиска начального State интерпретатора.

evaluator :: ApT IO x -> IO x
evaluator = (>>= untilPure stepFB) . interpretApT

Мы скомпилируем example2, что по сути является вашим примером, и запустите его за время 5.

main = do
    f <- compileIP evaluator example2
    a <- evaluator . f $ 5
    print a

который производит почти желаемый результат, когда все прочтения происходят перед любыми флипсами.

[2] reading image for time: 5
[1] reading image for time: 10
flipping
flipping
"|01 :emit rof ]1[ egami||5 :emit rof ]2[ egami|"

Ответ 2

A Monad не может изменить порядок шагов компонента, составляющих img1 и img2 в

addImage :: (Monad m) => m [i] -> m [i] -> m [i]
addImage img1 img2 = do
    i1 <- img1
    i2 <- img2
    return $ i1 ++ i2

если существует любой m [i], результат которого зависит от побочного эффекта. Любой MonadIO m имеет m [i], результат которого зависит от побочного эффекта, поэтому вы не можете изменить порядок шагов компонента img1 и img2.

Вышеупомянутые десугары на

addImage :: (Monad m) => m [i] -> m [i] -> m [i]
addImage img1 img2 =
    img1 >>=
        (\i1 ->
            img2 >>=
                (\i2 ->
                    return (i1 ++ i2)
                )
        )

Сфокусируйтесь на первом >>= (помня, что (>>=) :: forall a b. m a -> (a -> m b) -> m b). Специализируется на нашем типе, это (>>=) :: m [i] -> ([i] -> m [i]) -> m [i]. Если мы собираемся его реализовать, нам нужно написать что-то вроде

(img1 :: m [i]) >>= (f :: [i] -> m [i]) = ... 

Чтобы сделать что-либо с f, нам нужно передать его [i]. Единственный правильный [i], который мы имеем, застрял внутри img1 :: m [i]. Нам нужен результат img1, чтобы что-либо сделать с помощью f. Теперь есть две возможности. Мы либо можем, либо не можем определить результат img1 без выполнения его побочных эффектов. Мы рассмотрим оба случая, начиная с того, когда мы не сможем.

не может

Если мы не можем определить результат img1 без выполнения его побочных эффектов, у нас есть только один выбор - мы должны выполнить img1 и все его побочные эффекты. Теперь мы имеем [i], но все побочные эффекты img1 уже выполнены. Невозможно выполнить какие-либо побочные эффекты от img2 до некоторых побочных эффектов img1, поскольку побочные эффекты img1 уже произошли.

может

Если мы можем определить результат img1 без выполнения его побочных эффектов, нам повезло. Мы найдем результат img1 и перейдем к f, получив новый m [i], содержащий желаемый результат. Теперь мы можем рассмотреть побочные эффекты как img1, так и новых m [i] и переупорядочить их (хотя здесь существует огромный оговорка об ассоциативном законе для >>=).

проблема под рукой

Так как это применимо к нашему случаю, для любого MonadIO существует следующее, результат которого не может быть определен без выполнения его побочных эффектов, надежно помещая нас в случай не может, где мы не может переупорядочить побочные эффекты.

counterExample :: (MonadIO m) => m String
counterExample = liftIO getLine

Существует также множество других примеров встречных примеров, таких как readImage1 или readImage2, которые должны действительно читать изображение из IO.