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