{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings, StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
module Debian.Orphans where
import Data.Function (on)
import Data.Generics (Data, Typeable)
import Data.List (intersperse, isPrefixOf)
import Data.Maybe (fromMaybe)
import Debian.Changes (ChangeLog(..), ChangeLogEntry(..))
import Debian.Pretty (PP(PP, unPP))
import Debian.Relation (ArchitectureReq(..), Relation(..), VersionReq(..))
import Distribution.Compiler (CompilerId(..))
import Distribution.Compiler (AbiTag(..))
import Distribution.License (License(..))
import Distribution.PackageDescription (Executable(..), PackageDescription(package))
import Distribution.Pretty (prettyShow)
import Distribution.Simple.Compiler (Compiler(..))
import Distribution.Version (cataVersionRange, normaliseVersionRange, VersionRange(..), VersionRangeF(..))
import Distribution.Version (Version)
import Language.Haskell.Extension (Language(..))
import Network.URI (URI)
import Text.Parsec.Rfc2822 (NameAddr(..))
import Text.PrettyPrint.HughesPJ (Doc)
import Text.PrettyPrint.HughesPJClass (hcat, text)
import Distribution.Pretty (Pretty(pretty))
deriving instance Typeable Compiler
deriving instance Typeable CompilerId
deriving instance Typeable AbiTag
deriving instance Data AbiTag
deriving instance Ord AbiTag
deriving instance Data Compiler
deriving instance Data CompilerId
deriving instance Ord Language
deriving instance Ord Compiler
deriving instance Ord NameAddr
deriving instance Ord License
instance Ord Executable where
compare :: Executable -> Executable -> Ordering
compare = UnqualComponentName -> UnqualComponentName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (UnqualComponentName -> UnqualComponentName -> Ordering)
-> (Executable -> UnqualComponentName)
-> Executable
-> Executable
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Executable -> UnqualComponentName
exeName
instance Ord PackageDescription where
compare :: PackageDescription -> PackageDescription -> Ordering
compare = PackageIdentifier -> PackageIdentifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PackageIdentifier -> PackageIdentifier -> Ordering)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> PackageDescription
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PackageDescription -> PackageIdentifier
package
dropPrefix :: String -> String -> Maybe String
dropPrefix :: String -> String -> Maybe String
dropPrefix String
p String
s = if String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
p String
s then String -> Maybe String
forall a. a -> Maybe a
Just (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p) String
s) else Maybe String
forall a. Maybe a
Nothing
deriving instance Data ArchitectureReq
deriving instance Data ChangeLog
deriving instance Data ChangeLogEntry
deriving instance Data Relation
deriving instance Data VersionReq
deriving instance Typeable ArchitectureReq
deriving instance Typeable ChangeLog
deriving instance Typeable ChangeLogEntry
deriving instance Typeable Relation
deriving instance Typeable VersionReq
deriving instance Ord ChangeLog
deriving instance Ord ChangeLogEntry
instance Pretty (PP License) where
pretty :: PP License -> Doc
pretty (PP (GPL Maybe Version
_)) = String -> Doc
text String
"GPL"
pretty (PP (LGPL Maybe Version
_)) = String -> Doc
text String
"LGPL"
pretty (PP License
BSD3) = String -> Doc
text String
"BSD"
pretty (PP License
BSD4) = String -> Doc
text String
"BSD-like"
pretty (PP License
PublicDomain) = String -> Doc
text String
"Public Domain"
pretty (PP License
AllRightsReserved) = String -> Doc
text String
"Proprietary"
pretty (PP License
OtherLicense) = String -> Doc
text String
"Non-distributable"
pretty (PP License
MIT) = String -> Doc
text String
"MIT"
pretty (PP (UnknownLicense String
_)) = String -> Doc
text String
"Unknown"
pretty (PP License
x) = String -> Doc
text (License -> String
forall a. Show a => a -> String
show License
x)
deriving instance Data NameAddr
deriving instance Typeable NameAddr
deriving instance Read NameAddr
instance Pretty (PP NameAddr) where
pretty :: PP NameAddr -> Doc
pretty (PP NameAddr
x) = String -> Doc
text (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (NameAddr -> String
nameAddr_addr NameAddr
x) (NameAddr -> Maybe String
nameAddr_name NameAddr
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NameAddr -> String
nameAddr_addr NameAddr
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">")
instance Pretty (PP [NameAddr]) where
pretty :: PP [NameAddr] -> Doc
pretty = [Doc] -> Doc
hcat ([Doc] -> Doc) -> (PP [NameAddr] -> [Doc]) -> PP [NameAddr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
", ") ([Doc] -> [Doc])
-> (PP [NameAddr] -> [Doc]) -> PP [NameAddr] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameAddr -> Doc) -> [NameAddr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PP NameAddr -> Doc
forall a. Pretty a => a -> Doc
pretty (PP NameAddr -> Doc)
-> (NameAddr -> PP NameAddr) -> NameAddr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameAddr -> PP NameAddr
forall a. a -> PP a
PP) ([NameAddr] -> [Doc])
-> (PP [NameAddr] -> [NameAddr]) -> PP [NameAddr] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP [NameAddr] -> [NameAddr]
forall a. PP a -> a
unPP
instance Pretty (PP VersionRange) where
pretty :: PP VersionRange -> Doc
pretty (PP VersionRange
range) = ((VersionRangeF Doc -> Doc) -> VersionRange -> Doc
forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange VersionRangeF Doc -> Doc
prettyRange (VersionRange -> Doc)
-> (VersionRange -> VersionRange) -> VersionRange -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionRange
normaliseVersionRange) VersionRange
range
prettyRange :: VersionRangeF Text.PrettyPrint.HughesPJ.Doc -> Text.PrettyPrint.HughesPJ.Doc
#if !MIN_VERSION_Cabal(3,4,0)
prettyRange :: VersionRangeF Doc -> Doc
prettyRange VersionRangeF Doc
AnyVersionF = (String -> Doc
text String
"*")
#endif
prettyRange (ThisVersionF Version
v) = String -> Doc
text String
"=" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP Version -> Doc
forall a. Pretty a => a -> Doc
pretty (Version -> PP Version
forall a. a -> PP a
PP Version
v)
prettyRange (LaterVersionF Version
v) = String -> Doc
text String
">" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP Version -> Doc
forall a. Pretty a => a -> Doc
pretty (Version -> PP Version
forall a. a -> PP a
PP Version
v)
prettyRange (EarlierVersionF Version
v) = String -> Doc
text String
"<" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP Version -> Doc
forall a. Pretty a => a -> Doc
pretty (Version -> PP Version
forall a. a -> PP a
PP Version
v)
prettyRange (OrLaterVersionF Version
v) = String -> Doc
text String
">=" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP Version -> Doc
forall a. Pretty a => a -> Doc
pretty (Version -> PP Version
forall a. a -> PP a
PP Version
v)
prettyRange (OrEarlierVersionF Version
v) = String -> Doc
text String
"<=" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP Version -> Doc
forall a. Pretty a => a -> Doc
pretty (Version -> PP Version
forall a. a -> PP a
PP Version
v)
#if !MIN_VERSION_Cabal(3,4,0)
prettyRange (WildcardVersionF Version
v) = String -> Doc
text String
"=" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP Version -> Doc
forall a. Pretty a => a -> Doc
pretty (Version -> PP Version
forall a. a -> PP a
PP Version
v) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
".*"
#endif
prettyRange (MajorBoundVersionF Version
v) = String -> Doc
text String
" >= " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP Version -> Doc
forall a. Pretty a => a -> Doc
pretty (Version -> PP Version
forall a. a -> PP a
PP Version
v)
prettyRange (UnionVersionRangesF Doc
v1 Doc
v2) = String -> Doc
text String
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
v1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" || " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
v2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
prettyRange (IntersectVersionRangesF Doc
v1 Doc
v2) = String -> Doc
text String
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
v1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" && " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
v2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
#if !MIN_VERSION_Cabal(3,4,0)
prettyRange (VersionRangeParensF Doc
v) = String -> Doc
text String
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
#endif
instance Pretty (PP Version) where
pretty :: PP Version -> Doc
pretty = String -> Doc
text (String -> Doc) -> (PP Version -> String) -> PP Version -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
forall a. Pretty a => a -> String
prettyShow (Version -> String)
-> (PP Version -> Version) -> PP Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP Version -> Version
forall a. PP a -> a
unPP
instance Pretty (PP URI) where
pretty :: PP URI -> Doc
pretty = String -> Doc
text (String -> Doc) -> (PP URI -> String) -> PP URI -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show (URI -> String) -> (PP URI -> URI) -> PP URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP URI -> URI
forall a. PP a -> a
unPP