{-# 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

-- Convert from license to RPM-friendly description.  The strings are
-- taken from TagsCheck.py in the rpmlint distribution.
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

-- This Pretty instance gives a string used to create a valid
-- changelog entry, it *must* have a name followed by an email address
-- in angle brackets.
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
">")
    -- pretty x = text (maybe (nameAddr_addr x) (\ n -> n ++ " <" ++ nameAddr_addr x ++ ">") (nameAddr_name x))

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
".*" -- not exactly right
#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) -- maybe this will do?
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