{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Distribution.Client.Compat.Orphans () where

import Control.Exception             (SomeException)
import Distribution.Compat.Binary    (Binary (..))
import Distribution.Compat.Typeable  (typeRep)
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 -> Put
put (URI String
a Maybe URIAuth
b String
c String
d String
e) = do forall t. Binary t => t -> Put
put String
a; forall t. Binary t => t -> Put
put Maybe URIAuth
b; forall t. Binary t => t -> Put
put String
c; forall t. Binary t => t -> Put
put String
d; forall t. Binary t => t -> Put
put String
e
  get :: Get URI
get = do !String
a <- forall t. Binary t => Get t
get; !Maybe URIAuth
b <- forall t. Binary t => Get t
get; !String
c <- forall t. Binary t => Get t
get; !String
d <- forall t. Binary t => Get t
get; !String
e <- forall t. Binary t => Get t
get
           forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe URIAuth -> String -> String -> String -> URI
URI String
a Maybe URIAuth
b String
c String
d String
e)

instance Structured URI where
    structure :: Proxy URI -> Structure
structure Proxy URI
p = TypeRep -> TypeVersion -> String -> [Structure] -> Structure
Nominal (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy URI
p) TypeVersion
0 String
"URI" []

instance Binary URIAuth where
    put :: URIAuth -> Put
put (URIAuth String
a String
b String
c) = do forall t. Binary t => t -> Put
put String
a; forall t. Binary t => t -> Put
put String
b; forall t. Binary t => t -> Put
put String
c
    get :: Get URIAuth
get = do !String
a <- forall t. Binary t => Get t
get; !String
b <- forall t. Binary t => Get t
get; !String
c <- forall t. Binary t => Get t
get; forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String -> String -> URIAuth
URIAuth String
a String
b String
c)

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

--FIXME: Duncan Coutts: this is a total cheat
--Added in 46aa019ec85e313e257d122a3549cce01996c566
instance Binary SomeException where
    put :: SomeException -> Put
put SomeException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    get :: Get SomeException
get = forall a. HasCallStack => String -> a
error String
"cannot serialise exceptions"

instance Structured SomeException where
    structure :: Proxy SomeException -> Structure
structure Proxy SomeException
p = TypeRep -> TypeVersion -> String -> [Structure] -> Structure
Nominal (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy SomeException
p) TypeVersion
0 String
"SomeException" []