Difference between revisions of "Fully-functional heterogeneous lists (ru)"
(9 intermediate revisions by the same user not shown) | |||
Line 1: | Line 1: | ||
− | ''Fully-functional heterogeneous lists'' |
||
== Цели и задачи == |
== Цели и задачи == |
||
* Фильтрация элементов (объектов) гетерогенных списков по классам типов. |
* Фильтрация элементов (объектов) гетерогенных списков по классам типов. |
||
− | * Создание |
+ | * Создание «настоящих» гетерогенных списков, обладающих полной функциональностью. |
+ | |||
+ | [https://github.com/ilyazuev/inferInstance Библиотека и примеры использования] |
||
== Описание проблемы == |
== Описание проблемы == |
||
− | Мы реализуем проект на |
+ | Мы реализуем проект на Хаскелле. И в рамках проекта появилась необходимость в использовании ООП парадигмы. |
− | Обсуждение, хорошо это или плохо, выходит за рамки данной статьи. |
+ | Обсуждение, хорошо это или плохо, выходит за рамки данной статьи. |
− | для решения конкретно наших задач, подошёл именно ООП подход. |
+ | Самое главное, что для нашего проекта, для решения конкретно наших задач, подошёл именно ООП подход. |
− | Однако, камнем преткновения для нас стала невозможность хранения объектов в |
+ | Однако, камнем преткновения для нас стала невозможность хранения объектов в универсальных, так называемых гетерогенных списках. |
+ | Хранить-то в принципе можно, но полноценно использовать — нет, даже при использовании экзистенциальных типов. |
||
− | универсальных, так называемых гетерогенных списках. Хранить-то в принципе можно, |
||
+ | Проблема, достаточно широко известная в Хаскелле. |
||
− | но полноценно использовать - нет (даже при использовании экзистенциальных типов). |
||
+ | На одной из страниц Stack Overflow я нашёл такой комментарий: |
||
− | Проблема, достаточно широко известная в хаскель. |
||
+ | «You can use existensials, but then you can't do anything with the data after pattern matching on it», — что достаточно категорично характеризует ситуацию. |
||
− | |||
+ | Я достаточно долго бился над проблемой и, к сожалению, не нашёл решения данной задачи в интернете. |
||
− | На одной из страниц "stackoverflow" я нашёл такой комментарий: |
||
+ | Я изучил большое количество статей и провёл много экспериментов. См. внизу список использованных мною в процессе подготовки материалов. |
||
− | "You can use existensials, but then you can't do anything with the data after pattern matching on it", |
||
+ | Время и усилия были не напрасны в плане погружения в Хаскелл, но больше всего радует то, что поставленная задача решена. |
||
− | что достаточно категорично характеризует ситуацию. |
||
− | |||
− | Я достаточно долго бился над проблемой и, к сожалению, |
||
− | не нашёл решения данной задачи в интернете. |
||
− | Я изучил большое количество статей и провёл много экспериментов. |
||
− | См. внизу список использованных мною в процессе подготовки материалов. |
||
− | Время и усилия были не напрасны в плане погружения в хаскель, |
||
− | но больше всего радует то, что поставленная задача решена. |
||
Пусть пока грубо, пусть только для нашего конкретного случая. |
Пусть пока грубо, пусть только для нашего конкретного случая. |
||
== Решение задачи == |
== Решение задачи == |
||
− | + | Хаскелл по своей сути является функциональным языком программирования. |
|
Однако, пусть он будет мультипарадигменным хотя бы в нашем проекте. |
Однако, пусть он будет мультипарадигменным хотя бы в нашем проекте. |
||
Итак, примем за основу следующую схему. |
Итак, примем за основу следующую схему. |
||
− | В моём восприятии, это традиционный путь в |
+ | В моём восприятии, это традиционный путь в Хаскелле для имитации ООП. |
− | Для определения и хранения полей объектов будем использовать data и/или newtype. |
+ | Для определения и хранения полей объектов будем использовать `data` и/или `newtype`. |
− | Для придания объекту функциональности будем использовать |
+ | Для придания объекту функциональности будем использовать классы типов (`class`), как, в некотором роде, аналоги интерфейсам в традиционных ОО языках. |
+ | Типы, классы и экземпляры (`instance`) вместе пусть соответствуют классам в ООП. |
||
− | как, в некотором роде, аналоги интерфейсам в традиционных ООП-языках. |
||
− | Типы, классы и инстансы (instance) вместе пусть соответствуют классам в ООП. |
||
Вся суть идеи будет заключена лишь в паре функций и массивов. |
Вся суть идеи будет заключена лишь в паре функций и массивов. |
||
− | Тем не менее, для того, чтобы показать, что всё работает (и как работает) напишем небольшой проект. |
+ | Тем не менее, для того, чтобы показать, что всё работает (и как работает), напишем небольшой проект. |
− | Для пущей убедительности в том, что всё работает, сделаем объекты проекта |
+ | Для пущей убедительности в том, что всё работает, сделаем объекты проекта «множественно наследуемыми». |
− | Постараюсь сделать проект максимально простым. Основная цель проекта донести суть концепции. |
+ | Постараюсь сделать проект максимально простым. Основная цель проекта — донести суть концепции. |
Итак, приступим. |
Итак, приступим. |
||
Для начала приведу описание структуры дерева объектов: |
Для начала приведу описание структуры дерева объектов: |
||
− | * RenderableBase |
+ | * `RenderableBase` — абстрактный тип, отвечающий за расположение и рисование; |
− | * SerializableBase |
+ | * `SerializableBase` — абстрактный тип, отвечающий за сериализацию. |
+ | |||
+ | Объекты следующих типов будут включены в гетерогенный список: |
||
+ | * `Circle`, наследуется от `RenderableBase` и `SerializableBase`; |
||
− | Объекты следующих типов будут включены в гетерогенный список. |
||
− | * |
+ | * `Rectangle`, наследуется от `RenderableBase`; |
− | * |
+ | * `Triangle`, наследуется от `RenderableBase`. |
− | * Triangle (наследуется от RenderableBase). |
||
Представим схему наследования в виде небольшого списка: |
Представим схему наследования в виде небольшого списка: |
||
− | * SerializableBase > Circle |
+ | * `SerializableBase > Circle` |
− | * RenderableBase > Circle |
+ | * `RenderableBase > Circle` |
− | * RenderableBase > Rectangle |
+ | * `RenderableBase > Rectangle` |
− | * RenderableBase > Triangle |
+ | * `RenderableBase > Triangle` |
− | Иерархия наследования не играет никакой роли для |
+ | Иерархия наследования не играет никакой роли в реализации концепции и приведена лишь для того, чтобы придать проекту ощущение объектно-ориентированного подхода. |
− | реализации концепции и приведена лишь для того, чтобы |
||
− | придать проекту ощущение объектно-ориентированного подхода. |
||
Теперь дам описание классов типов: |
Теперь дам описание классов типов: |
||
+ | |||
− | * ClsShape - данный класс предназначен для объединения объектов в гетерогенный список. |
||
+ | * `ClsShape` предназначен для объединения объектов в гетерогенный список; |
||
− | * ClsRenderable - описывает функцию рендеринга |
||
− | * |
+ | * `ClsRenderable` описывает функцию рендеринга; |
− | * |
+ | * `ClsClickable` описывает функцию-реакцию на клик мышки; |
+ | * `ClsSerializable` описывает функцию сериализации объекта. |
||
Теперь нечто более важное: |
Теперь нечто более важное: |
||
− | * объекты типов Circle, Rectangle и Triangle |
||
− | могут быть отрисованы, т.е. имплементируют функцию render |
||
− | * на объекты типа Rectangle и Triangle можно кликнуть мышкой |
||
− | (Внимание! На объекты типа Circle кликнуть мышкой нельзя, т.е. тип |
||
− | Circle не реализует/не инстанциирует функционал класса ClsClickable) |
||
− | * объект типа Circle можно сериализовать (класс ClsSerializable) |
||
+ | * объекты типов `Circle`, `Rectangle` и `Triangle` могут быть отрисованы, то есть реализуют функцию `render`; |
||
− | Представим схему функциональности в виде небольшого списка, |
||
+ | * на объекты типов `Rectangle` и `Triangle` можно кликнуть мышкой (Внимание! На объекты типа `Circle` кликнуть мышкой нельзя, то есть тип `Circle` не реализует класс `ClsClickable`); |
||
− | которая показывает какой класс каким типом инстанциируется: |
||
+ | * объект типа `Circle` можно сериализовать (класс `ClsSerializable`). |
||
+ | Представим схему функциональности в виде небольшого списка, который показывает, какой класс каким типом реализуется: |
||
− | * ClsRenderable > Circle |
||
+ | |||
− | * ClsRenderable > Rectangle |
||
− | * ClsRenderable > |
+ | * `ClsRenderable > Circle` |
− | * |
+ | * `ClsRenderable > Rectangle` |
− | * |
+ | * `ClsRenderable > Triangle` |
+ | * `ClsClickable > Rectangle` |
||
− | * ClsSerializable > Circle |
||
+ | * `ClsClickable > Triangle` |
||
+ | * `ClsSerializable > Circle` |
||
Теперь начнём писать код. |
Теперь начнём писать код. |
||
− | Для начала включим все необходимые нам расширения GHC |
+ | Для начала включим все необходимые нам расширения GHC и импортируем библиотеки: |
− | и импортируем библиотеки. |
||
<haskell> |
<haskell> |
||
Line 108: | Line 97: | ||
</haskell> |
</haskell> |
||
− | Да нам понадобится функция небезопасного |
+ | Да, нам понадобится функция небезопасного приведения типов unsafeCoerce, но об этом чуть позже. |
+ | Весь код сосредоточен в одном файле, однако, давайте представим, что всё разбито на модули. Этим мне хотелось бы показать, что проект масштабируем. |
||
− | приведения типов unsafeCoerce, но об этом чуть позже. |
||
+ | Сначала опишем все классы, базовые абстрактные типы и типы данных, для которых мы будем создавать объекты. |
||
− | |||
+ | А также инстанцируем каждый тип. |
||
− | Весь код сосредоточен в одном файле, однако, давайте представим, |
||
+ | Пока всё тривиально. Мы используем «традиционный» подход для имитации ООП в Хаскелле: |
||
− | что всё разбито на модули. Этим мне хотелось бы показать, что |
||
− | проект масштабируем. |
||
− | |||
− | Сначала опишем все классы, базовые абстрактные типы и типы |
||
− | данных, для которых мы будем создавать объекты. |
||
− | А также инстанциируем каждый тип. |
||
− | Пока всё тривиально. Мы используем "традиционный" подход |
||
− | для имитации ООП в хаскель. |
||
<haskell> |
<haskell> |
||
Line 140: | Line 122: | ||
-- module Circle where -- |
-- module Circle where -- |
||
data Circle = Circle { |
data Circle = Circle { |
||
− | + | name :: String, |
|
− | + | renderableBase :: RenderableBase, |
|
− | + | serializableBase :: SerializableBase |
|
− | + | } deriving Show |
|
instance ClsShape Circle |
instance ClsShape Circle |
||
instance ClsRenderable Circle where |
instance ClsRenderable Circle where |
||
− | + | render Circle{..} = "Circle " ++ name ++ " " ++ render renderableBase |
|
instance ClsSerializable Circle where |
instance ClsSerializable Circle where |
||
− | + | serialize Circle{..} = "Circle " ++ name ++ " " ++ serialize serializableBase |
|
-- module Rectangle where -- |
-- module Rectangle where -- |
||
data Rectangle = Rectangle { |
data Rectangle = Rectangle { |
||
− | + | name :: String, |
|
− | + | renderableBase :: RenderableBase |
|
− | + | } deriving Show |
|
instance ClsShape Rectangle |
instance ClsShape Rectangle |
||
instance ClsRenderable Rectangle where |
instance ClsRenderable Rectangle where |
||
− | + | render Rectangle{..} = "Rectangle " ++ name ++ " " ++ render renderableBase |
|
instance ClsClickable Rectangle where |
instance ClsClickable Rectangle where |
||
− | + | click Rectangle{..} = "Rectangle " ++ name ++ " " ++ coords renderableBase ++ " clicked" |
|
-- module Triangle where -- |
-- module Triangle where -- |
||
data Triangle = Triangle { |
data Triangle = Triangle { |
||
− | + | name :: String, |
|
− | + | renderableBase :: RenderableBase |
|
− | + | } deriving Show |
|
instance ClsShape Triangle |
instance ClsShape Triangle |
||
instance ClsRenderable Triangle where |
instance ClsRenderable Triangle where |
||
− | + | render Triangle{..} = "Triangle " ++ name ++ " " ++ render renderableBase |
|
instance ClsClickable Triangle where |
instance ClsClickable Triangle where |
||
− | + | click Triangle{..} = "Triangle " ++ name ++ " " ++ coords renderableBase ++ " clicked" |
|
</haskell> |
</haskell> |
||
− | Теперь немного интереснее. Создадим тип-обёртку для реализации гетерогенного списка |
+ | Теперь немного интереснее. Создадим тип-обёртку для реализации гетерогенного списка: |
<haskell> |
<haskell> |
||
-- module InferInstanceOf where -- |
-- module InferInstanceOf where -- |
||
data Wrap (constraint :: * -> Constraint) where |
data Wrap (constraint :: * -> Constraint) where |
||
− | + | Wrp :: (Show a, Typeable a, constraint a) => a -> Wrap constraint |
|
instance Show (Wrap a) where show (Wrp a) = show a |
instance Show (Wrap a) where show (Wrp a) = show a |
||
</haskell> |
</haskell> |
||
− | + | Инстанцирование класса `Show` не играет никакой роли и служит лишь отладочным целям. |
|
− | А вот фраза |
+ | А вот фраза `(constraint :: * -> Constraint)` гораздо интереснее. |
− | подтипа для типа Wrap мы будем использовать некий класс. |
+ | Тут мы как бы говорим, что в качестве подтипа для типа `Wrap` мы будем использовать некий класс. |
− | + | То есть классы в данном случае будут играть роль типов. |
|
− | Теперь создадим сам гетерогенный список |
+ | Теперь создадим сам гетерогенный список: |
<haskell> |
<haskell> |
||
Line 202: | Line 184: | ||
</haskell> |
</haskell> |
||
− | Первое |
+ | Первое: список можно пополнять динамически в процессе выполнения программы. |
− | Второе |
+ | Второе: мы тут же теряем всю информацию о функциональности каждого объекта, то есть все словари для классов `ClsRenderable`, `ClsClickable` и `ClsSerializable`. |
+ | Остаются лишь ничего не значащиe для нас `ClsShape`, `Typeable` (о нём чуть позже) и `Show` для отладочных целей. |
||
− | все словари для классов: ClsRenderable, ClsClickable и ClsSerializable. |
||
− | Остаются лишь ничего не значащиe для нас ClsShape, Typeable (о нём чуть позже) и |
||
− | Show для отладочных целей. |
||
− | Максимум, что мы можем сейчас сделать это просто напечатать список объектов |
+ | Максимум, что мы можем сейчас сделать, это просто напечатать список объектов: |
<haskell> |
<haskell> |
||
Line 218: | Line 198: | ||
''all objects: ["Circle {name = \"crcl_1\", renderableBase = RenderableBase {coords = \"(1, 1)\"} ...'' |
''all objects: ["Circle {name = \"crcl_1\", renderableBase = RenderableBase {coords = \"(1, 1)\"} ...'' |
||
− | Теперь переходим к самой интересной части, в которой будет показана вся суть |
+ | Теперь переходим к самой интересной части, в которой будет показана вся суть идеи работы с гетерогенными списками. |
+ | Определяем списки распределённых по классам типов: |
||
− | идеи работы с гетерогенными списками. |
||
− | Определяем списки распределённых по классам типов. |
||
<haskell> |
<haskell> |
||
renderableTypes:: [Wrap ClsRenderable] |
renderableTypes:: [Wrap ClsRenderable] |
||
renderableTypes = [ |
renderableTypes = [ |
||
− | + | Wrp (undefined::Circle), |
|
− | + | Wrp (undefined::Rectangle), |
|
− | + | Wrp (undefined::Triangle) |
|
+ | ] |
||
− | ] |
||
clickableTypes:: [Wrap ClsClickable] |
clickableTypes:: [Wrap ClsClickable] |
||
clickableTypes = [ |
clickableTypes = [ |
||
− | + | Wrp (undefined::Rectangle), |
|
− | + | Wrp (undefined::Triangle) |
|
+ | ] |
||
− | ] |
||
serializableTypes:: [Wrap ClsSerializable] |
serializableTypes:: [Wrap ClsSerializable] |
||
serializableTypes = [ |
serializableTypes = [ |
||
− | + | Wrp (undefined::Circle) |
|
+ | ] |
||
− | ] |
||
</haskell> |
</haskell> |
||
− | Пока вручную. Позже эту работу возьмёт на себя |
+ | Пока вручную. Позже эту работу возьмёт на себя TemplateHaskell. |
− | Мало того, позже попытаемся упаковать эти списки в гетерогенный список типа HList, |
+ | Мало того, позже попытаемся упаковать эти списки в гетерогенный список типа `HList`, чтобы не использовать неуместные здесь функции. |
+ | Итак, каждый элемент этих списков опредлён как `undefined`, то есть данные нас не интересуют. |
||
− | чтобы не использовать неуместные здесь функции. |
||
+ | Нам нужно сохранить информацию о типе и, что более важно, нам важно не потерять информацию о функциональности, то есть нам нужно как-то сохранить словари. |
||
− | Итак, каждый элемент этих списков опредлён, как undefined, т.е. данные нас не интересуют. |
||
− | Нам нужно сохранить информацию о типе и, что более важно, нам |
||
− | важно не потерять информацию о функциональности, т.е. нам нужно как-то сохранить словари. |
||
− | Идём дальше. Первый этап нашей концепции научиться фильтровать |
+ | Идём дальше. Первый этап нашей концепции научиться фильтровать наш гетерогенный список по классу. |
− | + | Для этого напишем следующие функции: |
|
<haskell> |
<haskell> |
||
Line 258: | Line 235: | ||
instanceWrapOf:: |
instanceWrapOf:: |
||
− | + | [Wrap (constraint :: * -> Constraint)] -> |
|
− | + | Wrap (constraint2 :: * -> Constraint) -> Bool |
|
instanceWrapOf list (Wrp a) = instanceOf list a |
instanceWrapOf list (Wrp a) = instanceOf list a |
||
selectType::Typeable a => |
selectType::Typeable a => |
||
− | + | [Wrap (constraint :: * -> Constraint)] -> |
|
− | + | a -> |
|
− | + | [Wrap (constraint :: * -> Constraint)] |
|
selectType list a = filter inList list |
selectType list a = filter inList list |
||
where inList (Wrp b) = typeOf a == typeOf b |
where inList (Wrp b) = typeOf a == typeOf b |
||
</haskell> |
</haskell> |
||
− | Тут мы принимаем некий объект (или обёртку с объектом), список типов, |
+ | Тут мы принимаем некий объект (или обёртку с объектом), список типов, относящихся к определённому классу, и фильтруем этот список по типу. |
− | + | Вот для этого нам и понадобились `Typeable` и `typeOf` из пакета Data.Typeable. |
|
+ | Тут всё просто, если есть тип нашего объекта в списке, тогда объект относится к соответствующему классу. |
||
− | Typeable и typeOf из пакета Data.Typeable. |
||
+ | (Не забывайте, Хаскелл после компиляции полностью забывает про классы.) |
||
− | Тут всё просто: если есть тип нашего объекта в списке, тогда объект относится |
||
− | к соответствующему классу. (Не забывайте, хаскель после компиляции полностью забывает про классы.) |
||
Итак, теперь мы можем немного больше, например, отфильтровать наш список по классу и напечатать выборку: |
Итак, теперь мы можем немного больше, например, отфильтровать наш список по классу и напечатать выборку: |
||
Line 287: | Line 263: | ||
</haskell> |
</haskell> |
||
− | + | То есть если нам понадобятся только объекты класса `ClsClickable` или класса `ClsSerializable`, то есть объекты, обладающие строго определённой функциональностью, мы их получим. |
|
+ | И сможем их только... напечатать. Ничего больше. Но это уже нечто большее, нежели мы ожидали от гетерогенных списков ранее. |
||
− | объекты, обладающие строго определённой функциональностью, мы их получим. |
||
− | И сможем их только... напечатать. Ничего больше. Но это уже нечто большее, |
||
− | нежели мы ожидали от гетерогенных списков ранее. |
||
Идем дальше. |
Идем дальше. |
||
+ | |||
Нам, тем не менее, всё-таки необходимо как-то с нашими объектами работать. |
Нам, тем не менее, всё-таки необходимо как-то с нашими объектами работать. |
||
− | И для этого напишем следующую функцию. И вот она будет корнем всей концепции, |
+ | И для этого напишем следующую функцию. И вот она будет корнем всей концепции, тем, ради чего мы всё и затеяли: |
− | тем, ради чего, мы всё и затеяли. |
||
<haskell> |
<haskell> |
||
Line 308: | Line 282: | ||
unwrap (Wrp b) = substitute a b |
unwrap (Wrp b) = substitute a b |
||
substitute::forall t1 t2. (Typeable t2, Show t2, ClsClickable t2) => |
substitute::forall t1 t2. (Typeable t2, Show t2, ClsClickable t2) => |
||
− | + | t1 -> |
|
− | + | t2 -> |
|
− | + | Wrap ClsClickable |
|
substitute x y = Wrp (unsafeCoerce x::t2) |
substitute x y = Wrp (unsafeCoerce x::t2) |
||
</haskell> |
</haskell> |
||
Line 316: | Line 290: | ||
Эта функция подлежит генерализации и мы это сделаем ниже. Но сейчас давайте попытаемся понять, что же тут происходит. |
Эта функция подлежит генерализации и мы это сделаем ниже. Но сейчас давайте попытаемся понять, что же тут происходит. |
||
Мы принимаем объект. Далее, с помощью фильтрации, анализируем, относится ли этот объект к классу. |
Мы принимаем объект. Далее, с помощью фильтрации, анализируем, относится ли этот объект к классу. |
||
− | Если относится, распаковываем тип (undefined::тип) из соответствующей обёртки. |
+ | Если относится, распаковываем тип (`undefined::некий тип`) из соответствующей обёртки. |
− | подтверждаем с помощью функции unsafeCoerce, что наш объект относится к типу, |
+ | Проводим подстановку типов, то есть как бы подтверждаем с помощью функции unsafeCoerce, что наш объект относится к типу, инстанцирующему запрошенный нами класс. |
− | + | И... перепаковываем наш объект в новую обёртку. |
|
+ | В обёртку с необходимой нам функциональностью. |
||
− | функциональностью. Другими словами, мы "на лету" подставляем нашему объекту соответствующие словари. |
||
+ | Другими словами, мы «на лету» подставляем нашему объекту соответствующие словари. |
||
И возвращаем наш объект в новой упаковке внутри типа Maybe. |
И возвращаем наш объект в новой упаковке внутри типа Maybe. |
||
Line 329: | Line 304: | ||
putStr "\ncall click function: " |
putStr "\ncall click function: " |
||
print$ map (\a->case a of Just (Wrp a)->click a; Nothing->"")$ |
print$ map (\a->case a of Just (Wrp a)->click a; Nothing->"")$ |
||
− | + | map (\(Wrp a)->asInstanceOfClickable a ) testData |
|
</haskell> |
</haskell> |
||
Вуаля. |
Вуаля. |
||
− | Ещё один шаг. Мы обобщим нашу функцию, |
+ | Ещё один шаг. Мы обобщим нашу функцию, то есть вместо узкоспециальной функции `asInstanceOfClickable` напишем общую функцию `asInstanceOf`: |
+ | |||
− | asInstanceOfClickable напишем общую функцию asInstanceOf |
||
<haskell> |
<haskell> |
||
asInstanceOf::Typeable a => |
asInstanceOf::Typeable a => |
||
− | + | [Wrap (constraint :: * -> Constraint)] -> |
|
− | + | a -> |
|
− | + | Maybe (Wrap (constraint :: * -> Constraint)) |
|
asInstanceOf list a = |
asInstanceOf list a = |
||
if null typeOfClass then |
if null typeOfClass then |
||
Line 351: | Line 326: | ||
unwrap (Wrp b) = substitute a b |
unwrap (Wrp b) = substitute a b |
||
substitute::forall t1 t2 constraint. |
substitute::forall t1 t2 constraint. |
||
− | + | (Typeable t2, Show t2, (constraint :: * -> Constraint) t2) => |
|
− | + | t1 -> |
|
− | + | t2 -> |
|
− | + | Wrap (constraint :: * -> Constraint) |
|
substitute x y = Wrp (unsafeCoerce x::t2) |
substitute x y = Wrp (unsafeCoerce x::t2) |
||
</haskell> |
</haskell> |
||
− | + | ...и проведём ещё пару экспериментов: |
|
<haskell> |
<haskell> |
||
Line 365: | Line 340: | ||
putStr "\ncall render function: " |
putStr "\ncall render function: " |
||
print$ map (\a->case a of Just (Wrp a)->render a; Nothing->"")$ |
print$ map (\a->case a of Just (Wrp a)->render a; Nothing->"")$ |
||
− | + | map (\(Wrp a)->asInstanceOf renderableTypes a ) testData |
|
putStr "\ncall serialize function: " |
putStr "\ncall serialize function: " |
||
print$ map (\a->case a of Just (Wrp a)->serialize a; Nothing->"")$ |
print$ map (\a->case a of Just (Wrp a)->serialize a; Nothing->"")$ |
||
− | + | map (\(Wrp a)->asInstanceOf serializableTypes a ) testData |
|
</haskell> |
</haskell> |
||
− | ... |
+ | ...а также попробуем объединить действия из разных функциональных интерфейсов: |
<haskell> |
<haskell> |
||
Line 384: | Line 359: | ||
(case b of Just (Wrp b)->render b; Nothing->"-") )$ |
(case b of Just (Wrp b)->render b; Nothing->"-") )$ |
||
map (\(Wrp a)->(asInstanceOf clickableTypes a, asInstanceOf renderableTypes a) ) |
map (\(Wrp a)->(asInstanceOf clickableTypes a, asInstanceOf renderableTypes a) ) |
||
− | + | testData |
|
</haskell> |
</haskell> |
||
− | ... |
+ | ...или применим преобразование последовательно: |
<haskell> |
<haskell> |
||
Line 407: | Line 382: | ||
</haskell> |
</haskell> |
||
− | Конечно же, код, написанный |
+ | Конечно же, код, написанный «с пылу, с жару», не лишён изъянов. |
− | модуль, например |
+ | Всё должно быть упаковано в соответствующий модуль, например `Data.InferInstanceOf` или `Data.InstanceOf`. |
+ | Такие моменты как создание списков типов, хорошо автоматизируются с помощью TemplateHaskell. |
||
− | автоматизируются с помощью TemplateHaskell. Для лучшего восприятия можно воспользоваться Data.Maybe |
||
− | или взаимодействовать с Maybe в |
+ | Для лучшего восприятия можно воспользоваться `Data.Maybe` или взаимодействовать с `Maybe` в монадическом стиле. |
+ | Для проекта, который мы разрабатываем, я, конечно же, проведу эту работу. |
||
− | эту работу. Но то, что уже имеется будет большим подспорьем на нашем проекте. |
||
+ | Но то, что уже имеется, будет большим подспорьем на нашем проекте. |
||
− | И самое главное. Я попытался немного подвинуть |
+ | И самое главное. Я попытался немного подвинуть Хаскелл в сторону мультипарадигменности. |
Почему? Да, хотя бы потому, что мне самому это понадобилось и показалось интересным реализовать. |
Почему? Да, хотя бы потому, что мне самому это понадобилось и показалось интересным реализовать. |
||
В заключение хочу сказать, что в процессе поиска решения задачи было опробовано много различных подходов. |
В заключение хочу сказать, что в процессе поиска решения задачи было опробовано много различных подходов. |
||
− | Например, я пробовал решить задачу с использованием |
+ | Например, я пробовал решить задачу с использованием семейств типов, с помощью рефлексии (`Data.Reflection`), с помощью `Dict` из `Data.Constraint`, с помощью `cast`, с помощью `Data.Dynamic` и прочего. |
+ | Однако, каждый раз я заходил в тупик. Хаскелл ревностно защищает свою систему типов и жёстко пресекает все попытки её (защиту) обойти. |
||
− | с помощью Dict из Data.Constraint, с помощью "cast", с помощью Data.Dynamic и пр. |
||
− | Однако, каждый раз я заходил в тупик. Хаскель ревностно защищает свою систему типов и жёстко пресекает |
||
− | все попытки её (защиту) обойти. |
||
Буду рад, если эта статья окажется кому-то полезной. |
Буду рад, если эта статья окажется кому-то полезной. |
||
Line 432: | Line 406: | ||
[https://stackoverflow.com/questions/32481418/unsafe-entailment-with-haskell-constraints ghc - Unsafe entailment with Haskell constraints - Stack Overflow] |
[https://stackoverflow.com/questions/32481418/unsafe-entailment-with-haskell-constraints ghc - Unsafe entailment with Haskell constraints - Stack Overflow] |
||
− | [https://www.tutel.me/c/programming/questions/32481418/unsafe+entailment+with+haskell+constraints |
+ | [https://www.tutel.me/c/programming/questions/32481418/unsafe+entailment+with+haskell+constraints unsafe entailment with haskell constraints www.tutel.me] |
− | [https://www.tutel.me/c/programming/questions/29482576/turning+a+dict+into+a+constraint |
+ | [https://www.tutel.me/c/programming/questions/29482576/turning+a+dict+into+a+constraint turning a dict into a constraint www.tutel.me] |
[https://gist.github.com/sacundim/5386823 Toy instructional example of Haskell GADTs: simple dynamic types. · GitHub] |
[https://gist.github.com/sacundim/5386823 Toy instructional example of Haskell GADTs: simple dynamic types. · GitHub] |
||
Line 440: | Line 414: | ||
[https://arxiv.org/pdf/cs/0509027.pdf OOHaskell - 0509027.pdf] |
[https://arxiv.org/pdf/cs/0509027.pdf OOHaskell - 0509027.pdf] |
||
− | [http://www.rubendegooijer.nl/posts/2013-04-06-haskell-oop.html |
+ | [http://www.rubendegooijer.nl/posts/2013-04-06-haskell-oop.html OOP in Haskell: implementing wxHaskell in Haskell] |
[https://www.microsoft.com/en-us/research/publication/object-oriented-style-overloading-for-haskell/ Object-Oriented Style Overloading for Haskell - Microsoft Research] |
[https://www.microsoft.com/en-us/research/publication/object-oriented-style-overloading-for-haskell/ Object-Oriented Style Overloading for Haskell - Microsoft Research] |
||
Line 456: | Line 430: | ||
[http://www.haskellforall.com/2012/05/scrap-your-type-classes.html Haskell for all: Scrap your type classes] |
[http://www.haskellforall.com/2012/05/scrap-your-type-classes.html Haskell for all: Scrap your type classes] |
||
− | [http://blog.omega-prime.co.uk/2011/09/10/constraint-kinds-for-ghc/ |
+ | [http://blog.omega-prime.co.uk/2011/09/10/constraint-kinds-for-ghc/ Constraint Kinds for GHC] |
[https://stackoverflow.com/questions/20997745/how-do-i-make-an-heterogeneous-list-in-haskell-originally-in-java typeclass - How do I make an heterogeneous list in Haskell? (originally in Java) - Stack Overflow] |
[https://stackoverflow.com/questions/20997745/how-do-i-make-an-heterogeneous-list-in-haskell-originally-in-java typeclass - How do I make an heterogeneous list in Haskell? (originally in Java) - Stack Overflow] |
||
Line 470: | Line 444: | ||
[https://jeltsch.wordpress.com/2013/02/09/some-interesting-features-of-haskells-type-system/ Some interesting features of Haskell’s type system | Wolfgang Jeltsch] |
[https://jeltsch.wordpress.com/2013/02/09/some-interesting-features-of-haskells-type-system/ Some interesting features of Haskell’s type system | Wolfgang Jeltsch] |
||
− | [http://chrisdone.com/posts/data-typeable |
+ | [http://chrisdone.com/posts/data-typeable Typeable and Data in Haskell] |
− | [https://wiki.haskell.org/GHC/Type_families#Detailed_definition_of_type_synonym_families |
+ | [https://wiki.haskell.org/GHC/Type_families#Detailed_definition_of_type_synonym_families GHC/Type families - HaskellWiki] |
[https://stackoverflow.com/questions/5396783/get-a-list-of-the-instances-in-a-type-class-in-haskell introspection - Get a list of the instances in a type class in Haskell - Stack Overflow] |
[https://stackoverflow.com/questions/5396783/get-a-list-of-the-instances-in-a-type-class-in-haskell introspection - Get a list of the instances in a type class in Haskell - Stack Overflow] |
||
− | [https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/constraint-kind.html |
+ | [https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/constraint-kind.html 7.12. The Constraint kind] |
[http://andrew.gibiansky.com/blog/haskell/haskell-typeclasses/#_converting_between_numeric_types Typeclasses: Polymorphism in Haskell - Andrew Gibiansky] |
[http://andrew.gibiansky.com/blog/haskell/haskell-typeclasses/#_converting_between_numeric_types Typeclasses: Polymorphism in Haskell - Andrew Gibiansky] |
||
− | [https://stackoverflow.com/questions/20576596/tagging-functions-in-haskell/20576712#20576712 |
+ | [https://stackoverflow.com/questions/20576596/tagging-functions-in-haskell/20576712#20576712 Tagging functions in Haskell - Stack Overflow] |
[https://stackoverflow.com/questions/27008046/allowambiguoustypes-and-propositional-equality-whats-going-on-here haskell - AllowAmbiguousTypes and propositional equality: what's going on here? - Stack Overflow] |
[https://stackoverflow.com/questions/27008046/allowambiguoustypes-and-propositional-equality-whats-going-on-here haskell - AllowAmbiguousTypes and propositional equality: what's going on here? - Stack Overflow] |
||
− | [https://ocharles.org.uk/blog/posts/2014-12-12-type-families.html |
+ | [https://ocharles.org.uk/blog/posts/2014-12-12-type-families.html 24 Days of GHC Extensions: Type Families] |
− | [https://wiki.haskell.org/GHC/AdvancedOverlap |
+ | [https://wiki.haskell.org/GHC/AdvancedOverlap GHC/AdvancedOverlap - HaskellWiki] |
[https://stackoverflow.com/questions/28243383/how-can-i-read-the-metadata-of-a-type-at-runtime haskell - How can I read the metadata of a type at runtime? - Stack Overflow] |
[https://stackoverflow.com/questions/28243383/how-can-i-read-the-metadata-of-a-type-at-runtime haskell - How can I read the metadata of a type at runtime? - Stack Overflow] |
||
Line 500: | Line 474: | ||
Ниже представлен весь исходный код целиком. |
Ниже представлен весь исходный код целиком. |
||
− | Его можно скопировать в файл (например, testInstanceOfClass.hs) и запустить командой runhaskell testInstanceOfClass.hs |
+ | Его можно скопировать в файл (например, `testInstanceOfClass.hs`) и запустить командой `runhaskell testInstanceOfClass.hs`: |
<haskell> |
<haskell> |
||
Line 677: | Line 651: | ||
− | --[[User:Ilya|Ilya]] ([[User talk:Ilya|talk]]) |
+ | --[[User:Ilya|Ilya]] ([[User talk:Ilya|talk]]) 13:00, 20 October 2017 (UTC) |
Latest revision as of 13:00, 20 October 2017
Цели и задачи
- Фильтрация элементов (объектов) гетерогенных списков по классам типов.
- Создание «настоящих» гетерогенных списков, обладающих полной функциональностью.
Библиотека и примеры использования
Описание проблемы
Мы реализуем проект на Хаскелле. И в рамках проекта появилась необходимость в использовании ООП парадигмы. Обсуждение, хорошо это или плохо, выходит за рамки данной статьи. Самое главное, что для нашего проекта, для решения конкретно наших задач, подошёл именно ООП подход.
Однако, камнем преткновения для нас стала невозможность хранения объектов в универсальных, так называемых гетерогенных списках. Хранить-то в принципе можно, но полноценно использовать — нет, даже при использовании экзистенциальных типов. Проблема, достаточно широко известная в Хаскелле. На одной из страниц Stack Overflow я нашёл такой комментарий: «You can use existensials, but then you can't do anything with the data after pattern matching on it», — что достаточно категорично характеризует ситуацию. Я достаточно долго бился над проблемой и, к сожалению, не нашёл решения данной задачи в интернете. Я изучил большое количество статей и провёл много экспериментов. См. внизу список использованных мною в процессе подготовки материалов. Время и усилия были не напрасны в плане погружения в Хаскелл, но больше всего радует то, что поставленная задача решена. Пусть пока грубо, пусть только для нашего конкретного случая.
Решение задачи
Хаскелл по своей сути является функциональным языком программирования. Однако, пусть он будет мультипарадигменным хотя бы в нашем проекте.
Итак, примем за основу следующую схему. В моём восприятии, это традиционный путь в Хаскелле для имитации ООП. Для определения и хранения полей объектов будем использовать `data` и/или `newtype`. Для придания объекту функциональности будем использовать классы типов (`class`), как, в некотором роде, аналоги интерфейсам в традиционных ОО языках. Типы, классы и экземпляры (`instance`) вместе пусть соответствуют классам в ООП.
Вся суть идеи будет заключена лишь в паре функций и массивов. Тем не менее, для того, чтобы показать, что всё работает (и как работает), напишем небольшой проект. Для пущей убедительности в том, что всё работает, сделаем объекты проекта «множественно наследуемыми».
Постараюсь сделать проект максимально простым. Основная цель проекта — донести суть концепции.
Итак, приступим. Для начала приведу описание структуры дерева объектов:
- `RenderableBase` — абстрактный тип, отвечающий за расположение и рисование;
- `SerializableBase` — абстрактный тип, отвечающий за сериализацию.
Объекты следующих типов будут включены в гетерогенный список:
- `Circle`, наследуется от `RenderableBase` и `SerializableBase`;
- `Rectangle`, наследуется от `RenderableBase`;
- `Triangle`, наследуется от `RenderableBase`.
Представим схему наследования в виде небольшого списка:
- `SerializableBase > Circle`
- `RenderableBase > Circle`
- `RenderableBase > Rectangle`
- `RenderableBase > Triangle`
Иерархия наследования не играет никакой роли в реализации концепции и приведена лишь для того, чтобы придать проекту ощущение объектно-ориентированного подхода.
Теперь дам описание классов типов:
- `ClsShape` предназначен для объединения объектов в гетерогенный список;
- `ClsRenderable` описывает функцию рендеринга;
- `ClsClickable` описывает функцию-реакцию на клик мышки;
- `ClsSerializable` описывает функцию сериализации объекта.
Теперь нечто более важное:
- объекты типов `Circle`, `Rectangle` и `Triangle` могут быть отрисованы, то есть реализуют функцию `render`;
- на объекты типов `Rectangle` и `Triangle` можно кликнуть мышкой (Внимание! На объекты типа `Circle` кликнуть мышкой нельзя, то есть тип `Circle` не реализует класс `ClsClickable`);
- объект типа `Circle` можно сериализовать (класс `ClsSerializable`).
Представим схему функциональности в виде небольшого списка, который показывает, какой класс каким типом реализуется:
- `ClsRenderable > Circle`
- `ClsRenderable > Rectangle`
- `ClsRenderable > Triangle`
- `ClsClickable > Rectangle`
- `ClsClickable > Triangle`
- `ClsSerializable > Circle`
Теперь начнём писать код. Для начала включим все необходимые нам расширения GHC и импортируем библиотеки:
{-# LANGUAGE GADTs, ConstraintKinds, KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-}
{-# LANGUAGE DuplicateRecordFields, RecordWildCards #-}
module Main where
import Data.Typeable (Typeable, typeOf)
import GHC.Exts (Constraint)
import Unsafe.Coerce (unsafeCoerce)
Да, нам понадобится функция небезопасного приведения типов unsafeCoerce, но об этом чуть позже. Весь код сосредоточен в одном файле, однако, давайте представим, что всё разбито на модули. Этим мне хотелось бы показать, что проект масштабируем. Сначала опишем все классы, базовые абстрактные типы и типы данных, для которых мы будем создавать объекты. А также инстанцируем каждый тип. Пока всё тривиально. Мы используем «традиционный» подход для имитации ООП в Хаскелле:
-- module Base where --
class ClsShape shape
-- module RenderableBase where --
class ClsRenderable a where render::a->String
data RenderableBase = RenderableBase {coords::String} deriving Show
instance ClsRenderable RenderableBase where render a = coords a
-- module ClickableBase where --
class ClsClickable a where click::a->String
-- module SerializableBase where --
class ClsSerializable a where serialize::a->String
data SerializableBase = SerializableBase {serializedData::String} deriving Show
instance ClsSerializable SerializableBase where serialize a = serializedData a
-- module Circle where --
data Circle = Circle {
name :: String,
renderableBase :: RenderableBase,
serializableBase :: SerializableBase
} deriving Show
instance ClsShape Circle
instance ClsRenderable Circle where
render Circle{..} = "Circle " ++ name ++ " " ++ render renderableBase
instance ClsSerializable Circle where
serialize Circle{..} = "Circle " ++ name ++ " " ++ serialize serializableBase
-- module Rectangle where --
data Rectangle = Rectangle {
name :: String,
renderableBase :: RenderableBase
} deriving Show
instance ClsShape Rectangle
instance ClsRenderable Rectangle where
render Rectangle{..} = "Rectangle " ++ name ++ " " ++ render renderableBase
instance ClsClickable Rectangle where
click Rectangle{..} = "Rectangle " ++ name ++ " " ++ coords renderableBase ++ " clicked"
-- module Triangle where --
data Triangle = Triangle {
name :: String,
renderableBase :: RenderableBase
} deriving Show
instance ClsShape Triangle
instance ClsRenderable Triangle where
render Triangle{..} = "Triangle " ++ name ++ " " ++ render renderableBase
instance ClsClickable Triangle where
click Triangle{..} = "Triangle " ++ name ++ " " ++ coords renderableBase ++ " clicked"
Теперь немного интереснее. Создадим тип-обёртку для реализации гетерогенного списка:
-- module InferInstanceOf where --
data Wrap (constraint :: * -> Constraint) where
Wrp :: (Show a, Typeable a, constraint a) => a -> Wrap constraint
instance Show (Wrap a) where show (Wrp a) = show a
Инстанцирование класса `Show` не играет никакой роли и служит лишь отладочным целям. А вот фраза `(constraint :: * -> Constraint)` гораздо интереснее. Тут мы как бы говорим, что в качестве подтипа для типа `Wrap` мы будем использовать некий класс. То есть классы в данном случае будут играть роль типов.
Теперь создадим сам гетерогенный список:
-- module Main where --
testData :: [Wrap ClsShape]
testData = [
Wrp$ Circle "crcl_1" (RenderableBase "(1, 1)") (SerializableBase "Crcl1"),
Wrp$ Circle "crcl_2" (RenderableBase "(2, 2)") (SerializableBase "Crcl2"),
Wrp$ Rectangle "rect_1" (RenderableBase "(3, 3)"),
Wrp$ Rectangle "rect_2" (RenderableBase "(4, 4)"),
Wrp$ Triangle "trngl_1" (RenderableBase "(5, 5)"),
Wrp$ Triangle "trngl_2" (RenderableBase "(6, 6)")
]
Первое: список можно пополнять динамически в процессе выполнения программы. Второе: мы тут же теряем всю информацию о функциональности каждого объекта, то есть все словари для классов `ClsRenderable`, `ClsClickable` и `ClsSerializable`. Остаются лишь ничего не значащиe для нас `ClsShape`, `Typeable` (о нём чуть позже) и `Show` для отладочных целей.
Максимум, что мы можем сейчас сделать, это просто напечатать список объектов:
main = do
putStr "all objects: "
print$ map (\(Wrp a)->show a) testData
all objects: ["Circle {name = \"crcl_1\", renderableBase = RenderableBase {coords = \"(1, 1)\"} ...
Теперь переходим к самой интересной части, в которой будет показана вся суть идеи работы с гетерогенными списками. Определяем списки распределённых по классам типов:
renderableTypes:: [Wrap ClsRenderable]
renderableTypes = [
Wrp (undefined::Circle),
Wrp (undefined::Rectangle),
Wrp (undefined::Triangle)
]
clickableTypes:: [Wrap ClsClickable]
clickableTypes = [
Wrp (undefined::Rectangle),
Wrp (undefined::Triangle)
]
serializableTypes:: [Wrap ClsSerializable]
serializableTypes = [
Wrp (undefined::Circle)
]
Пока вручную. Позже эту работу возьмёт на себя TemplateHaskell. Мало того, позже попытаемся упаковать эти списки в гетерогенный список типа `HList`, чтобы не использовать неуместные здесь функции. Итак, каждый элемент этих списков опредлён как `undefined`, то есть данные нас не интересуют. Нам нужно сохранить информацию о типе и, что более важно, нам важно не потерять информацию о функциональности, то есть нам нужно как-то сохранить словари.
Идём дальше. Первый этап нашей концепции научиться фильтровать наш гетерогенный список по классу. Для этого напишем следующие функции:
-- module InferInstanceOf where --
instanceOf::Typeable a => [Wrap (constraint :: * -> Constraint)] -> a -> Bool
instanceOf list a = not. null $ selectType list a
instanceWrapOf::
[Wrap (constraint :: * -> Constraint)] ->
Wrap (constraint2 :: * -> Constraint) -> Bool
instanceWrapOf list (Wrp a) = instanceOf list a
selectType::Typeable a =>
[Wrap (constraint :: * -> Constraint)] ->
a ->
[Wrap (constraint :: * -> Constraint)]
selectType list a = filter inList list
where inList (Wrp b) = typeOf a == typeOf b
Тут мы принимаем некий объект (или обёртку с объектом), список типов, относящихся к определённому классу, и фильтруем этот список по типу. Вот для этого нам и понадобились `Typeable` и `typeOf` из пакета Data.Typeable. Тут всё просто, если есть тип нашего объекта в списке, тогда объект относится к соответствующему классу. (Не забывайте, Хаскелл после компиляции полностью забывает про классы.)
Итак, теперь мы можем немного больше, например, отфильтровать наш список по классу и напечатать выборку:
main = do
-- ...
putStr "\nclickable objects: "
print$ map show$ filter (\(Wrp a)->instanceOf clickableTypes a) testData
putStr "\nserializable objects: "
print$ map show$ filter (instanceWrapOf serializableTypes) testData
То есть если нам понадобятся только объекты класса `ClsClickable` или класса `ClsSerializable`, то есть объекты, обладающие строго определённой функциональностью, мы их получим. И сможем их только... напечатать. Ничего больше. Но это уже нечто большее, нежели мы ожидали от гетерогенных списков ранее.
Идем дальше.
Нам, тем не менее, всё-таки необходимо как-то с нашими объектами работать. И для этого напишем следующую функцию. И вот она будет корнем всей концепции, тем, ради чего мы всё и затеяли:
-- module Main (later InferInstanceOf) where --
asInstanceOfClickable a =
if null typeOfClass then
Nothing
else
Just. unwrap. head$ typeOfClass
where
typeOfClass = selectType clickableTypes a
unwrap (Wrp b) = substitute a b
substitute::forall t1 t2. (Typeable t2, Show t2, ClsClickable t2) =>
t1 ->
t2 ->
Wrap ClsClickable
substitute x y = Wrp (unsafeCoerce x::t2)
Эта функция подлежит генерализации и мы это сделаем ниже. Но сейчас давайте попытаемся понять, что же тут происходит. Мы принимаем объект. Далее, с помощью фильтрации, анализируем, относится ли этот объект к классу. Если относится, распаковываем тип (`undefined::некий тип`) из соответствующей обёртки. Проводим подстановку типов, то есть как бы подтверждаем с помощью функции unsafeCoerce, что наш объект относится к типу, инстанцирующему запрошенный нами класс. И... перепаковываем наш объект в новую обёртку. В обёртку с необходимой нам функциональностью. Другими словами, мы «на лету» подставляем нашему объекту соответствующие словари. И возвращаем наш объект в новой упаковке внутри типа Maybe.
Теперь мы можем полноценно работать с нашим объектом из гетерогенного списка:
main = do
-- ...
putStr "\ncall click function: "
print$ map (\a->case a of Just (Wrp a)->click a; Nothing->"")$
map (\(Wrp a)->asInstanceOfClickable a ) testData
Вуаля.
Ещё один шаг. Мы обобщим нашу функцию, то есть вместо узкоспециальной функции `asInstanceOfClickable` напишем общую функцию `asInstanceOf`:
asInstanceOf::Typeable a =>
[Wrap (constraint :: * -> Constraint)] ->
a ->
Maybe (Wrap (constraint :: * -> Constraint))
asInstanceOf list a =
if null typeOfClass then
Nothing
else
Just. unwrap. head$ typeOfClass
where
typeOfClass = selectType list a
unwrap (Wrp b) = substitute a b
substitute::forall t1 t2 constraint.
(Typeable t2, Show t2, (constraint :: * -> Constraint) t2) =>
t1 ->
t2 ->
Wrap (constraint :: * -> Constraint)
substitute x y = Wrp (unsafeCoerce x::t2)
...и проведём ещё пару экспериментов:
main = do
-- ...
putStr "\ncall render function: "
print$ map (\a->case a of Just (Wrp a)->render a; Nothing->"")$
map (\(Wrp a)->asInstanceOf renderableTypes a ) testData
putStr "\ncall serialize function: "
print$ map (\a->case a of Just (Wrp a)->serialize a; Nothing->"")$
map (\(Wrp a)->asInstanceOf serializableTypes a ) testData
...а также попробуем объединить действия из разных функциональных интерфейсов:
main = do
-- ...
putStr "\ncall click and render functions: "
print$
map (\(a, b)->
"click: " ++
(case a of Just (Wrp a)->click a; Nothing->"-") ++
"; render: " ++
(case b of Just (Wrp b)->render b; Nothing->"-") )$
map (\(Wrp a)->(asInstanceOf clickableTypes a, asInstanceOf renderableTypes a) )
testData
...или применим преобразование последовательно:
main = do
-- ...
putStr "\ncall click and render functions: "
print$
map (\w->"click: " ++
case w of
Just (Wrp a)->
click a ++
"; render: " ++
case asInstanceOf renderableTypes a of
Just (Wrp d)->render d
Nothing->"-"
Nothing->"-"
)$
map (\(Wrp a)->asInstanceOf clickableTypes a ) testData
Конечно же, код, написанный «с пылу, с жару», не лишён изъянов. Всё должно быть упаковано в соответствующий модуль, например `Data.InferInstanceOf` или `Data.InstanceOf`. Такие моменты как создание списков типов, хорошо автоматизируются с помощью TemplateHaskell. Для лучшего восприятия можно воспользоваться `Data.Maybe` или взаимодействовать с `Maybe` в монадическом стиле. Для проекта, который мы разрабатываем, я, конечно же, проведу эту работу. Но то, что уже имеется, будет большим подспорьем на нашем проекте.
И самое главное. Я попытался немного подвинуть Хаскелл в сторону мультипарадигменности. Почему? Да, хотя бы потому, что мне самому это понадобилось и показалось интересным реализовать.
В заключение хочу сказать, что в процессе поиска решения задачи было опробовано много различных подходов. Например, я пробовал решить задачу с использованием семейств типов, с помощью рефлексии (`Data.Reflection`), с помощью `Dict` из `Data.Constraint`, с помощью `cast`, с помощью `Data.Dynamic` и прочего. Однако, каждый раз я заходил в тупик. Хаскелл ревностно защищает свою систему типов и жёстко пресекает все попытки её (защиту) обойти.
Буду рад, если эта статья окажется кому-то полезной.
Список использованных в процессе подготовки материалов
haskell - Use of 'unsafeCoerce' - Stack Overflow
ghc - Unsafe entailment with Haskell constraints - Stack Overflow
unsafe entailment with haskell constraints www.tutel.me
turning a dict into a constraint www.tutel.me
Toy instructional example of Haskell GADTs: simple dynamic types. · GitHub
OOP in Haskell: implementing wxHaskell in Haskell
Object-Oriented Style Overloading for Haskell - Microsoft Research
OOHaskell/CircBuffer.hs at master · nkaretnikov/OOHaskell · GitHub
oo-haskell/Store.hs at master · andorp/oo-haskell · GitHub
newtype Monoid example haskell - Use of 'unsafeCoerce' - Stack Overflow
haskell - How to put constraints on the associated data? - Stack Overflow
Haskell for all: Scrap your type classes
typeclass - How do I make an heterogeneous list in Haskell? (originally in Java) - Stack Overflow
haskell - ConstraintKinds explained on a super simple example - Stack Overflow
OOP vs type classes - HaskellWiki
Heterogenous collections - HaskellWiki
How to work on lists - HaskellWiki
Some interesting features of Haskell’s type system | Wolfgang Jeltsch
GHC/Type families - HaskellWiki
introspection - Get a list of the instances in a type class in Haskell - Stack Overflow
Typeclasses: Polymorphism in Haskell - Andrew Gibiansky
Tagging functions in Haskell - Stack Overflow
haskell - AllowAmbiguousTypes and propositional equality: what's going on here? - Stack Overflow
24 Days of GHC Extensions: Type Families
GHC/AdvancedOverlap - HaskellWiki
haskell - How can I read the metadata of a type at runtime? - Stack Overflow
Reflecting values to types and back - School of Haskell | School of Haskell
Type Families and Pokemon. - School of Haskell | School of Haskell
GHC/Type families - HaskellWiki
Исходный код
Ниже представлен весь исходный код целиком. Его можно скопировать в файл (например, `testInstanceOfClass.hs`) и запустить командой `runhaskell testInstanceOfClass.hs`:
{-# LANGUAGE GADTs, ConstraintKinds, KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-}
{-# LANGUAGE DuplicateRecordFields, RecordWildCards #-}
module Main where
import Data.Typeable (Typeable, typeOf)
import GHC.Exts (Constraint)
import Unsafe.Coerce (unsafeCoerce)
-- module Base where --
class ClsShape shape
-- module RenderableBase where --
class ClsRenderable a where
render::a->String
data RenderableBase = RenderableBase {coords::String} deriving Show
instance ClsRenderable RenderableBase where
render a = coords a
-- module ClickableBase where --
class ClsClickable a where
click::a->String
-- module SerializableBase where --
class ClsSerializable a where
serialize::a->String
data SerializableBase = SerializableBase {serializedData::String} deriving Show
instance ClsSerializable SerializableBase where
serialize a = serializedData a
-- module Circle where --
data Circle = Circle {
name :: String,
renderableBase :: RenderableBase,
serializableBase :: SerializableBase
} deriving Show
instance ClsShape Circle
instance ClsRenderable Circle where
render Circle{..} = "Circle " ++ name ++ " " ++ render renderableBase
instance ClsSerializable Circle where
serialize Circle{..} = "Circle " ++ name ++ " " ++ serialize serializableBase
-- module Rectangle where --
data Rectangle = Rectangle {
name :: String,
renderableBase :: RenderableBase
} deriving Show
instance ClsShape Rectangle
instance ClsRenderable Rectangle where
render Rectangle{..} = "Rectangle " ++ name ++ " " ++ render renderableBase
instance ClsClickable Rectangle where
click Rectangle{..} = "Rectangle " ++ name ++ " " ++ coords renderableBase ++ " clicked"
-- module Triangle where --
data Triangle = Triangle {
name :: String,
renderableBase :: RenderableBase
} deriving Show
instance ClsShape Triangle
instance ClsRenderable Triangle where
render Triangle{..} = "Triangle " ++ name ++ " " ++ render renderableBase
instance ClsClickable Triangle where
click Triangle{..} = "Triangle " ++ name ++ " " ++ coords renderableBase ++ " clicked"
-- module InferInstanceOf where --
data Wrap (constraint :: * -> Constraint) where
Wrp :: (Show a, Typeable a, constraint a) => a -> Wrap constraint
instance Show (Wrap a) where
show (Wrp a) = show a
-- module Main where --
testData :: [Wrap ClsShape]
testData = [
Wrp$ Circle "crcl_1" (RenderableBase "(1, 1)") (SerializableBase "Crcl1"),
Wrp$ Circle "crcl_2" (RenderableBase "(2, 2)") (SerializableBase "Crcl2"),
Wrp$ Rectangle "rect_1" (RenderableBase "(3, 3)"),
Wrp$ Rectangle "rect_2" (RenderableBase "(4, 4)"),
Wrp$ Triangle "trngl_1" (RenderableBase "(5, 5)"),
Wrp$ Triangle "trngl_2" (RenderableBase "(6, 6)")
]
renderableTypes:: [Wrap ClsRenderable]
renderableTypes = [
Wrp (undefined::Circle),
Wrp (undefined::Rectangle),
Wrp (undefined::Triangle)
]
clickableTypes:: [Wrap ClsClickable]
clickableTypes = [
Wrp (undefined::Rectangle),
Wrp (undefined::Triangle)
]
serializableTypes:: [Wrap ClsSerializable]
serializableTypes = [
Wrp (undefined::Circle)
]
-- module InferInstanceOf where --
instanceOf::Typeable a => [Wrap (constraint :: * -> Constraint)] -> a -> Bool
instanceOf list a = not. null $ selectType list a
instanceWrapOf::[Wrap (constraint :: * -> Constraint)] -> Wrap (constraint2 :: * -> Constraint) -> Bool
instanceWrapOf list (Wrp a) = instanceOf list a
selectType::Typeable a => [Wrap (constraint :: * -> Constraint)] -> a -> [Wrap (constraint :: * -> Constraint)]
selectType list a = filter inList list
where inList (Wrp b) = typeOf a == typeOf b
-- module InferInstanceOf where --
-- asInstanceOfClickable: only as example
asInstanceOfClickable a =
if null typeOfClass then
Nothing
else
Just. unwrap. head$ typeOfClass
where
typeOfClass = selectType clickableTypes a
unwrap (Wrp b) = substitute a b
substitute::forall t1 t2. (Typeable t2, Show t2, ClsClickable t2) => t1 -> t2 -> Wrap ClsClickable
substitute x y = Wrp (unsafeCoerce x::t2)
asInstanceOf::Typeable a => [Wrap (constraint :: * -> Constraint)] -> a -> Maybe (Wrap (constraint :: * -> Constraint))
asInstanceOf list a =
if null typeOfClass then
Nothing
else
Just. unwrap. head$ typeOfClass
where
typeOfClass = selectType list a
unwrap (Wrp b) = substitute a b
substitute::forall t1 t2 constraint. (Typeable t2, Show t2, (constraint :: * -> Constraint) t2) => t1 -> t2 -> Wrap (constraint :: * -> Constraint)
substitute x y = Wrp (unsafeCoerce x::t2)
-- module Main where --
main = do
putStr "all objects: "
print$ map (\(Wrp a)->show a) testData
putStr "\nclickable objects: "
print$ map show$ filter (\(Wrp a)->instanceOf clickableTypes a) testData
putStr "\nserializable objects: "
print$ map show$ filter (instanceWrapOf serializableTypes) testData
putStr "\ncall click function: "
print$ map (\w->case w of Just (Wrp a)->click a; Nothing->"")$
map (\(Wrp a)->asInstanceOfClickable a ) testData
putStr "\ncall render function: "
print$ map (\w->case w of Just (Wrp a)->render a; Nothing->"")$
map (\(Wrp a)->asInstanceOf renderableTypes a ) testData
putStr "\ncall serialize function: "
print$ map (\w->case w of Just (Wrp a)->serialize a; Nothing->"")$
map (\(Wrp a)->asInstanceOf serializableTypes a ) testData
putStr "\ncall click and render functions: "
print$ map (\(w1, w2)-> "click: " ++
(case w1 of Just (Wrp a)->click a; Nothing->"-") ++
"; render: " ++
(case w2 of Just (Wrp b)->render b; Nothing->"-") )$
map (\(Wrp a)->(asInstanceOf clickableTypes a, asInstanceOf renderableTypes a) ) testData
putStr "\ncall click and render functions: "
print$ map (\w->"click: " ++
case w of
Just (Wrp a)->
click a ++
"; render: " ++
case asInstanceOf renderableTypes a of
Just (Wrp d)->render d
Nothing->"-"
Nothing->"-"
)$
map (\(Wrp a)->asInstanceOf clickableTypes a ) testData