1{-# LANGUAGE BangPatterns #-} 2{-# OPTIONS_GHC -fno-warn-orphans #-} 3module Distribution.Client.Compat.Orphans () where 4 5import Control.Exception (SomeException) 6import Distribution.Compat.Binary (Binary (..)) 7import Distribution.Compat.Typeable (typeRep) 8import Distribution.Utils.Structured (Structure (Nominal), Structured (..)) 9import Network.URI (URI (..), URIAuth (..)) 10import Prelude (error, return) 11 12------------------------------------------------------------------------------- 13-- network-uri 14------------------------------------------------------------------------------- 15 16-- note, network-uri-2.6.0.3+ provide a Generic instance but earlier 17-- versions do not, so we use manual Binary instances here 18instance Binary URI where 19 put (URI a b c d e) = do put a; put b; put c; put d; put e 20 get = do !a <- get; !b <- get; !c <- get; !d <- get; !e <- get 21 return (URI a b c d e) 22 23instance Structured URI where 24 structure p = Nominal (typeRep p) 0 "URI" [] 25 26instance Binary URIAuth where 27 put (URIAuth a b c) = do put a; put b; put c 28 get = do !a <- get; !b <- get; !c <- get; return (URIAuth a b c) 29 30------------------------------------------------------------------------------- 31-- base 32------------------------------------------------------------------------------- 33 34--FIXME: Duncan Coutts: this is a total cheat 35--Added in 46aa019ec85e313e257d122a3549cce01996c566 36instance Binary SomeException where 37 put _ = return () 38 get = error "cannot serialise exceptions" 39 40instance Structured SomeException where 41 structure p = Nominal (typeRep p) 0 "SomeException" [] 42