-- | Code pulled out of cabal-debian that straightforwardly implements
-- parts of the Debian policy manual, or other bits of Linux standards.
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, OverloadedStrings #-}
module Debian.Policy
    ( -- * Paths
      databaseDirectory
    , dataDirectory
    , apacheLogDirectory
    , apacheErrorLog
    , apacheAccessLog
    , serverLogDirectory
    , serverAppLog
    , serverAccessLog
    , errorLogBaseName
    , appLogBaseName
    , accessLogBaseName
    -- * Installed packages
    , debianPackageVersion
    , getDebhelperCompatLevel
    , StandardsVersion(..)
    , getDebianStandardsVersion
    , parseStandardsVersion
    -- * Package fields
    , SourceFormat(..)
    , readSourceFormat
    , PackagePriority(..)
    , readPriority
    , PackageArchitectures(..)
    , parsePackageArchitectures
    , Section(..)
    , readSection
    , MultiArch(..)
    , readMultiArch
    , Area(..)
    , parseUploaders
    , parseMaintainer
    , maintainerOfLastResort
    , getCurrentDebianUser
    , haskellMaintainer
    , License(..)
    , fromCabalLicense
    , toCabalLicense
    , readLicense
    ) where

import Codec.Binary.UTF8.String (decodeString)
import Control.Arrow (second)
import Control.Monad (mplus)
import Data.Char (isSpace, toLower)
import Data.Generics (Data, Typeable)
import Data.List (groupBy, intercalate)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (pack, strip, Text, unpack)
import Debian.Debianize.Prelude (read')
import Debian.Pretty (PP(..))
import Debian.Relation (BinPkgName)
import Debian.Version (DebianVersion, parseDebianVersion', version)
import qualified Distribution.License as Cabal (License(..))
import Distribution.Package (PackageIdentifier(pkgName))
import Distribution.PackageDescription (PackageDescription(package))
import Distribution.Text (display)
import System.Environment (getEnvironment)
import System.FilePath ((</>))
import System.Process (readProcess)
import Text.Parsec (parse)
import Text.Parsec.Rfc2822 (address, NameAddr(..))
import Text.PrettyPrint.HughesPJClass (text)
import Distribution.Pretty (Pretty(pretty))
import Text.Read (readMaybe)

databaseDirectory :: BinPkgName -> String
databaseDirectory :: BinPkgName -> [Char]
databaseDirectory BinPkgName
x = [Char]
"/srv" [Char] -> [Char] -> [Char]
</> forall a. Show a => a -> [Char]
show (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> PP a
PP forall a b. (a -> b) -> a -> b
$ BinPkgName
x)

dataDirectory :: PackageDescription -> String
dataDirectory :: PackageDescription -> [Char]
dataDirectory PackageDescription
pkgDesc = [Char]
"/usr/share" [Char] -> [Char] -> [Char]
</> PackageName -> [Char]
showPkgName (PackageIdentifier -> PackageName
pkgName (PackageDescription -> PackageIdentifier
package PackageDescription
pkgDesc))
    where
      -- Copied from Distribution.Simple.Build.PatsModule in Cabal
      showPkgName :: PackageName -> [Char]
showPkgName = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> [Char]
display
      fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
      fixchar Char
c   = Char
c

apacheLogDirectory :: BinPkgName -> String
apacheLogDirectory :: BinPkgName -> [Char]
apacheLogDirectory BinPkgName
x =  [Char]
"/var/log/apache2/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> PP a
PP forall a b. (a -> b) -> a -> b
$ BinPkgName
x)

apacheErrorLog :: BinPkgName -> String
apacheErrorLog :: BinPkgName -> [Char]
apacheErrorLog BinPkgName
x = BinPkgName -> [Char]
apacheLogDirectory BinPkgName
x [Char] -> [Char] -> [Char]
</> [Char]
errorLogBaseName

apacheAccessLog :: BinPkgName -> String
apacheAccessLog :: BinPkgName -> [Char]
apacheAccessLog BinPkgName
x = BinPkgName -> [Char]
apacheLogDirectory BinPkgName
x [Char] -> [Char] -> [Char]
</> [Char]
accessLogBaseName

serverLogDirectory :: BinPkgName -> String
serverLogDirectory :: BinPkgName -> [Char]
serverLogDirectory BinPkgName
x = [Char]
"/var/log/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> PP a
PP forall a b. (a -> b) -> a -> b
$ BinPkgName
x)

serverAppLog :: BinPkgName -> String
serverAppLog :: BinPkgName -> [Char]
serverAppLog BinPkgName
x = BinPkgName -> [Char]
serverLogDirectory BinPkgName
x [Char] -> [Char] -> [Char]
</> [Char]
appLogBaseName

serverAccessLog :: BinPkgName -> String
serverAccessLog :: BinPkgName -> [Char]
serverAccessLog BinPkgName
x = BinPkgName -> [Char]
serverLogDirectory BinPkgName
x [Char] -> [Char] -> [Char]
</> [Char]
accessLogBaseName

appLogBaseName :: String
appLogBaseName :: [Char]
appLogBaseName = [Char]
"app.log"

errorLogBaseName :: String
errorLogBaseName :: [Char]
errorLogBaseName = [Char]
"error.log"

accessLogBaseName :: String
accessLogBaseName :: [Char]
accessLogBaseName = [Char]
"access.log"

debianPackageVersion :: String -> IO (Maybe DebianVersion)
debianPackageVersion :: [Char] -> IO (Maybe DebianVersion)
debianPackageVersion [Char]
name =
    [Char] -> [[Char]] -> [Char] -> IO [Char]
readProcess [Char]
"dpkg-query" [[Char]
"--show", [Char]
"--showformat=${version}", [Char]
name] [Char]
"" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {string}.
(Eq string, IsString string, ParseDebianVersion string) =>
string -> Maybe DebianVersion
parseDebianVersion''
    where
      -- This should maybe be the real parseDebianVersion
      parseDebianVersion'' :: string -> Maybe DebianVersion
parseDebianVersion'' string
"" = forall a. Maybe a
Nothing
      parseDebianVersion'' string
s = forall a. a -> Maybe a
Just (forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' string
s)

-- | With the current state of CDBS, anything above 10 breaks, so
-- for now we force this to 10.
getDebhelperCompatLevel :: IO (Maybe Int)
getDebhelperCompatLevel :: IO (Maybe Int)
getDebhelperCompatLevel = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Int
10)

data StandardsVersion = StandardsVersion Int Int Int (Maybe Int) deriving (StandardsVersion -> StandardsVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StandardsVersion -> StandardsVersion -> Bool
$c/= :: StandardsVersion -> StandardsVersion -> Bool
== :: StandardsVersion -> StandardsVersion -> Bool
$c== :: StandardsVersion -> StandardsVersion -> Bool
Eq, Eq StandardsVersion
StandardsVersion -> StandardsVersion -> Bool
StandardsVersion -> StandardsVersion -> Ordering
StandardsVersion -> StandardsVersion -> StandardsVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StandardsVersion -> StandardsVersion -> StandardsVersion
$cmin :: StandardsVersion -> StandardsVersion -> StandardsVersion
max :: StandardsVersion -> StandardsVersion -> StandardsVersion
$cmax :: StandardsVersion -> StandardsVersion -> StandardsVersion
>= :: StandardsVersion -> StandardsVersion -> Bool
$c>= :: StandardsVersion -> StandardsVersion -> Bool
> :: StandardsVersion -> StandardsVersion -> Bool
$c> :: StandardsVersion -> StandardsVersion -> Bool
<= :: StandardsVersion -> StandardsVersion -> Bool
$c<= :: StandardsVersion -> StandardsVersion -> Bool
< :: StandardsVersion -> StandardsVersion -> Bool
$c< :: StandardsVersion -> StandardsVersion -> Bool
compare :: StandardsVersion -> StandardsVersion -> Ordering
$ccompare :: StandardsVersion -> StandardsVersion -> Ordering
Ord, Int -> StandardsVersion -> [Char] -> [Char]
[StandardsVersion] -> [Char] -> [Char]
StandardsVersion -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [StandardsVersion] -> [Char] -> [Char]
$cshowList :: [StandardsVersion] -> [Char] -> [Char]
show :: StandardsVersion -> [Char]
$cshow :: StandardsVersion -> [Char]
showsPrec :: Int -> StandardsVersion -> [Char] -> [Char]
$cshowsPrec :: Int -> StandardsVersion -> [Char] -> [Char]
Show, Typeable StandardsVersion
StandardsVersion -> DataType
StandardsVersion -> Constr
(forall b. Data b => b -> b)
-> StandardsVersion -> StandardsVersion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> StandardsVersion -> u
forall u. (forall d. Data d => d -> u) -> StandardsVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StandardsVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StandardsVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StandardsVersion -> m StandardsVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StandardsVersion -> m StandardsVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StandardsVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StandardsVersion -> c StandardsVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StandardsVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StandardsVersion)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StandardsVersion -> m StandardsVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StandardsVersion -> m StandardsVersion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StandardsVersion -> m StandardsVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StandardsVersion -> m StandardsVersion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StandardsVersion -> m StandardsVersion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StandardsVersion -> m StandardsVersion
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StandardsVersion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StandardsVersion -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> StandardsVersion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StandardsVersion -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StandardsVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StandardsVersion -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StandardsVersion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StandardsVersion -> r
gmapT :: (forall b. Data b => b -> b)
-> StandardsVersion -> StandardsVersion
$cgmapT :: (forall b. Data b => b -> b)
-> StandardsVersion -> StandardsVersion
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StandardsVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StandardsVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StandardsVersion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StandardsVersion)
dataTypeOf :: StandardsVersion -> DataType
$cdataTypeOf :: StandardsVersion -> DataType
toConstr :: StandardsVersion -> Constr
$ctoConstr :: StandardsVersion -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StandardsVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StandardsVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StandardsVersion -> c StandardsVersion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StandardsVersion -> c StandardsVersion
Data, Typeable)

instance Pretty (PP StandardsVersion) where
    pretty :: PP StandardsVersion -> Doc
pretty (PP (StandardsVersion Int
a Int
b Int
c (Just Int
d))) = [Char] -> Doc
text (forall a. Show a => a -> [Char]
show Int
a) forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"." forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (forall a. Show a => a -> [Char]
show Int
b) forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"." forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (forall a. Show a => a -> [Char]
show Int
c) forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"." forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (forall a. Show a => a -> [Char]
show Int
d)
    pretty (PP (StandardsVersion Int
a Int
b Int
c Maybe Int
Nothing)) = [Char] -> Doc
text (forall a. Show a => a -> [Char]
show Int
a) forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"." forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (forall a. Show a => a -> [Char]
show Int
b) forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"." forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (forall a. Show a => a -> [Char]
show Int
c)

-- | Assumes debian-policy is installed
getDebianStandardsVersion :: IO (Maybe StandardsVersion)
getDebianStandardsVersion :: IO (Maybe StandardsVersion)
getDebianStandardsVersion = [Char] -> IO (Maybe DebianVersion)
debianPackageVersion [Char]
"debian-policy" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> StandardsVersion
parseStandardsVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebianVersion -> [Char]
version)

parseStandardsVersion :: String -> StandardsVersion
parseStandardsVersion :: [Char] -> StandardsVersion
parseStandardsVersion [Char]
s =
    case forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= [Char]
".") (forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\ Char
a Char
b -> (Char
a forall a. Eq a => a -> a -> Bool
== Char
'.') forall a. Eq a => a -> a -> Bool
== (Char
b forall a. Eq a => a -> a -> Bool
== Char
'.')) [Char]
s) of
      ([Char]
a : [Char]
b : [Char]
c : [Char]
d : [[Char]]
_) -> Int -> Int -> Int -> Maybe Int -> StandardsVersion
StandardsVersion (forall a. Read a => ([Char] -> a) -> [Char] -> a
read' (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"StandardsVersion" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Char]
a)
                                              (forall a. Read a => ([Char] -> a) -> [Char] -> a
read' (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"StandardsVersion" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Char]
b)
                                              (forall a. Read a => ([Char] -> a) -> [Char] -> a
read' (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"StandardsVersion" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Char]
c)
                                              (forall a. a -> Maybe a
Just (forall a. Read a => ([Char] -> a) -> [Char] -> a
read' (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"StandardsVersion" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Char]
d))
      ([Char]
a : [Char]
b : [Char]
c : [[Char]]
_) -> Int -> Int -> Int -> Maybe Int -> StandardsVersion
StandardsVersion (forall a. Read a => ([Char] -> a) -> [Char] -> a
read' (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"StandardsVersion" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Char]
a)
                                          (forall a. Read a => ([Char] -> a) -> [Char] -> a
read' (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"StandardsVersion" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Char]
b)
                                          (forall a. Read a => ([Char] -> a) -> [Char] -> a
read' (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"StandardsVersion" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Char]
c) forall a. Maybe a
Nothing
      [[Char]]
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid Standards-Version string: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
s

data SourceFormat
    = Native3
    | Quilt3
    deriving (SourceFormat -> SourceFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceFormat -> SourceFormat -> Bool
$c/= :: SourceFormat -> SourceFormat -> Bool
== :: SourceFormat -> SourceFormat -> Bool
$c== :: SourceFormat -> SourceFormat -> Bool
Eq, Eq SourceFormat
SourceFormat -> SourceFormat -> Bool
SourceFormat -> SourceFormat -> Ordering
SourceFormat -> SourceFormat -> SourceFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourceFormat -> SourceFormat -> SourceFormat
$cmin :: SourceFormat -> SourceFormat -> SourceFormat
max :: SourceFormat -> SourceFormat -> SourceFormat
$cmax :: SourceFormat -> SourceFormat -> SourceFormat
>= :: SourceFormat -> SourceFormat -> Bool
$c>= :: SourceFormat -> SourceFormat -> Bool
> :: SourceFormat -> SourceFormat -> Bool
$c> :: SourceFormat -> SourceFormat -> Bool
<= :: SourceFormat -> SourceFormat -> Bool
$c<= :: SourceFormat -> SourceFormat -> Bool
< :: SourceFormat -> SourceFormat -> Bool
$c< :: SourceFormat -> SourceFormat -> Bool
compare :: SourceFormat -> SourceFormat -> Ordering
$ccompare :: SourceFormat -> SourceFormat -> Ordering
Ord, Int -> SourceFormat -> [Char] -> [Char]
[SourceFormat] -> [Char] -> [Char]
SourceFormat -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [SourceFormat] -> [Char] -> [Char]
$cshowList :: [SourceFormat] -> [Char] -> [Char]
show :: SourceFormat -> [Char]
$cshow :: SourceFormat -> [Char]
showsPrec :: Int -> SourceFormat -> [Char] -> [Char]
$cshowsPrec :: Int -> SourceFormat -> [Char] -> [Char]
Show, Typeable SourceFormat
SourceFormat -> DataType
SourceFormat -> Constr
(forall b. Data b => b -> b) -> SourceFormat -> SourceFormat
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourceFormat -> u
forall u. (forall d. Data d => d -> u) -> SourceFormat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFormat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFormat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFormat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceFormat -> c SourceFormat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceFormat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceFormat)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceFormat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceFormat -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SourceFormat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceFormat -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFormat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFormat -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFormat -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFormat -> r
gmapT :: (forall b. Data b => b -> b) -> SourceFormat -> SourceFormat
$cgmapT :: (forall b. Data b => b -> b) -> SourceFormat -> SourceFormat
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceFormat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceFormat)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceFormat)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceFormat)
dataTypeOf :: SourceFormat -> DataType
$cdataTypeOf :: SourceFormat -> DataType
toConstr :: SourceFormat -> Constr
$ctoConstr :: SourceFormat -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFormat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFormat
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceFormat -> c SourceFormat
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceFormat -> c SourceFormat
Data, Typeable)

instance Pretty (PP SourceFormat) where
    pretty :: PP SourceFormat -> Doc
pretty (PP SourceFormat
Quilt3) = [Char] -> Doc
text [Char]
"3.0 (quilt)\n"
    pretty (PP SourceFormat
Native3) = [Char] -> Doc
text [Char]
"3.0 (native)\n"

readSourceFormat :: Text -> Either Text SourceFormat
readSourceFormat :: Text -> Either Text SourceFormat
readSourceFormat Text
s =
    case () of
      ()
_ | Text -> Text
strip Text
s forall a. Eq a => a -> a -> Bool
== Text
"3.0 (native)" -> forall a b. b -> Either a b
Right SourceFormat
Native3
      ()
_ | Text -> Text
strip Text
s forall a. Eq a => a -> a -> Bool
== Text
"3.0 (quilt)" -> forall a b. b -> Either a b
Right SourceFormat
Quilt3
      ()
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid debian/source/format: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show (Text -> Text
strip Text
s))

data PackagePriority
    = Required
    | Important
    | Standard
    | Optional
    | Extra
    deriving (PackagePriority -> PackagePriority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackagePriority -> PackagePriority -> Bool
$c/= :: PackagePriority -> PackagePriority -> Bool
== :: PackagePriority -> PackagePriority -> Bool
$c== :: PackagePriority -> PackagePriority -> Bool
Eq, Eq PackagePriority
PackagePriority -> PackagePriority -> Bool
PackagePriority -> PackagePriority -> Ordering
PackagePriority -> PackagePriority -> PackagePriority
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackagePriority -> PackagePriority -> PackagePriority
$cmin :: PackagePriority -> PackagePriority -> PackagePriority
max :: PackagePriority -> PackagePriority -> PackagePriority
$cmax :: PackagePriority -> PackagePriority -> PackagePriority
>= :: PackagePriority -> PackagePriority -> Bool
$c>= :: PackagePriority -> PackagePriority -> Bool
> :: PackagePriority -> PackagePriority -> Bool
$c> :: PackagePriority -> PackagePriority -> Bool
<= :: PackagePriority -> PackagePriority -> Bool
$c<= :: PackagePriority -> PackagePriority -> Bool
< :: PackagePriority -> PackagePriority -> Bool
$c< :: PackagePriority -> PackagePriority -> Bool
compare :: PackagePriority -> PackagePriority -> Ordering
$ccompare :: PackagePriority -> PackagePriority -> Ordering
Ord, ReadPrec [PackagePriority]
ReadPrec PackagePriority
Int -> ReadS PackagePriority
ReadS [PackagePriority]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackagePriority]
$creadListPrec :: ReadPrec [PackagePriority]
readPrec :: ReadPrec PackagePriority
$creadPrec :: ReadPrec PackagePriority
readList :: ReadS [PackagePriority]
$creadList :: ReadS [PackagePriority]
readsPrec :: Int -> ReadS PackagePriority
$creadsPrec :: Int -> ReadS PackagePriority
Read, Int -> PackagePriority -> [Char] -> [Char]
[PackagePriority] -> [Char] -> [Char]
PackagePriority -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [PackagePriority] -> [Char] -> [Char]
$cshowList :: [PackagePriority] -> [Char] -> [Char]
show :: PackagePriority -> [Char]
$cshow :: PackagePriority -> [Char]
showsPrec :: Int -> PackagePriority -> [Char] -> [Char]
$cshowsPrec :: Int -> PackagePriority -> [Char] -> [Char]
Show, Typeable PackagePriority
PackagePriority -> DataType
PackagePriority -> Constr
(forall b. Data b => b -> b) -> PackagePriority -> PackagePriority
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PackagePriority -> u
forall u. (forall d. Data d => d -> u) -> PackagePriority -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackagePriority -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackagePriority -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackagePriority -> m PackagePriority
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackagePriority -> m PackagePriority
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackagePriority
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackagePriority -> c PackagePriority
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackagePriority)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackagePriority)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackagePriority -> m PackagePriority
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackagePriority -> m PackagePriority
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackagePriority -> m PackagePriority
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackagePriority -> m PackagePriority
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackagePriority -> m PackagePriority
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackagePriority -> m PackagePriority
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PackagePriority -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PackagePriority -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PackagePriority -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PackagePriority -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackagePriority -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackagePriority -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackagePriority -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackagePriority -> r
gmapT :: (forall b. Data b => b -> b) -> PackagePriority -> PackagePriority
$cgmapT :: (forall b. Data b => b -> b) -> PackagePriority -> PackagePriority
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackagePriority)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackagePriority)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackagePriority)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackagePriority)
dataTypeOf :: PackagePriority -> DataType
$cdataTypeOf :: PackagePriority -> DataType
toConstr :: PackagePriority -> Constr
$ctoConstr :: PackagePriority -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackagePriority
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackagePriority
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackagePriority -> c PackagePriority
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackagePriority -> c PackagePriority
Data, Typeable)

readPriority :: String -> PackagePriority
readPriority :: [Char] -> PackagePriority
readPriority [Char]
s =
    case Text -> [Char]
unpack (Text -> Text
strip ([Char] -> Text
pack [Char]
s)) of
      [Char]
"required" -> PackagePriority
Required
      [Char]
"important" -> PackagePriority
Important
      [Char]
"standard" -> PackagePriority
Standard
      [Char]
"optional" -> PackagePriority
Optional
      [Char]
"extra" -> PackagePriority
Extra
      [Char]
x -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid priority string: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
x

instance Pretty (PP PackagePriority) where
    pretty :: PP PackagePriority -> Doc
pretty = [Char] -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PP a -> a
unPP

-- | The architectures for which a binary deb can be built.
data PackageArchitectures
    = All            -- ^ The package is architecture independenct
    | Any            -- ^ The package can be built for any architecture
    | Names [String] -- ^ The list of suitable architectures
    deriving (ReadPrec [PackageArchitectures]
ReadPrec PackageArchitectures
Int -> ReadS PackageArchitectures
ReadS [PackageArchitectures]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackageArchitectures]
$creadListPrec :: ReadPrec [PackageArchitectures]
readPrec :: ReadPrec PackageArchitectures
$creadPrec :: ReadPrec PackageArchitectures
readList :: ReadS [PackageArchitectures]
$creadList :: ReadS [PackageArchitectures]
readsPrec :: Int -> ReadS PackageArchitectures
$creadsPrec :: Int -> ReadS PackageArchitectures
Read, PackageArchitectures -> PackageArchitectures -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageArchitectures -> PackageArchitectures -> Bool
$c/= :: PackageArchitectures -> PackageArchitectures -> Bool
== :: PackageArchitectures -> PackageArchitectures -> Bool
$c== :: PackageArchitectures -> PackageArchitectures -> Bool
Eq, Eq PackageArchitectures
PackageArchitectures -> PackageArchitectures -> Bool
PackageArchitectures -> PackageArchitectures -> Ordering
PackageArchitectures
-> PackageArchitectures -> PackageArchitectures
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageArchitectures
-> PackageArchitectures -> PackageArchitectures
$cmin :: PackageArchitectures
-> PackageArchitectures -> PackageArchitectures
max :: PackageArchitectures
-> PackageArchitectures -> PackageArchitectures
$cmax :: PackageArchitectures
-> PackageArchitectures -> PackageArchitectures
>= :: PackageArchitectures -> PackageArchitectures -> Bool
$c>= :: PackageArchitectures -> PackageArchitectures -> Bool
> :: PackageArchitectures -> PackageArchitectures -> Bool
$c> :: PackageArchitectures -> PackageArchitectures -> Bool
<= :: PackageArchitectures -> PackageArchitectures -> Bool
$c<= :: PackageArchitectures -> PackageArchitectures -> Bool
< :: PackageArchitectures -> PackageArchitectures -> Bool
$c< :: PackageArchitectures -> PackageArchitectures -> Bool
compare :: PackageArchitectures -> PackageArchitectures -> Ordering
$ccompare :: PackageArchitectures -> PackageArchitectures -> Ordering
Ord, Int -> PackageArchitectures -> [Char] -> [Char]
[PackageArchitectures] -> [Char] -> [Char]
PackageArchitectures -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [PackageArchitectures] -> [Char] -> [Char]
$cshowList :: [PackageArchitectures] -> [Char] -> [Char]
show :: PackageArchitectures -> [Char]
$cshow :: PackageArchitectures -> [Char]
showsPrec :: Int -> PackageArchitectures -> [Char] -> [Char]
$cshowsPrec :: Int -> PackageArchitectures -> [Char] -> [Char]
Show, Typeable PackageArchitectures
PackageArchitectures -> DataType
PackageArchitectures -> Constr
(forall b. Data b => b -> b)
-> PackageArchitectures -> PackageArchitectures
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PackageArchitectures -> u
forall u.
(forall d. Data d => d -> u) -> PackageArchitectures -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageArchitectures -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageArchitectures -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackageArchitectures -> m PackageArchitectures
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageArchitectures -> m PackageArchitectures
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageArchitectures
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PackageArchitectures
-> c PackageArchitectures
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageArchitectures)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageArchitectures)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageArchitectures -> m PackageArchitectures
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageArchitectures -> m PackageArchitectures
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageArchitectures -> m PackageArchitectures
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageArchitectures -> m PackageArchitectures
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackageArchitectures -> m PackageArchitectures
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackageArchitectures -> m PackageArchitectures
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PackageArchitectures -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PackageArchitectures -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> PackageArchitectures -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> PackageArchitectures -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageArchitectures -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageArchitectures -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageArchitectures -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageArchitectures -> r
gmapT :: (forall b. Data b => b -> b)
-> PackageArchitectures -> PackageArchitectures
$cgmapT :: (forall b. Data b => b -> b)
-> PackageArchitectures -> PackageArchitectures
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageArchitectures)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageArchitectures)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageArchitectures)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageArchitectures)
dataTypeOf :: PackageArchitectures -> DataType
$cdataTypeOf :: PackageArchitectures -> DataType
toConstr :: PackageArchitectures -> Constr
$ctoConstr :: PackageArchitectures -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageArchitectures
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageArchitectures
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PackageArchitectures
-> c PackageArchitectures
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PackageArchitectures
-> c PackageArchitectures
Data, Typeable)

instance Pretty (PP PackageArchitectures) where
    pretty :: PP PackageArchitectures -> Doc
pretty (PP PackageArchitectures
All) = [Char] -> Doc
text [Char]
"all"
    pretty (PP PackageArchitectures
Any) = [Char] -> Doc
text [Char]
"any"
    pretty (PP (Names [[Char]]
xs)) = [Char] -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " [[Char]]
xs

parsePackageArchitectures :: String -> PackageArchitectures
parsePackageArchitectures :: [Char] -> PackageArchitectures
parsePackageArchitectures [Char]
"all" = PackageArchitectures
All
parsePackageArchitectures [Char]
"any" = PackageArchitectures
Any
parsePackageArchitectures [Char]
s = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"FIXME: parsePackageArchitectures " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
s

data Section
    = MainSection String -- Equivalent to AreaSection Main s?
    | AreaSection Area String
    deriving (ReadPrec [Section]
ReadPrec Section
Int -> ReadS Section
ReadS [Section]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Section]
$creadListPrec :: ReadPrec [Section]
readPrec :: ReadPrec Section
$creadPrec :: ReadPrec Section
readList :: ReadS [Section]
$creadList :: ReadS [Section]
readsPrec :: Int -> ReadS Section
$creadsPrec :: Int -> ReadS Section
Read, Section -> Section -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c== :: Section -> Section -> Bool
Eq, Eq Section
Section -> Section -> Bool
Section -> Section -> Ordering
Section -> Section -> Section
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Section -> Section -> Section
$cmin :: Section -> Section -> Section
max :: Section -> Section -> Section
$cmax :: Section -> Section -> Section
>= :: Section -> Section -> Bool
$c>= :: Section -> Section -> Bool
> :: Section -> Section -> Bool
$c> :: Section -> Section -> Bool
<= :: Section -> Section -> Bool
$c<= :: Section -> Section -> Bool
< :: Section -> Section -> Bool
$c< :: Section -> Section -> Bool
compare :: Section -> Section -> Ordering
$ccompare :: Section -> Section -> Ordering
Ord, Int -> Section -> [Char] -> [Char]
[Section] -> [Char] -> [Char]
Section -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Section] -> [Char] -> [Char]
$cshowList :: [Section] -> [Char] -> [Char]
show :: Section -> [Char]
$cshow :: Section -> [Char]
showsPrec :: Int -> Section -> [Char] -> [Char]
$cshowsPrec :: Int -> Section -> [Char] -> [Char]
Show, Typeable Section
Section -> DataType
Section -> Constr
(forall b. Data b => b -> b) -> Section -> Section
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Section -> u
forall u. (forall d. Data d => d -> u) -> Section -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Section -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Section -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Section -> m Section
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Section -> m Section
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Section
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Section -> c Section
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Section)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Section)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Section -> m Section
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Section -> m Section
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Section -> m Section
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Section -> m Section
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Section -> m Section
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Section -> m Section
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Section -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Section -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Section -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Section -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Section -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Section -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Section -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Section -> r
gmapT :: (forall b. Data b => b -> b) -> Section -> Section
$cgmapT :: (forall b. Data b => b -> b) -> Section -> Section
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Section)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Section)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Section)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Section)
dataTypeOf :: Section -> DataType
$cdataTypeOf :: Section -> DataType
toConstr :: Section -> Constr
$ctoConstr :: Section -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Section
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Section
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Section -> c Section
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Section -> c Section
Data, Typeable)

readSection :: String -> Section
readSection :: [Char] -> Section
readSection [Char]
s =
    case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') [Char]
s of
      ([Char]
"contrib", Char
'/' : [Char]
b) -> Area -> [Char] -> Section
AreaSection Area
Contrib (forall a. [a] -> [a]
tail [Char]
b)
      ([Char]
"non-free", Char
'/' : [Char]
b) -> Area -> [Char] -> Section
AreaSection Area
NonFree (forall a. [a] -> [a]
tail [Char]
b)
      ([Char]
"main", Char
'/' : [Char]
b) -> Area -> [Char] -> Section
AreaSection Area
Main (forall a. [a] -> [a]
tail [Char]
b)
      ([Char]
a, Char
'/' : [Char]
_) -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"readSection - unknown area: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
a
      ([Char]
a, [Char]
_) -> [Char] -> Section
MainSection [Char]
a

instance Pretty (PP Section) where
    pretty :: PP Section -> Doc
pretty (PP (MainSection [Char]
sec)) = [Char] -> Doc
text [Char]
sec
    pretty (PP (AreaSection Area
area [Char]
sec)) = forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP Area
area) forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"/" forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
sec

data MultiArch = MANo | MASame | MAForeign | MAAllowed
    deriving (ReadPrec [MultiArch]
ReadPrec MultiArch
Int -> ReadS MultiArch
ReadS [MultiArch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MultiArch]
$creadListPrec :: ReadPrec [MultiArch]
readPrec :: ReadPrec MultiArch
$creadPrec :: ReadPrec MultiArch
readList :: ReadS [MultiArch]
$creadList :: ReadS [MultiArch]
readsPrec :: Int -> ReadS MultiArch
$creadsPrec :: Int -> ReadS MultiArch
Read, MultiArch -> MultiArch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiArch -> MultiArch -> Bool
$c/= :: MultiArch -> MultiArch -> Bool
== :: MultiArch -> MultiArch -> Bool
$c== :: MultiArch -> MultiArch -> Bool
Eq, Eq MultiArch
MultiArch -> MultiArch -> Bool
MultiArch -> MultiArch -> Ordering
MultiArch -> MultiArch -> MultiArch
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MultiArch -> MultiArch -> MultiArch
$cmin :: MultiArch -> MultiArch -> MultiArch
max :: MultiArch -> MultiArch -> MultiArch
$cmax :: MultiArch -> MultiArch -> MultiArch
>= :: MultiArch -> MultiArch -> Bool
$c>= :: MultiArch -> MultiArch -> Bool
> :: MultiArch -> MultiArch -> Bool
$c> :: MultiArch -> MultiArch -> Bool
<= :: MultiArch -> MultiArch -> Bool
$c<= :: MultiArch -> MultiArch -> Bool
< :: MultiArch -> MultiArch -> Bool
$c< :: MultiArch -> MultiArch -> Bool
compare :: MultiArch -> MultiArch -> Ordering
$ccompare :: MultiArch -> MultiArch -> Ordering
Ord, Int -> MultiArch -> [Char] -> [Char]
[MultiArch] -> [Char] -> [Char]
MultiArch -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [MultiArch] -> [Char] -> [Char]
$cshowList :: [MultiArch] -> [Char] -> [Char]
show :: MultiArch -> [Char]
$cshow :: MultiArch -> [Char]
showsPrec :: Int -> MultiArch -> [Char] -> [Char]
$cshowsPrec :: Int -> MultiArch -> [Char] -> [Char]
Show, Typeable MultiArch
MultiArch -> DataType
MultiArch -> Constr
(forall b. Data b => b -> b) -> MultiArch -> MultiArch
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MultiArch -> u
forall u. (forall d. Data d => d -> u) -> MultiArch -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MultiArch -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MultiArch -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MultiArch -> m MultiArch
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MultiArch -> m MultiArch
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MultiArch
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MultiArch -> c MultiArch
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MultiArch)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MultiArch)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MultiArch -> m MultiArch
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MultiArch -> m MultiArch
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MultiArch -> m MultiArch
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MultiArch -> m MultiArch
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MultiArch -> m MultiArch
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MultiArch -> m MultiArch
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MultiArch -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MultiArch -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> MultiArch -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MultiArch -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MultiArch -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MultiArch -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MultiArch -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MultiArch -> r
gmapT :: (forall b. Data b => b -> b) -> MultiArch -> MultiArch
$cgmapT :: (forall b. Data b => b -> b) -> MultiArch -> MultiArch
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MultiArch)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MultiArch)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MultiArch)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MultiArch)
dataTypeOf :: MultiArch -> DataType
$cdataTypeOf :: MultiArch -> DataType
toConstr :: MultiArch -> Constr
$ctoConstr :: MultiArch -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MultiArch
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MultiArch
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MultiArch -> c MultiArch
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MultiArch -> c MultiArch
Data, Typeable)

readMultiArch :: String -> MultiArch
readMultiArch :: [Char] -> MultiArch
readMultiArch [Char]
s =
    case Text -> [Char]
unpack (Text -> Text
strip ([Char] -> Text
pack [Char]
s)) of
      [Char]
"no" -> MultiArch
MANo
      [Char]
"same" -> MultiArch
MASame
      [Char]
"foreign" -> MultiArch
MAForeign
      [Char]
"allowed" -> MultiArch
MAAllowed
      [Char]
x -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid Multi-Arch string: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
x

instance Pretty (PP MultiArch) where
    pretty :: PP MultiArch -> Doc
pretty (PP MultiArch
MANo) = [Char] -> Doc
text [Char]
"no"
    pretty (PP MultiArch
MASame) = [Char] -> Doc
text [Char]
"same"
    pretty (PP MultiArch
MAForeign) = [Char] -> Doc
text [Char]
"foreign"
    pretty (PP MultiArch
MAAllowed) = [Char] -> Doc
text [Char]
"allowed"

-- Is this really all that is allowed here?  Doesn't Ubuntu have different areas?
data Area
    = Main
    | Contrib
    | NonFree
    deriving (ReadPrec [Area]
ReadPrec Area
Int -> ReadS Area
ReadS [Area]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Area]
$creadListPrec :: ReadPrec [Area]
readPrec :: ReadPrec Area
$creadPrec :: ReadPrec Area
readList :: ReadS [Area]
$creadList :: ReadS [Area]
readsPrec :: Int -> ReadS Area
$creadsPrec :: Int -> ReadS Area
Read, Area -> Area -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Area -> Area -> Bool
$c/= :: Area -> Area -> Bool
== :: Area -> Area -> Bool
$c== :: Area -> Area -> Bool
Eq, Eq Area
Area -> Area -> Bool
Area -> Area -> Ordering
Area -> Area -> Area
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Area -> Area -> Area
$cmin :: Area -> Area -> Area
max :: Area -> Area -> Area
$cmax :: Area -> Area -> Area
>= :: Area -> Area -> Bool
$c>= :: Area -> Area -> Bool
> :: Area -> Area -> Bool
$c> :: Area -> Area -> Bool
<= :: Area -> Area -> Bool
$c<= :: Area -> Area -> Bool
< :: Area -> Area -> Bool
$c< :: Area -> Area -> Bool
compare :: Area -> Area -> Ordering
$ccompare :: Area -> Area -> Ordering
Ord, Int -> Area -> [Char] -> [Char]
[Area] -> [Char] -> [Char]
Area -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Area] -> [Char] -> [Char]
$cshowList :: [Area] -> [Char] -> [Char]
show :: Area -> [Char]
$cshow :: Area -> [Char]
showsPrec :: Int -> Area -> [Char] -> [Char]
$cshowsPrec :: Int -> Area -> [Char] -> [Char]
Show, Typeable Area
Area -> DataType
Area -> Constr
(forall b. Data b => b -> b) -> Area -> Area
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Area -> u
forall u. (forall d. Data d => d -> u) -> Area -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Area -> m Area
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Area -> m Area
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Area
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Area -> c Area
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Area)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Area)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Area -> m Area
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Area -> m Area
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Area -> m Area
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Area -> m Area
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Area -> m Area
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Area -> m Area
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Area -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Area -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Area -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Area -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Area -> r
gmapT :: (forall b. Data b => b -> b) -> Area -> Area
$cgmapT :: (forall b. Data b => b -> b) -> Area -> Area
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Area)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Area)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Area)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Area)
dataTypeOf :: Area -> DataType
$cdataTypeOf :: Area -> DataType
toConstr :: Area -> Constr
$ctoConstr :: Area -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Area
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Area
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Area -> c Area
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Area -> c Area
Data, Typeable)

instance Pretty (PP Area) where
    pretty :: PP Area -> Doc
pretty (PP Area
Main) = [Char] -> Doc
text [Char]
"main"
    pretty (PP Area
Contrib) = [Char] -> Doc
text [Char]
"contrib"
    pretty (PP Area
NonFree) = [Char] -> Doc
text [Char]
"non-free"

{-
Create a debian maintainer field from the environment variables:

  DEBFULLNAME (preferred) or NAME
  DEBEMAIL (preferred) or EMAIL

More work could be done to match dch, but this is sufficient for
now. Here is what the man page for dch has to say:

 If the environment variable DEBFULLNAME is set, this will be used for
 the maintainer full name; if not, then NAME will be checked.  If the
 environment variable DEBEMAIL is set, this will be used for the email
 address.  If this variable has the form "name <email>", then the
 maintainer name will also be taken from here if neither DEBFULLNAME
 nor NAME is set.  If this variable is not set, the same test is
 performed on the environment variable EMAIL.  Next, if the full name
 has still not been determined, then use getpwuid(3) to determine the
 name from the pass‐word file.  If this fails, use the previous
 changelog entry.  For the email address, if it has not been set from
 DEBEMAIL or EMAIL, then look in /etc/mailname, then attempt to build
 it from the username and FQDN, otherwise use the email address in the
 previous changelog entry.  In other words, it’s a good idea to set
 DEBEMAIL and DEBFULLNAME when using this script.

-}
getCurrentDebianUser :: IO (Maybe NameAddr)
getCurrentDebianUser :: IO (Maybe NameAddr)
getCurrentDebianUser =
    do [([Char], [Char])]
env <- forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Char] -> [Char]
decodeString) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO [([Char], [Char])]
getEnvironment
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do [Char]
fullname <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"DEBFULLNAME" [([Char], [Char])]
env forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"NAME" [([Char], [Char])]
env
                   [Char]
email    <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"DEBEMAIL" [([Char], [Char])]
env forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"EMAIL" [([Char], [Char])]
env
                   forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just ([Char] -> Either [Char] NameAddr
parseMaintainer ([Char]
fullname forall a. [a] -> [a] -> [a]
++ [Char]
" <" forall a. [a] -> [a] -> [a]
++ [Char]
email forall a. [a] -> [a] -> [a]
++ [Char]
">"))

haskellMaintainer :: NameAddr
haskellMaintainer :: NameAddr
haskellMaintainer =
    NameAddr { nameAddr_name :: Maybe [Char]
nameAddr_name = forall a. a -> Maybe a
Just [Char]
"Debian Haskell Group"
             , nameAddr_addr :: [Char]
nameAddr_addr = [Char]
"pkg-haskell-maintainers@lists.alioth.debian.org"}

-- | Turn the uploaders field of a cabal package into a list of
-- RFC2822 NameAddr values.
parseUploaders :: String -> Either String [NameAddr]
parseUploaders :: [Char] -> Either [Char] [NameAddr]
parseUploaders [Char]
x =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [NameAddr] -> Either [Char] [NameAddr]
fixNameAddrs (forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address [Char]
"" ([Char]
"Names: " forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixWhite [Char]
x forall a. [a] -> [a] -> [a]
++ [Char]
";"))
    -- either (\ e -> error ("Failure parsing uploader list: " ++ show x ++ " -> " ++ show e)) id $ 
    where
      fixWhite :: Char -> Char
fixWhite Char
c = if Char -> Bool
isSpace Char
c then Char
' ' else Char
c
      -- We absoletely need a name.
      fixNameAddrs :: [NameAddr] -> Either String [NameAddr]
      fixNameAddrs :: [NameAddr] -> Either [Char] [NameAddr]
fixNameAddrs [NameAddr]
xs = case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NameAddr -> Maybe NameAddr
fixNameAddr [NameAddr]
xs of
                          [] -> forall a b. a -> Either a b
Left ([Char]
"No valid debian maintainers in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
x)
                          [NameAddr]
xs' -> forall a b. b -> Either a b
Right [NameAddr]
xs'
      fixNameAddr :: NameAddr -> Maybe NameAddr
      fixNameAddr :: NameAddr -> Maybe NameAddr
fixNameAddr NameAddr
y =
          case NameAddr -> Maybe [Char]
nameAddr_name NameAddr
y of
            Maybe [Char]
Nothing -> forall a. Maybe a
Nothing
            Maybe [Char]
_ -> forall a. a -> Maybe a
Just NameAddr
y

-- | Parse a string containing a single NameAddr value.
parseMaintainer :: String -> Either String NameAddr
parseMaintainer :: [Char] -> Either [Char] NameAddr
parseMaintainer [Char]
x =
    case [Char] -> Either [Char] [NameAddr]
parseUploaders [Char]
x of
      Left [Char]
s -> forall a b. a -> Either a b
Left [Char]
s
      Right [NameAddr
y] -> forall a b. b -> Either a b
Right NameAddr
y
      Right [] -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Missing maintainer: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
x
      Right [NameAddr]
ys -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Too many maintainers: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [NameAddr]
ys


-- | Maintainer is a mandatory field, so we need a value we can use
-- when all else fails.
maintainerOfLastResort :: NameAddr
Right NameAddr
maintainerOfLastResort = [Char] -> Either [Char] NameAddr
parseMaintainer [Char]
"nobody <nobody@nowhere>"

-- | Official Debian license types as described in
-- <https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/#license-specification>.
data License
    = Public_Domain     -- ^ No license required for any purpose; the work is not subject to copyright in any jurisdiction.
    | Apache            -- ^ Apache license 1.0, 2.0.
    | Artistic          -- ^ Artistic license 1.0, 2.0.
    | BSD_2_Clause      -- ^ Berkeley software distribution license, 2-clause version.
    | BSD_3_Clause      -- ^ Berkeley software distribution license, 3-clause version.
    | BSD_4_Clause      -- ^ Berkeley software distribution license, 4-clause version.
    | ISC               -- ^ Internet Software Consortium, sometimes also known as the OpenBSD License.
    | CC_BY             -- ^ Creative Commons Attribution license 1.0, 2.0, 2.5, 3.0.
    | CC_BY_SA          -- ^ Creative Commons Attribution Share Alike license 1.0, 2.0, 2.5, 3.0.
    | CC_BY_ND          -- ^ Creative Commons Attribution No Derivatives license 1.0, 2.0, 2.5, 3.0.
    | CC_BY_NC          -- ^ Creative Commons Attribution Non-Commercial license 1.0, 2.0, 2.5, 3.0.
    | CC_BY_NC_SA       -- ^ Creative Commons Attribution Non-Commercial Share Alike license 1.0, 2.0, 2.5, 3.0.
    | CC_BY_NC_ND       -- ^ Creative Commons Attribution Non-Commercial No Derivatives license 1.0, 2.0, 2.5, 3.0.
    | CC0               -- ^ Creative Commons Zero 1.0 Universal. Omit "Universal" from the license version when forming the short name.
    | CDDL              -- ^ Common Development and Distribution License 1.0.
    | CPL               -- ^ IBM Common Public License.
    | EFL               -- ^ The Eiffel Forum License 1.0, 2.0.
    | Expat             -- ^ The Expat license.
    | GPL               -- ^ GNU General Public License 1.0, 2.0, 3.0.
    | LGPL              -- ^ GNU Lesser General Public License 2.1, 3.0, or GNU Library General Public License 2.0.
    | GFDL              -- ^ GNU Free Documentation License 1.0, 1.1, 1.2, or 1.3. Use GFDL-NIV instead if there are no Front-Cover or Back-Cover Texts or Invariant Sections.
    | GFDL_NIV          -- ^ GNU Free Documentation License, with no Front-Cover or Back-Cover Texts or Invariant Sections. Use the same version numbers as GFDL.
    | LPPL              -- ^ LaTeX Project Public License 1.0, 1.1, 1.2, 1.3c.
    | MPL               -- ^ Mozilla Public License 1.1.
    | Perl              -- ^ erl license (use "GPL-1+ or Artistic-1" instead)
    | Python            -- ^ Python license 2.0.
    | QPL               -- ^ Q Public License 1.0.
    | W3C               -- ^ W3C Software License For more information, consult the W3C Intellectual Rights FAQ.
    | Zlib              -- ^ zlib/libpng license.
    | Zope              -- ^ Zope Public License 1.0, 1.1, 2.0, 2.1.
    | OtherLicense String
                        -- ^ Any other license name
    deriving (ReadPrec [License]
ReadPrec License
Int -> ReadS License
ReadS [License]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [License]
$creadListPrec :: ReadPrec [License]
readPrec :: ReadPrec License
$creadPrec :: ReadPrec License
readList :: ReadS [License]
$creadList :: ReadS [License]
readsPrec :: Int -> ReadS License
$creadsPrec :: Int -> ReadS License
Read, Int -> License -> [Char] -> [Char]
[License] -> [Char] -> [Char]
License -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [License] -> [Char] -> [Char]
$cshowList :: [License] -> [Char] -> [Char]
show :: License -> [Char]
$cshow :: License -> [Char]
showsPrec :: Int -> License -> [Char] -> [Char]
$cshowsPrec :: Int -> License -> [Char] -> [Char]
Show, License -> License -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: License -> License -> Bool
$c/= :: License -> License -> Bool
== :: License -> License -> Bool
$c== :: License -> License -> Bool
Eq, Eq License
License -> License -> Bool
License -> License -> Ordering
License -> License -> License
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: License -> License -> License
$cmin :: License -> License -> License
max :: License -> License -> License
$cmax :: License -> License -> License
>= :: License -> License -> Bool
$c>= :: License -> License -> Bool
> :: License -> License -> Bool
$c> :: License -> License -> Bool
<= :: License -> License -> Bool
$c<= :: License -> License -> Bool
< :: License -> License -> Bool
$c< :: License -> License -> Bool
compare :: License -> License -> Ordering
$ccompare :: License -> License -> Ordering
Ord, Typeable License
License -> DataType
License -> Constr
(forall b. Data b => b -> b) -> License -> License
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> License -> u
forall u. (forall d. Data d => d -> u) -> License -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> License -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> License -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> License -> m License
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> License -> m License
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c License
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> License -> c License
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c License)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c License)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> License -> m License
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> License -> m License
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> License -> m License
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> License -> m License
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> License -> m License
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> License -> m License
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> License -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> License -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> License -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> License -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> License -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> License -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> License -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> License -> r
gmapT :: (forall b. Data b => b -> b) -> License -> License
$cgmapT :: (forall b. Data b => b -> b) -> License -> License
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c License)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c License)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c License)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c License)
dataTypeOf :: License -> DataType
$cdataTypeOf :: License -> DataType
toConstr :: License -> Constr
$ctoConstr :: License -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c License
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c License
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> License -> c License
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> License -> c License
Data, Typeable)

-- We need a license parse function that converts these strings back
-- into License values.
instance Pretty License where
    pretty :: License -> Doc
pretty License
Public_Domain = [Char] -> Doc
text [Char]
"public-domain"
    pretty License
Apache = [Char] -> Doc
text [Char]
"Apache"
    pretty License
Artistic = [Char] -> Doc
text [Char]
"Artistic"
    pretty License
BSD_2_Clause = [Char] -> Doc
text [Char]
"BSD-2-clause"
    pretty License
BSD_3_Clause = [Char] -> Doc
text [Char]
"BSD-3-clause"
    pretty License
BSD_4_Clause = [Char] -> Doc
text [Char]
"BSD-4-clause"
    pretty License
ISC = [Char] -> Doc
text [Char]
"ISC"
    pretty License
CC_BY = [Char] -> Doc
text [Char]
"CC-BY"
    pretty License
CC_BY_SA = [Char] -> Doc
text [Char]
"CC-BY-SA"
    pretty License
CC_BY_ND = [Char] -> Doc
text [Char]
"CC-BY-ND"
    pretty License
CC_BY_NC = [Char] -> Doc
text [Char]
"CC-BY-NC"
    pretty License
CC_BY_NC_SA = [Char] -> Doc
text [Char]
"CC-BY-NC-SA"
    pretty License
CC_BY_NC_ND = [Char] -> Doc
text [Char]
"CC-BY-NC-ND"
    pretty License
CC0 = [Char] -> Doc
text [Char]
"CC0"
    pretty License
CDDL = [Char] -> Doc
text [Char]
"CDDL"
    pretty License
CPL = [Char] -> Doc
text [Char]
"CPL"
    pretty License
EFL = [Char] -> Doc
text [Char]
"EFL"
    pretty License
Expat = [Char] -> Doc
text [Char]
"Expat"
    pretty License
GPL = [Char] -> Doc
text [Char]
"GPL"
    pretty License
LGPL = [Char] -> Doc
text [Char]
"LGPL"
    pretty License
GFDL = [Char] -> Doc
text [Char]
"GFDL"
    pretty License
GFDL_NIV = [Char] -> Doc
text [Char]
"GFDL-NIV"
    pretty License
LPPL = [Char] -> Doc
text [Char]
"LPPL"
    pretty License
MPL = [Char] -> Doc
text [Char]
"MPL"
    pretty License
Perl = [Char] -> Doc
text [Char]
"Perl"
    pretty License
Python = [Char] -> Doc
text [Char]
"Python"
    pretty License
QPL = [Char] -> Doc
text [Char]
"QPL"
    pretty License
W3C = [Char] -> Doc
text [Char]
"W3C"
    pretty License
Zlib = [Char] -> Doc
text [Char]
"Zlib"
    pretty License
Zope = [Char] -> Doc
text [Char]
"Zope"
    pretty (OtherLicense [Char]
s) = [Char] -> Doc
text [Char]
s

-- | Convert the Cabal license to a Debian license.  I would welcome input
-- on how to make this more correct.
fromCabalLicense :: Cabal.License -> License
fromCabalLicense :: License -> License
fromCabalLicense License
x =
    case License
x of
      Cabal.GPL Maybe Version
_ -> License
GPL -- FIXME - what about the version number?  same below
      Cabal.AGPL Maybe Version
_ -> [Char] -> License
OtherLicense (forall a. Show a => a -> [Char]
show License
x)
      Cabal.LGPL Maybe Version
_ -> License
LGPL
      License
Cabal.BSD3 -> License
BSD_3_Clause
      License
Cabal.BSD4 -> License
BSD_4_Clause
      License
Cabal.MIT -> License
Expat
      Cabal.Apache Maybe Version
_ -> License
Apache
      License
Cabal.PublicDomain -> License
Public_Domain
      License
Cabal.AllRightsReserved -> [Char] -> License
OtherLicense [Char]
"AllRightsReserved"
      License
Cabal.OtherLicense -> [Char] -> License
OtherLicense (forall a. Show a => a -> [Char]
show License
x)
      Cabal.UnknownLicense [Char]
_ -> [Char] -> License
OtherLicense (forall a. Show a => a -> [Char]
show License
x)
      Cabal.MPL Version
_ -> License
MPL
      License
Cabal.BSD2 -> License
BSD_2_Clause
      License
Cabal.ISC -> [Char] -> License
OtherLicense (forall a. Show a => a -> [Char]
show License
x)
      License
Cabal.UnspecifiedLicense -> [Char] -> License
OtherLicense (forall a. Show a => a -> [Char]
show License
x)

-- | Convert a Debian license to a Cabal license.  Additional cases
-- and corrections welcome.
toCabalLicense :: License -> Cabal.License
toCabalLicense :: License -> License
toCabalLicense License
x =
    -- This needs to be finished
    case License
x of
      License
BSD_2_Clause -> License
Cabal.BSD2
      License
BSD_3_Clause -> License
Cabal.BSD3
      License
BSD_4_Clause -> License
Cabal.BSD4
      License
Expat -> License
Cabal.MIT
      OtherLicense [Char]
s -> [Char] -> License
Cabal.UnknownLicense [Char]
s
      License
_ -> [Char] -> License
Cabal.UnknownLicense (forall a. Show a => a -> [Char]
show License
x)

invalidLicense :: Text -> License
invalidLicense :: Text -> License
invalidLicense = [Char] -> License
OtherLicense forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack

-- | I think we need an actual parser for license names.
readLicense :: Text -> License
readLicense :: Text -> License
readLicense Text
t = let s :: [Char]
s = Text -> [Char]
unpack (Text -> Text
strip Text
t) in forall a. a -> Maybe a -> a
fromMaybe (Text -> License
invalidLicense Text
t) (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s)