{-# OPTIONS_GHC -fno-warn-orphans #-}
{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Defines a /pickler/ for 'Either'.
-}

module BishBosh.Data.Either(
-- * Functions
	xpickle
) where

import			Control.Arrow((|||))
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

{-
-- CAVEAT: Introduced into 'HXT-9.3.1.21'.
instance (HXT.XmlPickler l, HXT.XmlPickler r) => HXT.XmlPickler (Either l r) where
	xpickle	= xpickle HXT.xpickle HXT.xpickle
-}

-- | Pickler for an arbitrary datum of type 'Either'.
xpickle :: HXT.PU l -> HXT.PU r -> HXT.PU (Either l r)
xpickle :: PU l -> PU r -> PU (Either l r)
xpickle PU l
lPickler PU r
rPickler	= (Either l r -> Int) -> [PU (Either l r)] -> PU (Either l r)
forall a. (a -> Int) -> [PU a] -> PU a
HXT.xpAlt (
	Int -> l -> Int
forall a b. a -> b -> a
const Int
0 (l -> Int) -> (r -> Int) -> Either l r -> Int
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Int -> r -> Int
forall a b. a -> b -> a
const Int
1	-- Index into the subsequent pickler-list.
 ) [
	(l -> Either l r, Either l r -> l) -> PU l -> PU (Either l r)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		l -> Either l r
forall a b. a -> Either a b
Left,		-- Construct.
		\(Left l
l) -> l
l	-- Deconstruct.
	) PU l
lPickler,
	(r -> Either l r, Either l r -> r) -> PU r -> PU (Either l r)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		r -> Either l r
forall a b. b -> Either a b
Right,		-- Construct.
		\(Right r
r) -> r
r	-- Deconstruct.
	) PU r
rPickler
 ]