О скоупах

А вот ещё одна хитрая задачка. Положим у нас есть несколько устройств, которые мы можем как-то дёргать через DevHnd a (где a — тип-параметр характеризующий устройство). Проблема в том, что если два треда будут рулить устройством одновременно, то результат будет трудно предсказать. Хорошо, вводим концепцию владения устройством: управлять устройством¹ можно только завладев им, если кто-то другой завладел устройством до тебя, то ты ждёшь пока устройство освободится. Просто, но есть пара нюансов:

• мы говорим «блокировка» и подразумеваем «дедлок», поскольку в реальной жизни тред должен контролировать состояние более одного устройства одновременно;
• из типа DevHnd a никак не следует захвачен ли он текущим тредом, а значит проверка этого факта будет осуществляться в рантайме каждый раз когда мы будем модифицировать устройство и более того время от времени мы будем сталкиваться с ошибками времени исполнения.

В общем случае, когда устройства захватываются и высвобождаются в произвольный момент времени ни первую, ни вторую проблему мы вероятнее всего не решим. Но если рассмотреть ситуацию когда все устройства захватываются и освобождаются одновременно ситуация перестаёт быть такой удручающей и внезапно укладывается в традиционный для haskell’я паттерн:

    withSomething :: DevHnd a -> DevHnd b -> IO c -> IO c
    withSomething dev1 dev2 action = do
        alloc dev1 dev2
        v <- action
        dealloc dev1 dev2
        return v

Способов заблокировать несколько сущностей одновременно избежав дедлоков более одного, выберите по вкусу. Но action всё равно может содержать действия с устройствами, которые мы не захватили. Чтобы этого избежать можно сделать следующее:

• введём изоморфный DevHnd a тип StaticHnd s a с фантомным параметром s и приватную функцию toStatic делающую из первого второе;
• введём изоморфную IO a монаду Scope a, а также функции для управления устройствами внутри этой монады через StaticHnd s a;
• перепишем предыдущий код так:

    withSomething :: DevHnd a -> DevHnd b -> (forall s. StaticHnd s a -> forall s. StaticHnd s b -> Scope c) -> IO c
    withSomething dev1 dev2 action = do
        alloc dev1 dev2
        v <- action (toStatic dev1) (toStatic dev2)
        dealloc dev1 dev2
        return v

Всё. Теперь следим за руками:

• изменять в нашем скоупе устройства через DevHnd a мы не можем, поскольку соответствующий мутатор не определён для Scope a;
• создать StaticHnd s a мы можем только при помощи withSomething, поскольку toStatic не экспортирован наружу;
• вернуть StaticHnd s a из action мы тоже не можем, поскольку функция не может вернуть значение любого типа, а фантомный параметр s передаваемых в неё аргументов объявлен как forall.

Из всего этого следует что любая попытка использовать внутри нашего скоупа не захваченное устройство или устройство захваченное в другой скоуп (кроме родительского :^)) завершится ошибкой компиляции. Хорошо? Очень хорошо. Но на этом хорошее заканчивается и начинается Real World.

Приведённый код определён для двух устройств захватываемых в скоуп. Очевидным образом это довольно частный случай и этого мало. Также очевидно что функция withSomething содержит детали приватной реализации и должна быть чёрным ящиком. Есть несколько вариантов решения:

• Наиболее распространённым решением таких проблем в haskell’е это… унылая копипаста в результате которой получатся функции вида:

  withSomething :: DevHnd a -> (forall s. StaticHnd s a -> Scope c) -> IO c
  
  withSomething2 :: DevHnd a -> DevHnd b -> (forall s. StaticHnd s a -> forall s. StaticHnd s b -> Scope c) -> IO c
  
  withSomething3 :: DevHnd a -> DevHnd b -> DevHnd c ->
      (forall s. StaticHnd s a -> forall s. StaticHnd s b -> forall s. StaticHnd s c -> Scope d) -> IO d

  И так до тех пор пока не надоест.

• Также можно попробовать изобразить композицию.

  action =
      withSomething hnd1 $ \sHnd1 ->
          withSomething hnd2 $ \sHnd2 ->
              withSomething hnd3 $ \sHnd3 -> do
                  doSomething sHnd1
                  doSomething sHnd2
                  doSomething sHnd3

  Но так мы теряем возможность захватывать устройства одной транзакцией (у каждого withSomething своя транзакция). В принципе это можно пофиксить введя ещё одну стадию заправки ракеты:

  • вводим ещё одну монаду² (например Accure a) внутри которой можно делать только withSomething и run;
  • withSomething просто добавляет захват очередного устройства в готовящуюся транзакцию;
  • run запускает транзакцию и затем выполняет наш Scope.

    action = accure $
        withSomething hnd1 $ \sHnd1 ->
            withSomething hnd2 $ \sHnd2 ->
                withSomething hnd3 $ \sHnd3 -> run $ do
                    doSomething sHnd1
                    doSomething sHnd2
                    doSomething sHnd3

• Наконец есть магия в стиле Applicative позволяющая писать что-то в духе:

  (\v1 -> … ) <$> doSome1
  (\v1 v2 -> … ) <$> doSome1 <*> doSome2
  (\v1 v2 v3 -> … ) <$> doSome1 <*> doSome2 <*> doSome3

  Я даже видел как что-то подобное использовали в parsec’е, но от попыток натянуть это на свои типы у меня стабильно плавится мозг.