简体   繁体   中英

How to use GHC Generics or Data.Data on a list of Data to merge fields on a certain criteria?

I have data that looks like this:

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]

I would like to consolidate testList into one Test. I know the id is the same for all the Tests. The way I want to merge the Tests is that if for one field they all have the same value or Nothing, be that value, else if there exist different values make that field Nothing. An example would be:

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")

I understand how i would do this with two values, but I need to perform it on a list. Also my real data has 20+ records and multiple versions so I would like to use Generics.

Header stuff:

{-# 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)

Let's use this this thing from a previous answer:

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

We can inject Maybe into Same :

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

and we can collapse the other way:

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

Let's apply both to every field within a generic representation:

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

And so, everything boils down to just converting and combining:

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

A lot of this is rather ugly; does anyone have any better ideas?

output = combine testList
-- = Test 1 Nothing (Just 2) Nothing (Just "t22"), as desired

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM