{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Safe #-}
module Data.Generics.Is.Internal (
Constructs
,construct
,Base
,Rebase(..)
,EqHead(..)
) where
import GHC.Generics
class Rebase c a where
rebase :: c -> a
instance (Rebase c c) where
rebase = id
instance (Rebase b c) => Rebase (a -> b) c where
rebase c = rebase (c (error "Data.Generics.Is.Internal#rebase"))
type family Base b where
Base (a -> b) = Base b
Base b = b
type Constructs a b = (Rebase a b, Base a ~ b)
construct :: (Constructs a b) => a -> b
construct = rebase
class EqHead f where
eqH :: f a -> f a -> Bool
instance EqHead V1 where
eqH _ = const True
instance EqHead U1 where
eqH _ = const True
instance EqHead (f :*: g) where
eqH _ = const True
instance EqHead (K1 i c) where
eqH _ = const True
instance (EqHead f) => EqHead (M1 i t f) where
eqH (M1 x) = let r = eqH x in \(M1 y) -> r y
instance (EqHead f, EqHead g) => EqHead (f :+: g) where
eqH (L1 x) = let r = eqH x in \case { (L1 y) -> r y; _ -> False }
eqH (R1 x) = let r = eqH x in \case { (R1 y) -> r y; _ -> False }