-- | 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 -> String
databaseDirectory BinPkgName
x = String
"/srv" String -> String -> String
</> Doc -> String
forall a. Show a => a -> String
show (PP BinPkgName -> Doc
forall a. Pretty a => a -> Doc
pretty (PP BinPkgName -> Doc)
-> (BinPkgName -> PP BinPkgName) -> BinPkgName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> PP BinPkgName
forall a. a -> PP a
PP (BinPkgName -> Doc) -> BinPkgName -> Doc
forall a b. (a -> b) -> a -> b
$ BinPkgName
x)

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

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

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

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

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

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

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

appLogBaseName :: String
appLogBaseName :: String
appLogBaseName = String
"app.log"

errorLogBaseName :: String
errorLogBaseName :: String
errorLogBaseName = String
"error.log"

accessLogBaseName :: String
accessLogBaseName :: String
accessLogBaseName = String
"access.log"

debianPackageVersion :: String -> IO (Maybe DebianVersion)
debianPackageVersion :: String -> IO (Maybe DebianVersion)
debianPackageVersion String
name =
    String -> [String] -> String -> IO String
readProcess String
"dpkg-query" [String
"--show", String
"--showformat=${version}", String
name] String
"" IO String
-> (String -> IO (Maybe DebianVersion)) -> IO (Maybe DebianVersion)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Maybe DebianVersion -> IO (Maybe DebianVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DebianVersion -> IO (Maybe DebianVersion))
-> (String -> Maybe DebianVersion)
-> String
-> IO (Maybe DebianVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe DebianVersion
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
"" = Maybe DebianVersion
forall a. Maybe a
Nothing
      parseDebianVersion'' string
s = DebianVersion -> Maybe DebianVersion
forall a. a -> Maybe a
Just (string -> DebianVersion
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 = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10)

data StandardsVersion = StandardsVersion Int Int Int (Maybe Int) deriving (StandardsVersion -> StandardsVersion -> Bool
(StandardsVersion -> StandardsVersion -> Bool)
-> (StandardsVersion -> StandardsVersion -> Bool)
-> Eq StandardsVersion
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
Eq StandardsVersion
-> (StandardsVersion -> StandardsVersion -> Ordering)
-> (StandardsVersion -> StandardsVersion -> Bool)
-> (StandardsVersion -> StandardsVersion -> Bool)
-> (StandardsVersion -> StandardsVersion -> Bool)
-> (StandardsVersion -> StandardsVersion -> Bool)
-> (StandardsVersion -> StandardsVersion -> StandardsVersion)
-> (StandardsVersion -> StandardsVersion -> StandardsVersion)
-> Ord 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
$cp1Ord :: Eq StandardsVersion
Ord, Int -> StandardsVersion -> String -> String
[StandardsVersion] -> String -> String
StandardsVersion -> String
(Int -> StandardsVersion -> String -> String)
-> (StandardsVersion -> String)
-> ([StandardsVersion] -> String -> String)
-> Show StandardsVersion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [StandardsVersion] -> String -> String
$cshowList :: [StandardsVersion] -> String -> String
show :: StandardsVersion -> String
$cshow :: StandardsVersion -> String
showsPrec :: Int -> StandardsVersion -> String -> String
$cshowsPrec :: Int -> StandardsVersion -> String -> String
Show, Typeable StandardsVersion
DataType
Constr
Typeable StandardsVersion
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> StandardsVersion -> c StandardsVersion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StandardsVersion)
-> (StandardsVersion -> Constr)
-> (StandardsVersion -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> StandardsVersion -> StandardsVersion)
-> (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 u.
    (forall d. Data d => d -> u) -> StandardsVersion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StandardsVersion -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StandardsVersion -> m StandardsVersion)
-> Data StandardsVersion
StandardsVersion -> DataType
StandardsVersion -> Constr
(forall b. Data b => b -> b)
-> StandardsVersion -> StandardsVersion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StandardsVersion -> c StandardsVersion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cStandardsVersion :: Constr
$tStandardsVersion :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> StandardsVersion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StandardsVersion -> u
gmapQ :: (forall d. Data d => d -> u) -> StandardsVersion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StandardsVersion -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable StandardsVersion
Data, Typeable)

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

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

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

data SourceFormat
    = Native3
    | Quilt3
    deriving (SourceFormat -> SourceFormat -> Bool
(SourceFormat -> SourceFormat -> Bool)
-> (SourceFormat -> SourceFormat -> Bool) -> Eq SourceFormat
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
Eq SourceFormat
-> (SourceFormat -> SourceFormat -> Ordering)
-> (SourceFormat -> SourceFormat -> Bool)
-> (SourceFormat -> SourceFormat -> Bool)
-> (SourceFormat -> SourceFormat -> Bool)
-> (SourceFormat -> SourceFormat -> Bool)
-> (SourceFormat -> SourceFormat -> SourceFormat)
-> (SourceFormat -> SourceFormat -> SourceFormat)
-> Ord 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
$cp1Ord :: Eq SourceFormat
Ord, Int -> SourceFormat -> String -> String
[SourceFormat] -> String -> String
SourceFormat -> String
(Int -> SourceFormat -> String -> String)
-> (SourceFormat -> String)
-> ([SourceFormat] -> String -> String)
-> Show SourceFormat
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SourceFormat] -> String -> String
$cshowList :: [SourceFormat] -> String -> String
show :: SourceFormat -> String
$cshow :: SourceFormat -> String
showsPrec :: Int -> SourceFormat -> String -> String
$cshowsPrec :: Int -> SourceFormat -> String -> String
Show, Typeable SourceFormat
DataType
Constr
Typeable SourceFormat
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SourceFormat -> c SourceFormat)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceFormat)
-> (SourceFormat -> Constr)
-> (SourceFormat -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SourceFormat -> SourceFormat)
-> (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 u. (forall d. Data d => d -> u) -> SourceFormat -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceFormat -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceFormat -> m SourceFormat)
-> Data SourceFormat
SourceFormat -> DataType
SourceFormat -> Constr
(forall b. Data b => b -> b) -> SourceFormat -> SourceFormat
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceFormat -> c SourceFormat
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cQuilt3 :: Constr
$cNative3 :: Constr
$tSourceFormat :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> SourceFormat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceFormat -> u
gmapQ :: (forall d. Data d => d -> u) -> SourceFormat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceFormat -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable SourceFormat
Data, Typeable)

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

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

data PackagePriority
    = Required
    | Important
    | Standard
    | Optional
    | Extra
    deriving (PackagePriority -> PackagePriority -> Bool
(PackagePriority -> PackagePriority -> Bool)
-> (PackagePriority -> PackagePriority -> Bool)
-> Eq PackagePriority
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
Eq PackagePriority
-> (PackagePriority -> PackagePriority -> Ordering)
-> (PackagePriority -> PackagePriority -> Bool)
-> (PackagePriority -> PackagePriority -> Bool)
-> (PackagePriority -> PackagePriority -> Bool)
-> (PackagePriority -> PackagePriority -> Bool)
-> (PackagePriority -> PackagePriority -> PackagePriority)
-> (PackagePriority -> PackagePriority -> PackagePriority)
-> Ord 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
$cp1Ord :: Eq PackagePriority
Ord, ReadPrec [PackagePriority]
ReadPrec PackagePriority
Int -> ReadS PackagePriority
ReadS [PackagePriority]
(Int -> ReadS PackagePriority)
-> ReadS [PackagePriority]
-> ReadPrec PackagePriority
-> ReadPrec [PackagePriority]
-> Read 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 -> String -> String
[PackagePriority] -> String -> String
PackagePriority -> String
(Int -> PackagePriority -> String -> String)
-> (PackagePriority -> String)
-> ([PackagePriority] -> String -> String)
-> Show PackagePriority
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PackagePriority] -> String -> String
$cshowList :: [PackagePriority] -> String -> String
show :: PackagePriority -> String
$cshow :: PackagePriority -> String
showsPrec :: Int -> PackagePriority -> String -> String
$cshowsPrec :: Int -> PackagePriority -> String -> String
Show, Typeable PackagePriority
DataType
Constr
Typeable PackagePriority
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PackagePriority -> c PackagePriority)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PackagePriority)
-> (PackagePriority -> Constr)
-> (PackagePriority -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> PackagePriority -> PackagePriority)
-> (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 u.
    (forall d. Data d => d -> u) -> PackagePriority -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PackagePriority -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PackagePriority -> m PackagePriority)
-> Data PackagePriority
PackagePriority -> DataType
PackagePriority -> Constr
(forall b. Data b => b -> b) -> PackagePriority -> PackagePriority
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackagePriority -> c PackagePriority
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cExtra :: Constr
$cOptional :: Constr
$cStandard :: Constr
$cImportant :: Constr
$cRequired :: Constr
$tPackagePriority :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> PackagePriority -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PackagePriority -> u
gmapQ :: (forall d. Data d => d -> u) -> PackagePriority -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PackagePriority -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable PackagePriority
Data, Typeable)

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

instance Pretty (PP PackagePriority) where
    pretty :: PP PackagePriority -> Doc
pretty = String -> Doc
text (String -> Doc)
-> (PP PackagePriority -> String) -> PP PackagePriority -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String)
-> (PP PackagePriority -> String) -> PP PackagePriority -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagePriority -> String
forall a. Show a => a -> String
show (PackagePriority -> String)
-> (PP PackagePriority -> PackagePriority)
-> PP PackagePriority
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP PackagePriority -> PackagePriority
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]
(Int -> ReadS PackageArchitectures)
-> ReadS [PackageArchitectures]
-> ReadPrec PackageArchitectures
-> ReadPrec [PackageArchitectures]
-> Read 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
(PackageArchitectures -> PackageArchitectures -> Bool)
-> (PackageArchitectures -> PackageArchitectures -> Bool)
-> Eq PackageArchitectures
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
Eq PackageArchitectures
-> (PackageArchitectures -> PackageArchitectures -> Ordering)
-> (PackageArchitectures -> PackageArchitectures -> Bool)
-> (PackageArchitectures -> PackageArchitectures -> Bool)
-> (PackageArchitectures -> PackageArchitectures -> Bool)
-> (PackageArchitectures -> PackageArchitectures -> Bool)
-> (PackageArchitectures
    -> PackageArchitectures -> PackageArchitectures)
-> (PackageArchitectures
    -> PackageArchitectures -> PackageArchitectures)
-> Ord 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
$cp1Ord :: Eq PackageArchitectures
Ord, Int -> PackageArchitectures -> String -> String
[PackageArchitectures] -> String -> String
PackageArchitectures -> String
(Int -> PackageArchitectures -> String -> String)
-> (PackageArchitectures -> String)
-> ([PackageArchitectures] -> String -> String)
-> Show PackageArchitectures
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PackageArchitectures] -> String -> String
$cshowList :: [PackageArchitectures] -> String -> String
show :: PackageArchitectures -> String
$cshow :: PackageArchitectures -> String
showsPrec :: Int -> PackageArchitectures -> String -> String
$cshowsPrec :: Int -> PackageArchitectures -> String -> String
Show, Typeable PackageArchitectures
DataType
Constr
Typeable PackageArchitectures
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> PackageArchitectures
    -> c PackageArchitectures)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PackageArchitectures)
-> (PackageArchitectures -> Constr)
-> (PackageArchitectures -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> PackageArchitectures -> PackageArchitectures)
-> (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 u.
    (forall d. Data d => d -> u) -> PackageArchitectures -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PackageArchitectures -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PackageArchitectures -> m PackageArchitectures)
-> Data PackageArchitectures
PackageArchitectures -> DataType
PackageArchitectures -> Constr
(forall b. Data b => b -> b)
-> PackageArchitectures -> PackageArchitectures
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PackageArchitectures
-> c PackageArchitectures
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cNames :: Constr
$cAny :: Constr
$cAll :: Constr
$tPackageArchitectures :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> PackageArchitectures -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PackageArchitectures -> u
gmapQ :: (forall d. Data d => d -> u) -> PackageArchitectures -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> PackageArchitectures -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable PackageArchitectures
Data, Typeable)

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

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

data Section
    = MainSection String -- Equivalent to AreaSection Main s?
    | AreaSection Area String
    deriving (ReadPrec [Section]
ReadPrec Section
Int -> ReadS Section
ReadS [Section]
(Int -> ReadS Section)
-> ReadS [Section]
-> ReadPrec Section
-> ReadPrec [Section]
-> Read 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
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
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
Eq Section
-> (Section -> Section -> Ordering)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Section)
-> (Section -> Section -> Section)
-> Ord 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
$cp1Ord :: Eq Section
Ord, Int -> Section -> String -> String
[Section] -> String -> String
Section -> String
(Int -> Section -> String -> String)
-> (Section -> String)
-> ([Section] -> String -> String)
-> Show Section
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Section] -> String -> String
$cshowList :: [Section] -> String -> String
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Int -> Section -> String -> String
$cshowsPrec :: Int -> Section -> String -> String
Show, Typeable Section
DataType
Constr
Typeable Section
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Section -> c Section)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Section)
-> (Section -> Constr)
-> (Section -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Section -> Section)
-> (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 u. (forall d. Data d => d -> u) -> Section -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Section -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Section -> m Section)
-> Data Section
Section -> DataType
Section -> Constr
(forall b. Data b => b -> b) -> Section -> Section
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Section -> c Section
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cAreaSection :: Constr
$cMainSection :: Constr
$tSection :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Section -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Section -> u
gmapQ :: (forall d. Data d => d -> u) -> Section -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Section -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Section
Data, Typeable)

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

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

data MultiArch = MANo | MASame | MAForeign | MAAllowed
    deriving (ReadPrec [MultiArch]
ReadPrec MultiArch
Int -> ReadS MultiArch
ReadS [MultiArch]
(Int -> ReadS MultiArch)
-> ReadS [MultiArch]
-> ReadPrec MultiArch
-> ReadPrec [MultiArch]
-> Read 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
(MultiArch -> MultiArch -> Bool)
-> (MultiArch -> MultiArch -> Bool) -> Eq MultiArch
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
Eq MultiArch
-> (MultiArch -> MultiArch -> Ordering)
-> (MultiArch -> MultiArch -> Bool)
-> (MultiArch -> MultiArch -> Bool)
-> (MultiArch -> MultiArch -> Bool)
-> (MultiArch -> MultiArch -> Bool)
-> (MultiArch -> MultiArch -> MultiArch)
-> (MultiArch -> MultiArch -> MultiArch)
-> Ord 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
$cp1Ord :: Eq MultiArch
Ord, Int -> MultiArch -> String -> String
[MultiArch] -> String -> String
MultiArch -> String
(Int -> MultiArch -> String -> String)
-> (MultiArch -> String)
-> ([MultiArch] -> String -> String)
-> Show MultiArch
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MultiArch] -> String -> String
$cshowList :: [MultiArch] -> String -> String
show :: MultiArch -> String
$cshow :: MultiArch -> String
showsPrec :: Int -> MultiArch -> String -> String
$cshowsPrec :: Int -> MultiArch -> String -> String
Show, Typeable MultiArch
DataType
Constr
Typeable MultiArch
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MultiArch -> c MultiArch)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MultiArch)
-> (MultiArch -> Constr)
-> (MultiArch -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> MultiArch -> MultiArch)
-> (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 u. (forall d. Data d => d -> u) -> MultiArch -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MultiArch -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MultiArch -> m MultiArch)
-> Data MultiArch
MultiArch -> DataType
MultiArch -> Constr
(forall b. Data b => b -> b) -> MultiArch -> MultiArch
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MultiArch -> c MultiArch
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cMAAllowed :: Constr
$cMAForeign :: Constr
$cMASame :: Constr
$cMANo :: Constr
$tMultiArch :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> MultiArch -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MultiArch -> u
gmapQ :: (forall d. Data d => d -> u) -> MultiArch -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MultiArch -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable MultiArch
Data, Typeable)

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

instance Pretty (PP MultiArch) where
    pretty :: PP MultiArch -> Doc
pretty (PP MultiArch
MANo) = String -> Doc
text String
"no"
    pretty (PP MultiArch
MASame) = String -> Doc
text String
"same"
    pretty (PP MultiArch
MAForeign) = String -> Doc
text String
"foreign"
    pretty (PP MultiArch
MAAllowed) = String -> Doc
text String
"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]
(Int -> ReadS Area)
-> ReadS [Area] -> ReadPrec Area -> ReadPrec [Area] -> Read 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
(Area -> Area -> Bool) -> (Area -> Area -> Bool) -> Eq Area
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
Eq Area
-> (Area -> Area -> Ordering)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Bool)
-> (Area -> Area -> Area)
-> (Area -> Area -> Area)
-> Ord 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
$cp1Ord :: Eq Area
Ord, Int -> Area -> String -> String
[Area] -> String -> String
Area -> String
(Int -> Area -> String -> String)
-> (Area -> String) -> ([Area] -> String -> String) -> Show Area
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Area] -> String -> String
$cshowList :: [Area] -> String -> String
show :: Area -> String
$cshow :: Area -> String
showsPrec :: Int -> Area -> String -> String
$cshowsPrec :: Int -> Area -> String -> String
Show, Typeable Area
DataType
Constr
Typeable Area
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Area -> c Area)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Area)
-> (Area -> Constr)
-> (Area -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Area -> Area)
-> (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 u. (forall d. Data d => d -> u) -> Area -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Area -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Area -> m Area)
-> Data Area
Area -> DataType
Area -> Constr
(forall b. Data b => b -> b) -> Area -> Area
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Area -> c Area
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cNonFree :: Constr
$cContrib :: Constr
$cMain :: Constr
$tArea :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Area -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Area -> u
gmapQ :: (forall d. Data d => d -> u) -> Area -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Area -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Area
Data, Typeable)

instance Pretty (PP Area) where
    pretty :: PP Area -> Doc
pretty (PP Area
Main) = String -> Doc
text String
"main"
    pretty (PP Area
Contrib) = String -> Doc
text String
"contrib"
    pretty (PP Area
NonFree) = String -> Doc
text String
"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 [(String, String)]
env <- ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> String
decodeString) ([(String, String)] -> [(String, String)])
-> IO [(String, String)] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO [(String, String)]
getEnvironment
       Maybe NameAddr -> IO (Maybe NameAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NameAddr -> IO (Maybe NameAddr))
-> Maybe NameAddr -> IO (Maybe NameAddr)
forall a b. (a -> b) -> a -> b
$ do String
fullname <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"DEBFULLNAME" [(String, String)]
env Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"NAME" [(String, String)]
env
                   String
email    <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"DEBEMAIL" [(String, String)]
env Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"EMAIL" [(String, String)]
env
                   (String -> Maybe NameAddr)
-> (NameAddr -> Maybe NameAddr)
-> Either String NameAddr
-> Maybe NameAddr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe NameAddr -> String -> Maybe NameAddr
forall a b. a -> b -> a
const Maybe NameAddr
forall a. Maybe a
Nothing) NameAddr -> Maybe NameAddr
forall a. a -> Maybe a
Just (String -> Either String NameAddr
parseMaintainer (String
fullname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
email String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"))

haskellMaintainer :: NameAddr
haskellMaintainer :: NameAddr
haskellMaintainer =
    NameAddr :: Maybe String -> String -> NameAddr
NameAddr { nameAddr_name :: Maybe String
nameAddr_name = String -> Maybe String
forall a. a -> Maybe a
Just String
"Debian Haskell Group"
             , nameAddr_addr :: String
nameAddr_addr = String
"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 :: String -> Either String [NameAddr]
parseUploaders String
x =
    (ParseError -> Either String [NameAddr])
-> ([NameAddr] -> Either String [NameAddr])
-> Either ParseError [NameAddr]
-> Either String [NameAddr]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String [NameAddr]
forall a b. a -> Either a b
Left (String -> Either String [NameAddr])
-> (ParseError -> String) -> ParseError -> Either String [NameAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) [NameAddr] -> Either String [NameAddr]
fixNameAddrs (Parsec String () [NameAddr]
-> String -> String -> Either ParseError [NameAddr]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address String
"" (String
"Names: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixWhite String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"))
    -- 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 String [NameAddr]
fixNameAddrs [NameAddr]
xs = case (NameAddr -> Maybe NameAddr) -> [NameAddr] -> [NameAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NameAddr -> Maybe NameAddr
fixNameAddr [NameAddr]
xs of
                          [] -> String -> Either String [NameAddr]
forall a b. a -> Either a b
Left (String
"No valid debian maintainers in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x)
                          [NameAddr]
xs' -> [NameAddr] -> Either String [NameAddr]
forall a b. b -> Either a b
Right [NameAddr]
xs'
      fixNameAddr :: NameAddr -> Maybe NameAddr
      fixNameAddr :: NameAddr -> Maybe NameAddr
fixNameAddr NameAddr
y =
          case NameAddr -> Maybe String
nameAddr_name NameAddr
y of
            Maybe String
Nothing -> Maybe NameAddr
forall a. Maybe a
Nothing
            Maybe String
_ -> NameAddr -> Maybe NameAddr
forall a. a -> Maybe a
Just NameAddr
y

-- | Parse a string containing a single NameAddr value.
parseMaintainer :: String -> Either String NameAddr
parseMaintainer :: String -> Either String NameAddr
parseMaintainer String
x =
    case String -> Either String [NameAddr]
parseUploaders String
x of
      Left String
s -> String -> Either String NameAddr
forall a b. a -> Either a b
Left String
s
      Right [NameAddr
y] -> NameAddr -> Either String NameAddr
forall a b. b -> Either a b
Right NameAddr
y
      Right [] -> String -> Either String NameAddr
forall a b. a -> Either a b
Left (String -> Either String NameAddr)
-> String -> Either String NameAddr
forall a b. (a -> b) -> a -> b
$ String
"Missing maintainer: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x
      Right [NameAddr]
ys -> String -> Either String NameAddr
forall a b. a -> Either a b
Left (String -> Either String NameAddr)
-> String -> Either String NameAddr
forall a b. (a -> b) -> a -> b
$ String
"Too many maintainers: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [NameAddr] -> String
forall a. Show a => a -> String
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 = String -> Either String NameAddr
parseMaintainer String
"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]
(Int -> ReadS License)
-> ReadS [License]
-> ReadPrec License
-> ReadPrec [License]
-> Read 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 -> String -> String
[License] -> String -> String
License -> String
(Int -> License -> String -> String)
-> (License -> String)
-> ([License] -> String -> String)
-> Show License
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [License] -> String -> String
$cshowList :: [License] -> String -> String
show :: License -> String
$cshow :: License -> String
showsPrec :: Int -> License -> String -> String
$cshowsPrec :: Int -> License -> String -> String
Show, License -> License -> Bool
(License -> License -> Bool)
-> (License -> License -> Bool) -> Eq License
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
Eq License
-> (License -> License -> Ordering)
-> (License -> License -> Bool)
-> (License -> License -> Bool)
-> (License -> License -> Bool)
-> (License -> License -> Bool)
-> (License -> License -> License)
-> (License -> License -> License)
-> Ord 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
$cp1Ord :: Eq License
Ord, Typeable License
DataType
Constr
Typeable License
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> License -> c License)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c License)
-> (License -> Constr)
-> (License -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> License -> License)
-> (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 u. (forall d. Data d => d -> u) -> License -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> License -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> License -> m License)
-> Data License
License -> DataType
License -> Constr
(forall b. Data b => b -> b) -> License -> License
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> License -> c License
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cOtherLicense :: Constr
$cZope :: Constr
$cZlib :: Constr
$cW3C :: Constr
$cQPL :: Constr
$cPython :: Constr
$cPerl :: Constr
$cMPL :: Constr
$cLPPL :: Constr
$cGFDL_NIV :: Constr
$cGFDL :: Constr
$cLGPL :: Constr
$cGPL :: Constr
$cExpat :: Constr
$cEFL :: Constr
$cCPL :: Constr
$cCDDL :: Constr
$cCC0 :: Constr
$cCC_BY_NC_ND :: Constr
$cCC_BY_NC_SA :: Constr
$cCC_BY_NC :: Constr
$cCC_BY_ND :: Constr
$cCC_BY_SA :: Constr
$cCC_BY :: Constr
$cISC :: Constr
$cBSD_4_Clause :: Constr
$cBSD_3_Clause :: Constr
$cBSD_2_Clause :: Constr
$cArtistic :: Constr
$cApache :: Constr
$cPublic_Domain :: Constr
$tLicense :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> License -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> License -> u
gmapQ :: (forall d. Data d => d -> u) -> License -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> License -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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 = String -> Doc
text String
"public-domain"
    pretty License
Apache = String -> Doc
text String
"Apache"
    pretty License
Artistic = String -> Doc
text String
"Artistic"
    pretty License
BSD_2_Clause = String -> Doc
text String
"BSD-2-clause"
    pretty License
BSD_3_Clause = String -> Doc
text String
"BSD-3-clause"
    pretty License
BSD_4_Clause = String -> Doc
text String
"BSD-4-clause"
    pretty License
ISC = String -> Doc
text String
"ISC"
    pretty License
CC_BY = String -> Doc
text String
"CC-BY"
    pretty License
CC_BY_SA = String -> Doc
text String
"CC-BY-SA"
    pretty License
CC_BY_ND = String -> Doc
text String
"CC-BY-ND"
    pretty License
CC_BY_NC = String -> Doc
text String
"CC-BY-NC"
    pretty License
CC_BY_NC_SA = String -> Doc
text String
"CC-BY-NC-SA"
    pretty License
CC_BY_NC_ND = String -> Doc
text String
"CC-BY-NC-ND"
    pretty License
CC0 = String -> Doc
text String
"CC0"
    pretty License
CDDL = String -> Doc
text String
"CDDL"
    pretty License
CPL = String -> Doc
text String
"CPL"
    pretty License
EFL = String -> Doc
text String
"EFL"
    pretty License
Expat = String -> Doc
text String
"Expat"
    pretty License
GPL = String -> Doc
text String
"GPL"
    pretty License
LGPL = String -> Doc
text String
"LGPL"
    pretty License
GFDL = String -> Doc
text String
"GFDL"
    pretty License
GFDL_NIV = String -> Doc
text String
"GFDL-NIV"
    pretty License
LPPL = String -> Doc
text String
"LPPL"
    pretty License
MPL = String -> Doc
text String
"MPL"
    pretty License
Perl = String -> Doc
text String
"Perl"
    pretty License
Python = String -> Doc
text String
"Python"
    pretty License
QPL = String -> Doc
text String
"QPL"
    pretty License
W3C = String -> Doc
text String
"W3C"
    pretty License
Zlib = String -> Doc
text String
"Zlib"
    pretty License
Zope = String -> Doc
text String
"Zope"
    pretty (OtherLicense String
s) = String -> Doc
text String
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
_ -> String -> License
OtherLicense (License -> String
forall a. Show a => a -> String
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 -> String -> License
OtherLicense String
"AllRightsReserved"
      License
Cabal.OtherLicense -> String -> License
OtherLicense (License -> String
forall a. Show a => a -> String
show License
x)
      Cabal.UnknownLicense String
_ -> String -> License
OtherLicense (License -> String
forall a. Show a => a -> String
show License
x)
      Cabal.MPL Version
_ -> License
MPL
      License
Cabal.BSD2 -> License
BSD_2_Clause
      License
Cabal.ISC -> String -> License
OtherLicense (License -> String
forall a. Show a => a -> String
show License
x)
      License
Cabal.UnspecifiedLicense -> String -> License
OtherLicense (License -> String
forall a. Show a => a -> String
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 String
s -> String -> License
Cabal.UnknownLicense String
s
      License
_ -> String -> License
Cabal.UnknownLicense (License -> String
forall a. Show a => a -> String
show License
x)

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

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