{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}

module Data.Extend.Internal where

import Control.Applicative
import GHC.Generics


class GExtend a where
   gExtend :: a p -> a p -> a p


instance (GExtend (K1 i (m a)), Alternative m, GExtend b) => GExtend (K1 i (m a) :*: b) where
   gExtend (K1 a1 :*: b1) (K1 a2 :*: b2) = K1 (a1 <|> a2) :*: gExtend b1 b2

instance GExtend U1 where
   gExtend _ _ = U1

instance (Extend a) => GExtend (K1 i a) where
   gExtend (K1 a) (K1 b) = K1 $ extend a b

instance (GExtend a, GExtend b) => GExtend (a :*: b) where
   gExtend (a1 :*: b1) (a2 :*: b2) = gExtend a1 a2 :*: gExtend b1 b2

instance (GExtend a, GExtend b) => GExtend (a :+: b) where
   gExtend (L1 a) (L1 b) = L1 $ gExtend a b
   gExtend (R1 a) (R1 b) = R1 $ gExtend a b
   gExtend a _ = a

instance (GExtend a) => GExtend (M1 i c a) where
   gExtend (M1 a) (M1 b) = M1 $ gExtend a b


class Extend a where
   -- | By default
   --
   -- prop>  a `extend` b = a
   --
   -- prop> Nothing `extend` Just a = Just a
   --
   -- To use the "Extend" class, simply make your data derive Generic.
   --
   -- If "a" is a user defined data type, then all "Nothing" fields of "a" are replaced by corresponding fields in "b",
   --
   -- ie, all "Just" fields in "a" will override corresponding fields in "b".
   extend :: a -> a -> a
   default extend :: (Generic a, GExtend (Rep a)) => a -> a -> a
   extend a b = to $ gExtend (from a) (from b)


instance (Extend a) => Extend (Maybe a) where
   -- | Nothing `extend` Just b = Just b
   -- (Just a) `extend` (Just b) = Just a
   extend (Just a) _ = Just a
   extend Nothing  b = b

instance {-# OVERLAPPABLE #-} Extend a where
   -- | By default a `extend` b is a
   extend a _ = a