Как использовать GH C Generics или Data.Data в списке данных для объединения полей по определенным критериям? - PullRequest
1 голос
/ 14 июля 2020

У меня есть данные, которые выглядят так:

data Test = Test {
  id :: Int,
  rating :: Maybe Float,
  amount :: Maybe Int,
  reviewHeader :: Maybe String,
  reviewDescription:: Maybe String
  }
  deriving (Typeable, Data, Eq, Show, GHC.Generic)

testList :: [Test]

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

t1 :: Test
t1 = Test 1 (Just 1.1) (Just 2) Nothing (Just "t22")
    
t2 :: Test
t2 = Test 1 (Just 2.1) (Just 2) (Just "t1") (Just "t22")

t3 :: Test
t3 = Test 1 Nothing Nothing (Just "t2") (Just "t22")

t4 :: Test
t4 = Test 1 (Just 1.1) Nothing Nothing (Just "t22")

testList = [t1, t2, t3, t4]

output = function testList

-- output equals Test 1 Nothing (Just 2) Nothing (Just "t22")

Я понимаю, как я бы сделал это с двумя значениями, но мне нужно выполнить это в списке. Также мои реальные данные содержат 20+ записей и несколько версий, поэтому я хотел бы использовать Generics.

1 Ответ

3 голосов
/ 14 июля 2020

Заголовок:

{-# LANGUAGE DeriveGeneric, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PolyKinds, TypeFamilies, TypeOperators #-}
import Data.Kind(Type)
import Data.Maybe(fromJust)
import Data.Semigroup(First(..))
import GHC.Generics((:*:)(..), Generic, K1(..), M1(..), Rep, from, to)
import GHC.Exts(Any)

Давайте воспользуемся этим этим из предыдущего ответа:

data Same a = Vacuous | Fail | Same a
instance Eq a => Semigroup (Same a) where
    Vacuous    <> x       = x
    Fail       <> _       = Fail
    s@(Same l) <> Same r  = if l == r then s else Fail
    x          <> Vacuous = x
    _          <> Fail    = Fail
instance Eq a => Monoid (Same a) where
    mempty = Vacuous

Мы можем вставить Maybe в Same :

maybeSame :: Maybe a -> Same a
maybeSame = maybe Vacuous Same

, и мы можем свернуть другим способом:

sameMaybe :: Same a -> Maybe a
sameMaybe (Same x) = Just x
sameMaybe _ = Nothing

Давайте применим оба к каждому полю в общем c представлении:

class Monoid (MaybeSameAllRep rep p) => GMaybeSameAll rep p where
    type MaybeSameAllRep rep :: k -> Type
    gMaybeSameAll :: rep p -> MaybeSameAllRep rep p
    gSameMaybeAll :: MaybeSameAllRep rep p -> rep p
type family ForBase (x :: Type) :: Type where
    ForBase (Maybe x) = Same x
    ForBase x = Maybe (First x)
instance {-# OVERLAPS #-} Eq a => GMaybeSameAll (K1 i (Maybe a)) p where
    gMaybeSameAll = K1 . maybeSame . unK1
    gSameMaybeAll = K1 . sameMaybe . unK1
instance ForBase c ~ Maybe (First c) => GMaybeSameAll (K1 i c) p where
    type MaybeSameAllRep (K1 i c) = K1 i (ForBase c)
    gMaybeSameAll = K1 . Just . First . unK1
    gSameMaybeAll = K1 . getFirst . fromJust . unK1
instance (GMaybeSameAll l p, GMaybeSameAll r p) => GMaybeSameAll (l :*: r) p where
    type MaybeSameAllRep (l :*: r) = MaybeSameAllRep l :*: MaybeSameAllRep r
    gMaybeSameAll (l :*: r) = gMaybeSameAll l :*: gMaybeSameAll r
    gSameMaybeAll (l :*: r) = gSameMaybeAll l :*: gSameMaybeAll r
instance (GMaybeSameAll r p) => GMaybeSameAll (M1 i c r) p where
    type MaybeSameAllRep (M1 i c r) = M1 i c (MaybeSameAllRep r)
    gMaybeSameAll = M1 . gMaybeSameAll . unM1
    gSameMaybeAll = M1 . gSameMaybeAll . unM1

Итак, все сводится к простому преобразованию и объединению:

combine :: (Foldable f, Generic t, GMaybeSameAll (Rep t) Any) => f t -> t
combine = post . foldMap pre
    where post :: (Generic t, GMaybeSameAll (Rep t) Any) => MaybeSameAllRep (Rep t) Any -> t
          post = to . gSameMaybeAll
          pre :: (Generic t, GMaybeSameAll (Rep t) Any) => t -> MaybeSameAllRep (Rep t) Any
          pre = gMaybeSameAll . from

Многое из этого довольно некрасиво; есть ли у кого-нибудь идеи получше?

output = combine testList
-- = Test 1 Nothing (Just 2) Nothing (Just "t22"), as desired
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...