never executed always true always false

    1 {-# LANGUAGE BangPatterns #-}
    2 {-# OPTIONS_GHC -fno-warn-orphans #-}
    3 module Distribution.Client.Compat.Orphans () where
    4 
    5 import Control.Exception             (SomeException)
    6 import Distribution.Compat.Binary    (Binary (..))
    7 import Distribution.Compat.Typeable  (typeRep)
    8 import Distribution.Utils.Structured (Structure (Nominal), Structured (..))
    9 import Network.URI                   (URI (..), URIAuth (..))
   10 import 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
   18 instance 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 
   23 instance Structured URI where
   24     structure p = Nominal (typeRep p) 0 "URI" []
   25 
   26 instance 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
   36 instance Binary SomeException where
   37     put _ = return ()
   38     get = error "cannot serialise exceptions"
   39 
   40 instance Structured SomeException where
   41     structure p = Nominal (typeRep p) 0 "SomeException" []