{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Safe #-}
module Data.Generics.Is.Internal (
   -- * Getting return types from functions
   Constructs
  ,construct

   -- | An instance of @Rebase' a b@ exists if and only if @Base a ~ b@.
   -- 
   --   By giving this information to the typechecker as a constraint, it can
   --   agressively unify type variables, thus avoiding ambiguity when
   --   working with polymorphic types.
   --
   --   >>> imports Data.Generics.Is.Generic
   --   
   --   >>> is Just Nothing
   --   False
   -- 
   --   >>> is (:) [1,2,3]
   --   True
   
  ,Base
  ,Rebase(..)

   -- | Defines 'Generic' equality on the head constructor.
  ,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 }