{-# 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 ]