{-# 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 = forall a. Ord a => a -> a -> Ordering
compare 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 = forall a. Ord a => a -> a -> Ordering
compare 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 forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
p String
s then forall a. a -> Maybe a
Just (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p) String
s) else 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 (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 (forall a. a -> Maybe a -> a
fromMaybe (NameAddr -> String
nameAddr_addr NameAddr
x) (NameAddr -> Maybe String
nameAddr_name NameAddr
x) forall a. [a] -> [a] -> [a]
++ String
" <" forall a. [a] -> [a] -> [a]
++ NameAddr -> String
nameAddr_addr NameAddr
x 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
", ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> PP a
PP) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PP a -> a
unPP

instance Pretty (PP VersionRange) where
    pretty :: PP VersionRange -> Doc
pretty (PP VersionRange
range) = (forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange VersionRangeF Doc -> Doc
prettyRange 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 AnyVersionF                     = (text "*")
#endif
prettyRange :: VersionRangeF Doc -> Doc
prettyRange (ThisVersionF Version
v)                = String -> Doc
text String
"=" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP Version
v)
prettyRange (LaterVersionF Version
v)               = String -> Doc
text String
">" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP Version
v)
prettyRange (EarlierVersionF Version
v)             = String -> Doc
text String
"<" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP Version
v)
prettyRange (OrLaterVersionF Version
v)             = String -> Doc
text String
">=" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP Version
v)
prettyRange (OrEarlierVersionF Version
v)           = String -> Doc
text String
"<=" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP Version
v)
#if !MIN_VERSION_Cabal(3,4,0)
prettyRange (WildcardVersionF v)            = text "=" <> pretty (PP v) <> text ".*" -- not exactly right
#endif
prettyRange (MajorBoundVersionF Version
v)          = String -> Doc
text String
" >= " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP Version
v) -- maybe this will do?
prettyRange (UnionVersionRangesF Doc
v1 Doc
v2)     = String -> Doc
text String
"(" forall a. Semigroup a => a -> a -> a
<> Doc
v1 forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" || " forall a. Semigroup a => a -> a -> a
<> Doc
v2 forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
prettyRange (IntersectVersionRangesF Doc
v1 Doc
v2) = String -> Doc
text String
"(" forall a. Semigroup a => a -> a -> a
<> Doc
v1 forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" && " forall a. Semigroup a => a -> a -> a
<> Doc
v2 forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
#if !MIN_VERSION_Cabal(3,4,0)
prettyRange (VersionRangeParensF v)         = text "(" <> v <> text ")"
#endif

instance Pretty (PP Version) where
    pretty :: PP Version -> Doc
pretty = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PP a -> a
unPP

instance Pretty (PP URI) where
    pretty :: PP URI -> Doc
pretty = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PP a -> a
unPP