unification-fd icon indicating copy to clipboard operation
unification-fd copied to clipboard

Deriving Unifiable with Generic1

Open expipiplus1 opened this issue 3 years ago • 0 comments

I've written some code making it possible to deriving Unifiable instances using Generic1 from GHC.Generics. How maintained is this repo, i.e. if I make a PR will it see the light of day on Hackage (modulo the code being acceptable of course)?

zipMatchViaGeneric
  :: (Generic1 t, GUnifiable (Rep1 t))
  => t a
  -> t a
  -> Maybe (t (Either a (a, a)))
zipMatchViaGeneric l r = to1 <$> gZipMatch (from1 l) (from1 r)

class (Traversable t, Generic1 t) => GUnifiable t where
  gZipMatch :: t a -> t a -> Maybe (t (Either a (a,a)))

instance GUnifiable t => GUnifiable (M1 m i t) where
  gZipMatch (M1 l) (M1 r) = M1 <$> gZipMatch l r

instance GUnifiable U1 where
  gZipMatch _ _ = Just U1

instance Eq c => GUnifiable (K1 m c) where
  gZipMatch (K1 l) (K1 r) | l == r    = Just (K1 l)
                          | otherwise = Nothing

instance GUnifiable Par1 where
  gZipMatch (Par1 l) (Par1 r) = Just . Par1 . Right $ (l, r)

instance Unifiable x => GUnifiable (Rec1 x) where
  gZipMatch (Rec1 l) (Rec1 r) = Rec1 <$> zipMatch l r

instance (GUnifiable l, GUnifiable r) => GUnifiable (l :+: r) where
  gZipMatch (L1 l) (L1 r) = L1 <$> gZipMatch l r
  gZipMatch (R1 l) (R1 r) = R1 <$> gZipMatch l r
  gZipMatch _      _      = Nothing

instance (GUnifiable l, GUnifiable r) => GUnifiable (l :*: r) where
  gZipMatch (l1 :*: r1) (l2 :*: r2) =
    (:*:) <$> gZipMatch l1 l2 <*> gZipMatch r1 r2

instance (Unifiable a, GUnifiable b) => GUnifiable (a :.: b) where
  gZipMatch (Comp1 l) (Comp1 r) = do
    x <- zipMatch l r >>= traverse
      (\case
        Left  a        -> Just $ Left <$> a
        Right (a1, a2) -> gZipMatch a1 a2
      )
    pure (Comp1 x)

expipiplus1 avatar Oct 23 '20 02:10 expipiplus1