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

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

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 (из Functor) и составлять вычисления вместе с <*>, используя результат одного вычисления в качестве входных данных для другого. Это не позволяет пользователю библиотеки выполнять вычисление, которое выполняет другое вычисление, а затем напрямую использовать результат этого вычисления; пользователь никак не может написать join :: f (f a) -> f a. Это ограничение не позволит нашей библиотеке столкнуться с проблемой, которую я описал в другом ответе.

Трансформеры, бесплатно, и трансформер ApT

Ваша примерная проблема довольно сложная, поэтому мы собираемся вытащить кучу высокоуровневых трюков Haskell и сделать несколько новых собственных. Первые два трюка, которые мы собираемся использовать, это трансформеры и бесплатные типы данных. Преобразователи — это типы, которые берут типы типа Functors, Applicatives или Monads и производят новые типы того же типа.

Трансформеры обычно выглядят так, как показано в следующем 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 интерфейс для комбинирования вычислений, который в нижней части позволяет выполнять Monadic вычисления. Мы хотим максимально «освободить» интерпретатор, чтобы он мог изменить порядок вычислений. Для этого мы будем комбинировать как бесплатный 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}

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

Интерлюдия

Чтобы запустить весь этот код, вам понадобится следующее. 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, перепробовав все и вся, чтобы попытаться запихнуть Monadic вычисления в 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

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

-- 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 с вершины стека.

Чтобы совместно использовать вычисления, нам нужно их где-то хранить, это memoizes 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

Чтобы интерпретировать 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)

Интерпретировать 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

Выполнение интерпретатора

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

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|"

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], но все побочные эффекты img1s уже выполнены. Мы никак не можем выполнить какой-либо из побочных эффектов img2 раньше некоторых побочных эффектов img1, потому что побочные эффекты img1 уже произошли.

могу

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

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

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

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

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