Orphans.hs

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Distribution.Client.Compat.Orphans () where

import Control.Exception (SomeException)
import Data.Typeable (typeRep)
import Distribution.Compat.Binary (Binary (..))
import Distribution.Utils.Structured (Structure (Nominal), Structured (..))
import Network.URI (URI (..), URIAuth (..))
import Prelude (error, return)

-------------------------------------------------------------------------------
-- network-uri
-------------------------------------------------------------------------------

-- note, network-uri-2.6.0.3+ provide a Generic instance but earlier
-- versions do not, so we use manual Binary instances here
instance Binary URI where
  put (URI a b c d e) = do put a; put b; put c; put d; put e
  get = do
    !a <- get
    !b <- get
    !c <- get
    !d <- get
    !e <- get
    return (URI a b c d e)

instance Structured URI where
  structure p = Nominal (typeRep p) 0 "URI" []

instance Binary URIAuth where
  put (URIAuth a b c) = do put a; put b; put c
  get = do !a <- get; !b <- get; !c <- get; return (URIAuth a b c)

-------------------------------------------------------------------------------
-- base
-------------------------------------------------------------------------------

-- FIXME: Duncan Coutts: this is a total cheat
-- Added in 46aa019ec85e313e257d122a3549cce01996c566
instance Binary SomeException where
  put _ = return ()
  get = error "cannot serialise exceptions"

instance Structured SomeException where
  structure p = Nominal (typeRep p) 0 "SomeException" []