Функция для возврата части продукта или записи в зависимости от параметра и запрошенного типа возврата

Question

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

Например:

data MyProduct = MyProduct String Int Bool

prod = MyProduct "yes" 0 False

func prod :: Boolean -- would return False
func prod :: String  -- would return "yes"
func prod :: Double  -- compiler error

И аналогично для той же функции func, но другой продукт:

data AnotherProduct = AP (Maybe Int) Char

ap = AP Nothing 'C'

func ap :: Maybe Int -- would return Nothing

Существует ли такая функция? Я чувствую, что это должно быть возможно, возможно, используя Generic, Я знаю, что это возможно на других языках, таких как Scala с библиотекой Shapeless, но я не могу понять, как лучше всего подойти к этому в Haskell.

Answer 1

Согласно ответу @Li-yao_Xia, это можно сделать с GHC.Generics (который является то, что generic-lens использует за кулисами). Код в generic-lens Вероятно, немного трудно следовать, поэтому вот как вы можете сделать это с нуля.

Путь GHC.Generics работает, он представляет определенный тип, такой как:

data MyProduct = MyProduct String Int Bool deriving (Generic)

с помощью изоморфного типа Rep MyProduct это выглядит так:

> :kind! Rep MyProduct
Rep MyProduct :: * -> *
= D1
    ('MetaData "MyProduct" "GenericFetch3" "main" 'False)
    (C1
       ('MetaCons "MyProduct" 'PrefixI 'False)
       (S1
          ('MetaSel
             'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (Rec0 String)
        :*: (S1
               ('MetaSel
                  'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
               (Rec0 Int)
             :*: S1
                   ('MetaSel
                      'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                   (Rec0 Bool))))

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

Rep MyProduct = Rec0 String :*: Rec0 Int :*: Rec0 Bool

что помогает показать, как структурировано представление.

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

В нашем случае мы собираемся определить класс типов Fetch' что позволяет нам получить первое значение типа b вне представления t (то есть t будет Rep MyProduct или что-то подобное)

class Fetch' t b where
  fetch' :: t p -> Maybe b

На данный момент мы не будем требовать, чтобы t на самом деле содержат bИменно поэтому мы позволяем fetch' возвращать Nothing,

Нам понадобится экземпляр для обработки метаданных:

instance Fetch' t b => Fetch' (M1 i m t) b where
  fetch' (M1 x) = fetch' x

Поскольку все обертки метаданных (D1, S1, а также C1) на самом деле псевдонимы (M1 D, M1 S, M1 C соответственно), мы можем справиться со всеми M1 экземпляр, который проходит fetch' через обертку.

Нам также понадобится один для обработки продуктов:

instance (Fetch' s b, Fetch' t b) => Fetch' (s :*: t) b where
  fetch' (s :*: t) = fetch' s <|> fetch' t

Это просто принесет b с левой стороны продукта или - если это невозможно - с правой стороны.

И нам нужен экземпляр, чтобы получить b из поля (верхнего уровня) соответствующего типа (который соответствует Rec0 выше, так как это просто псевдоним для K1 R):

instance Fetch' (K1 i b) b where
  fetch' (K1 x) = Just x

а также перекрывающийся универсальный элемент, который будет обрабатывать поля неправильного типа:

instance {-# OVERLAPPABLE #-} Fetch' (K1 i b) a where
  fetch' (K1 _) = Nothing

Мы также можем опционально обрабатывать другие возможные конструкторы типов в этих представлениях (а именно: V1, U1, а также :+:), что я сделал в полном примере ниже.

В любом случае, с этими экземплярами мы могли бы написать:

fetch1 :: (Generic t, Fetch' (Rep t) b) => t -> b
fetch1 = fromJust . fetch' . from

и это прекрасно работает

> fetch1 prod :: String
"yes"
> fetch1 prod :: Int
0
> fetch1 prod :: Bool
False

но, как и с ответом @ Luqui на основе Data Вообще говоря, он не улавливает плохие поля во время компиляции, а скорее вылетает во время выполнения

> fetch1 prod :: Double
*** Exception: Maybe.fromJust: Nothing

Чтобы исправить это, мы можем ввести семейство типов, которое вычисляет, является ли структура данных (или, скорее, это Rep) фактически содержит необходимое поле, например:

type family Has t b where
  Has (s :*: t) b = Or (Has s b) (Has t b)
  Has (K1 i b) b = 'True
  Has (K1 i a) b = 'False
  Has (M1 i m t) b = Has t b

с обычным определением для семейства типов Or, Теперь мы можем добавить это как ограничение в определении fetch:

fetch :: ( Generic t
         , Has (Rep t) b ~ 'True
         , Fetch' (Rep t) b)
      => t -> b
fetch = fromJust . fetch' . from

и теперь мы получаем ошибку времени компиляции для плохих полей:

> fetch prod :: String
"yes"
> fetch prod :: Double

<interactive>:83:1: error:
    • Couldn't match type ‘'False’ with ‘'True’
        arising from a use of ‘fetch’
    • In the expression: fetch prod :: Double
      In an equation for ‘it’: it = fetch prod :: Double
>

Во всяком случае, собрать все вместе и добавить экземпляры и Has Определения для всех конструкторов, мы получаем следующую версию. Обратите внимание, что для типов суммы (т. Е. (:+:)), он допускает только те типы полей, которые могут быть найдены во всех терминах в сумме (и поэтому гарантированно присутствуют). в отличие от typed функция в generic-lens, эта версия допускает несколько полей целевого типа в продукте и просто выбирает первое.

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}

module GenericFetch where

import Control.Applicative
import Data.Maybe
import GHC.Generics

data MyProduct = MyProduct String Int Bool deriving (Generic)
prod :: MyProduct
prod = MyProduct "yes" 0 False

data AnotherProduct = AP (Maybe Int) Char deriving (Generic)
ap :: AnotherProduct
ap = AP Nothing 'C'

data ASum = A Int String | B Int Double deriving (Generic)
asum :: ASum
asum = A 10 "hello"

class Fetch' t b where
  fetch' :: t p -> Maybe b
instance Fetch' V1 b where
  fetch' _ = Nothing
instance Fetch' U1 b where
  fetch' _ = Nothing
instance (Fetch' s b, Fetch' t b) => Fetch' (s :+: t) b where
  fetch' (L1 s) = fetch' s
  fetch' (R1 t) = fetch' t
instance (Fetch' s b, Fetch' t b) => Fetch' (s :*: t) b where
  fetch' (s :*: t) = fetch' s <|> fetch' t
instance Fetch' (K1 i b) b where
  fetch' (K1 x) = Just x
instance {-# OVERLAPPABLE #-} Fetch' (K1 i b) a where
  fetch' (K1 _) = Nothing
instance Fetch' t b => Fetch' (M1 i m t) b where
  fetch' (M1 x) = fetch' x

type family Has t b where
  Has V1 b = 'False
  Has U1 b = 'False
  Has (s :+: t) b = And (Has s b) (Has t b)
  Has (s :*: t) b = Or (Has s b) (Has t b)
  Has (K1 i b) b = 'True
  Has (K1 i a) b = 'False
  Has (M1 i m t) b = Has t b
type family Or a b where
  Or 'False 'False = 'False
  Or a b = 'True
type family And a b where
  And 'True 'True = 'True
  And a b = 'False

fetch :: ( Generic t
         , Has (Rep t) b ~ 'True
         , Fetch' (Rep t) b)
      => t -> b
fetch = fromJust . fetch' . from

давая:

> :l GenericFetch
> fetch prod :: Int
0
> fetch prod :: Double
...type error...
> fetch ap :: Maybe Int
Nothing
> fetch ap :: Int
...type error...
> fetch asum :: Int
10
> fetch asum :: String
... type error: no string in `B` constructor...
> 

Answer 2

Одним из решений является универсальный объектив. Особенно, getTyped @T :: P -> T получит доступ к полю типа T в любом типе продукта P (это пример Generic). Вот пример в GHCi (для более подробной информации см. README):

> :set -XDeriveGeneric -XTypeApplications
> import Data.Generics.Product
> import GHC.Generics
> data MyProduct = MyProduct String Int Bool deriving Generic
> getTyped @Int (MyProduct "Hello" 33 True)
33
> getTyped @Int (0 :: Int, "hello")
0

Answer 3

Вот как получить список всех совместимых полей:

import Data.Data
import Data.Typeable
import Data.Maybe (maybeToList)

fields :: (Data a, Typeable b) => a -> [b]
fields = gmapQr (++) [] (maybeToList . cast)

Типы продуктов, которые вы используете, должны быть получены Data, Это может быть сделано автоматически с {-# LANGUAGE DeriveDataTypeable #-}

data MyProduct = MyProduct String Int Bool
    deriving (Typeable, Data)

Смотрите документы для gmapQr а также cast,

Единственное предостережение в том, что я не могу придумать способ выдать ошибку во время компиляции, когда вы запрашиваете поле, которого нет, как вы и просили. Нам понадобится какая-то версия во время компиляции Data.Data, Я не знаю ничего подобного, хотя подозреваю, что это возможно (хотя, вероятно, это будет немного более болезненно - deriving Data делает много тяжелой работы для нас!).

Answer 4

Это не может быть сделано в соответствии со стандартом Haskell 98. В общем, параметрическая функция не может изменить поведение в зависимости от конкретного типа, которым она становится. Он должен оставаться общим.

В качестве мыслительного процесса о том, почему это может быть рассмотрено дело:

data MpProduct a = My Product Int Int String [a]

Что следует func вернуть попросили Int? Как насчет когда a такое Чар?

Я не говорю о том, что какой-то опыт программиста с глубоким знанием расширений GHC не мог этого сделать, но это невозможно с помощью стандартной проверки типов Hindley Milner.