Длинное, про Хаскель - часть 3

Я тут натолкнулся на интересный способ решить упомянутую в одном из предыдущих постов проблему. Способ этот заключается в использовании сборщика мусора GHC.

Напомню немного постановку задачи. Требуется реализовать stateless протокол, с тем, чтобы между сервером и клиентом шли только сериализуемые данные. Это означает, что часть ответов пользователя нужно передавать ему снова и снова, и получать от него назад, повторяя некоторые вычисления заново (а как иначе, если на каком-то этапе, например, требуется сохранить для дальнейшей работы функцию? Только вычислить её в следующий раз снова). Проблема заключалась в том, что мы не можем понять, какие из ответов пользователя более не требуются, а потому вынуждены передавать туда-сюда их все, создавая лишнюю нагрузку на сеть. Сейчас я покажу, как эта проблема, в принципе, может быть решена. Правда, для практической работы я бы это решение не рекомендовал, это, скорее, proof of concept.

> module Test where

Нам нужно будет работать с изменяемыми переменными:

> import Data.IORef

Следующий модуль ничего особо интересного из себя не представляет.

> import Data.Maybe

В одном месте мне нужна будет функция unsafePerformIO. Да, я ЗНАЮ, что делаю.

> import System.IO.Unsafe

Начинается интересное.

> import System.Mem

Модуль System.Mem экспортирует только одну переменную: performIO типа IO (). Это действие, будучи выполнено, заставляет сборщик мусора поработать. Полезно, если мы почему-либо считаем, что мусора к этому моменту должно было скопиться многовато. В данном случае мы заставим сборщик мусора прибрать лишние ответы пользователя (точнее, "ссылки" на них).

> import System.Mem.Weak

А вот это - самое главное. Модуль System.Mem.Weak позволяет работать с так называемыми "слабыми указателями". Вот что это такое:

Слабый указатель - это переменная типа Weak v. У него есть а) значение типа v, и б) ключ некоторого типа k. Обратите внимание, что тип ключа в типе указателя не содержится; тем самым, вытащить ключ из указателя невозможно. Фишка, однако, заключается в том, что даже если сам слабый указатель находится в наших руках, как значение его, так и ключ, могут быть независимо прибраны сборщиком мусора. Единственная, по сути дела, связь между ними - пока сборщик мусора не прибрал ключ, он не может прибрать и значение. Оно "подвязано" к ключу. Заметьте, это верно даже в случае, когда сам слабый указатель мы где-то потеряли: неважно, он тоже подвязан к ключу. Причём ограничений нет: к одному ключу может быть подвязано сколько угодно значений (и сколько угодно указателей).

Зачем тогда нужен сам слабый указатель? А вот зачем: если этот указатель в наших руках, мы всегда можем сказать, прибрал уже сборщик мусора его КЛЮЧ (Внимание! Если ключ отправился в мусор, то у нас нет способа узнать, отправилось ли туда же значение) или нет. Поскольку ответ на этот вопрос зависит от текущего состояния, всё это обёрнуто в монаду IO.

Я модифицирую основной тип данных, так, чтобы он обрабатывал не весь список строк сразу, как в первом постинге на эту тему, а строки по одной:

> data CGI a = Return a | Ask String (String -> CGI a)

То есть: либо, не задавая лишних вопросов, вернуть значение - либо задать вопрос и, в зависимости от ответа, продолжить работу.

Нам понадобятся сервер и клиент. В реальности они должны, разумеется, работать через сеть, мы же реализуем их, ради краткости примера, в одном бинарнике. Сначала сервер:

> type Server m a = CGI a -> [String] -> m (Either (String, [String]) a)

Сервер, обслуживая нашу CGI-монаду, принимает на вход запрос пользователя в виде списка строк; на выходе он либо выдаёт значение, либо задаёт пользователю вопрос; вопрос этот сопровождается некоторым состоянием, а именно, запомненными сервером предыдущими ответами пользователя, которые пользователь обязуется вернуть назад неизменными. Сервер, вообще говоря, может выполнять какие-то действия, а не только вычислять; поэтому, он обёрнут в произвольную монаду m (которая, в дальнейшем, будет просто IO).

Напишем простенький сервер:

> simpleServer :: Monad m => Server m a
> simpleServer cgi ss = server cgi ss
>     where
>       server (Return x) _ = return $ Right x
>       server (Ask s _) [] = return $ Left $ (s,ss)
>       server (Ask _ f) (s:st) = server (f s) st

То есть: если CGI-монада требует вернуть значение - вернуть значение. Если больше от пользователя ничего пока не поступало - задать очередной вопрос. В противном случае, скормить CGI-монаде очередной ответ от пользователя и повторить. Всё просто и тупо.

Клиент:

> type Client m = (String, [String]) -> m ([String])

Клиент получает от пользователя вопрос, вместе с неким состоянием (запомненными предыдущими ответами). Он производит какие-то действия (опять в монаде) и возвращает то же состояние, дописывая к нему ответ на заданный вопрос.

> simpleClient :: Client IO
> simpleClient (s, ss) =
>     do putStrLn s
>        putStrLn $ "debug: " ++ show ss
>        putStr ">>> "
>        s' <- getLine
>        return (ss ++ [s'])

В данном случае, наш клиент будет работать в монаде IO, выводить на печать вопрос, выводить (для отладки) переданное состояние и считывать (после приглашения ">>>") ответ пользователя.

Наконец, нам нужно как-то соединить сервер с клиентом. Это мы сделаем так:

> runCGI :: Monad m => Server m a -> Client m -> CGI a -> m a
> runCGI server ask cgi = run []
>     where
>       run ss =
>           do responce <- server cgi ss
>              case responce of
>                Right x -> return x
>                Left (s', ss') ->
>                    do ss'' <- ask (s', ss')
>                       run ss''

То есть: начать работу с пустого "состояния"; на очередном шаге передать "состояние" (то есть, список ответов пользователя) серверу; если сервер попросил задать пользователю вопрос - передать его клиенту, получить от него обновлённый список ответов, и так далее.

Наконец, наши эти CGI-монады надо как-то собирать. Кирпичик ask позволяет задать вопрос и вернуть ответ:

> ask :: String -> CGI String
> ask s = Ask s Return

И, наконец, наша монада - действительно монада.

> instance Monad CGI where
>     return = Return
>     Return x >>= g = g x
>     Ask s f >>= g = Ask s $ \s' -> f s' >>= g

Тестируем:

> test =
>     do a1 <- ask "1?"
>        a2 <- ask $ "You said: " ++ a1 ++ "; 2?"
>        a3 <- ask $ "You said: " ++ a2 ++ "; 3?"
>        a4 <- ask $ "You said: " ++ a3 ++ "; 4?"
>        a5 <- ask $ "You said: " ++ a4 ++ "; 5?"
>        ask $ "You said: " ++ a5 ++ "; first time you said: " ++ a1 ++ "."
>        return ()

Заметим, что этот test отличается от testM из первого постинга; на последнем этапе мы выводим не только предыдущий ответ, но и самый первый. Я вставил это для того, чтобы нагляднее показать, что мы будем сохранять (впоследствии) те ответы пользователя, которые нам нужны в дальнейшем, а не все.

Запускаем в GHCi:

*Test> runCGI simpleServer simpleClient test
1?
debug: []
>>> a
You said: a; 2?
debug: ["a"]
>>> b
You said: b; 3?
debug: ["a","b"]
>>> c
You said: c; 4?
debug: ["a","b","c"]
>>> d
You said: d; 5?
debug: ["a","b","c","d"]
>>> e
You said: e; first time you said: a.
debug: ["a","b","c","d","e"]
>>> 

Видим, что наш подход - как мы и ожидали - слишком прост. Сохраняются ВСЕ ответы пользователя, нагружая сеть.

Решение проблемы - более умный сервер.

Для начала, нам понадобятся "ссылки" на строки:

> data Str = Str {fromStr :: String}

Дело в том, что сами по себе ответы пользователя сборщик мусора удалять не будет, они нам ещё пригодятся. А вот эти "ссылки" - за ради бога. Мы же примем меры, чтобы он не удалил те из них, которые ещё понадобятся.

Следующая функция по CGI-монаде и списку ответов пользователя делает следующее: запихивает эти ответы в CGI-монаду, затем, если та просит вернуть ответ - возвращает ответ, а если просит задать вопрос - возвращает а) сам вопрос, б) функцию, показывающую, что делать с ответом, и в) список слабых указателей на строки. Ключом для каждой строки является та самая "ссылка" типа Str на неё. Кроме того, эта функция пишет в IORef [Int] номера тех ответов пользователя, которые были реально использованы (а, значит, могут понадобиться и впредь).

Фактически, функция, показывающая, что делать со следующим ответом, нужна ТОЛЬКО для того, чтобы сборщик мусора не прибрал лишнее.

> feedCGI :: CGI a -> [String] -> IORef [Int] -> Int -> IO (Either (String -> CGI a, String, [Weak String]) a) 
> feedCGI (Return x) _ _ _ = return $ Right x
> feedCGI (Ask s f) [] _ _ = return $ Left (f, s, [])
> feedCGI (Ask _ f) (s:ss) used n =
>     do let str = Str s
>        w <- mkWeak str s Nothing
>        responce <- feedCGI (f $ unsafePerformIO $ do {modifyIORef used (n:); return $ fromStr str}) ss used (n+1)
>        case responce of
>          Left (g, s, ws) -> return $ Left (g, s, w:ws)
>          Right x -> return $ Right x

Ключевая строка здесь - разумеется, (f $ unsafePerformIO $ do {modifyIORef used (n:); return $ fromStr str}). Фокус вот в чём: если функция f использует свой аргумент - выполнится действие, переданное unsafePerformIO, и в переменную used (которая типа IORef [Int]) будет дописан индекс текущего ответа (того, на который ссылается str). Если же f запихает свой аргумент куда-то в замыкание, так, что он по-прежнему будет нужен - слабый указатель w сообщит нам, что этот аргумент по-прежнему используется. И только если f отбросит свой аргумент, не использовав его вовсе - он будет убран сборщиком мусора, соответствующий индекс не попадёт в список used, и слабый указатель w сообщит, что его ключ пропал.

> mergeCGI :: [Int] -> [Maybe String] -> [String] -> [String]
> mergeCGI ns = flip zipWith3 [0..] $ \n ms s -> if n `elem` ns then s else fromMaybe "" ms

Здесь, собственно, всё собирается воедино: список номеров использованных ответов пользователя, список тех ответов, которые не прибрал сборщик мусора (вместо тех, которые он таки прибрал, в этом списке содержится Nothing), и список всех ответов пользователя. В результате получается список тех ответов пользователя, которые ещё могут пригодиться. Вместо тех, которые не могут, мы ставим пустую строку.

Наконец, напишем умный сервер:

> smartServer :: Server IO a
> smartServer cgi ss =
>     do used <- newIORef []
>        responce <- feedCGI cgi ss used 0
>        performGC
>        case responce of
>          Right x -> return $ Right x
>          Left (f, s, wss) ->
>              do ss' <- sequence $ map deRefWeak wss
>                 usedStrings <- readIORef used
>                 return $ Left (s, mergeCGI usedStrings ss' ss)

Здесь мы заводим новый мутабельный список - список использованных ответов пользователя; изначально он пуст. Передаём его функции feedCGI, чтобы она его запомнила. Просим сборщик мусора прибрать лишнее. Если возвращено значение - возвращаем его; если нужно задать вопрос - вытаскиваем а) список тех ответов, которые не были прибраны сборщиком мусора; б) список номеров тех ответов, которые были использованы (NB: порядок этих действий важен, так как между строкой "ss' <- ..." и строкой "usedStrings <- ..." может, в принципе, произойти какая-нибудь редукция (хрен его знает, что компилятору в голову взбредёт), и, если эти строки будут в обратном порядке, номер может попасть в список used, но - слишком поздно, мы уже прочитали этот список), соединяем всё это как сказано выше, и возвращаем.

Запускаем это в GHCi:

*Test> runCGI smartServer simpleClient test
1?
debug: []
>>> a
You said: a; 2?
debug: ["a"]
>>> b
You said: b; 3?
debug: ["a","b"]
>>> c
You said: c; 4?
debug: ["a","","c"]
>>> d
You said: d; 5?
debug: ["a","","","d"]
>>> e
You said: e; first time you said: a.
debug: ["a","","","","e"]
>>> 

Видим, что на этот раз всё хорошо: сохраняются лишь те ответы пользователя, которые могут пригодиться в дальнейшем.

На самом деле, я не стал бы делать так. Всё-таки запросов к серверу, по большому счёту, должно быть много, и дёргать каждый раз сборщик мусора - ИМХО, не лучшая идея. Сам я сделал очистку лишнего через Template Haskell (ох, сколько было возни! зато вся возня ушла во время компиляции)