Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Deriving Unifiable with Generic1 #12

Open
expipiplus1 opened this issue Oct 23, 2020 · 0 comments
Open

Deriving Unifiable with Generic1 #12

expipiplus1 opened this issue Oct 23, 2020 · 0 comments

Comments

@expipiplus1
Copy link

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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant