Either.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Language.LOL.Typing.Constraint.Either where

import Data.Either (Either(..), either)
import Data.Function (($), (.))
import Data.Functor (Functor(..))
import Data.Text.Buildable (Buildable(..))
import Text.Show (Show(..))

import Language.LOL.Typing.Type
import Language.LOL.Typing.Solver

-- ** Type 'Constraint_Either'

newtype Constraint_Either f g info
 =      Constraint_Either (Either (f info) (g info))
 deriving (Show)

instance
 ( Buildable (f info)
 , Buildable (g info)
 ) => Buildable (Constraint_Either f g info) where
	build (Constraint_Either x) = either build build x
instance
 ( Functor f
 , Functor g
 ) => Functor (Constraint_Either f g) where
	fmap f (Constraint_Either x) =
		Constraint_Either $
		either (Left . fmap f) (Right . fmap f) x
instance
 ( Substitutable (f info)
 , Substitutable (g info)
 ) => Substitutable (Constraint_Either f g info) where
	subvars (Constraint_Either x) = either subvars subvars x
	substitute sub (Constraint_Either x) =
		Constraint_Either $
		either
		 (Left  . (sub `substitute`))
		 (Right . (sub `substitute`))
		 x
instance
 ( Solvable (f info) m
 , Solvable (g info) m
 ) => Solvable (Constraint_Either f g info) m where
	constraint_solver (Constraint_Either x) = either constraint_solver constraint_solver x
	constraint_checker (Constraint_Either x) = either constraint_checker constraint_checker x