-- | <https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/>
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

module Debian.Debianize.CopyrightDescription
    ( CopyrightDescription(..)
    , FilesOrLicenseDescription(..)
    -- * Lenses
    , format
    , upstreamName
    , upstreamContact
    , upstreamSource
    , disclaimer
    , summaryComment
    , summaryLicense
    , summaryCopyright
    , filesAndLicenses
    , filesPattern
    , filesCopyright
    , filesLicense
    , filesLicenseText
    , filesComment
    , license
    , licenseText
    , comment
    -- * Builders
    , readCopyrightDescription
    , parseCopyrightDescription
    , defaultCopyrightDescription
    ) where

import Data.Char (isSpace)
import Data.Default (Default(def))
import Data.Either (lefts, rights)
import Data.Generics (Data, Typeable)
import Control.Lens.TH (makeLenses)
import Data.List as List (dropWhileEnd, partition)
import Data.Maybe.Extended (isJust, catMaybes, fromJust, fromMaybe, listToMaybe, nothingIf)
import Data.Text as Text (Text, pack, strip, unpack, null, lines, unlines, dropWhileEnd)
import Debian.Control (Field'(Field), fieldValue, Paragraph'(Paragraph), Control'(Control, unControl), parseControl)
import Debian.Debianize.Prelude (readFileMaybe)
import Debian.Orphans ()
import Debian.Policy (License(..), readLicense, fromCabalLicense)
import Debian.Pretty (prettyText, ppText)
import Debug.Trace
import qualified Distribution.License as Cabal (License(UnknownLicense))
import qualified Distribution.Package as Cabal
import qualified Distribution.PackageDescription as Cabal (PackageDescription(licenseFiles, copyright, licenseRaw, package, maintainer))
#if MIN_VERSION_Cabal(3,2,0)
import qualified Distribution.Utils.ShortText as ST
#endif
#if MIN_VERSION_Cabal(3,6,0)
import qualified Distribution.Utils.Path as DUP
#endif
import Network.URI (URI, parseURI)
import Prelude hiding (init, init, log, log, unlines, readFile)
import Text.PrettyPrint.HughesPJClass (text)
import Distribution.Pretty (Pretty(pretty))

unPackageName :: Cabal.PackageName -> String
unPackageName :: PackageName -> [Char]
unPackageName PackageName
p = PackageName -> [Char]
Cabal.unPackageName PackageName
p

-- | Description of the machine readable debian/copyright file.  A
-- special case is used to represeent the old style free format file -
-- if the value is equal to newCopyrightDescription except for the
-- field _summaryComment, the text in _summaryComment is the copyright
-- file.
data CopyrightDescription
    = CopyrightDescription
      { CopyrightDescription -> URI
_format :: URI
      , CopyrightDescription -> Maybe Text
_upstreamName :: Maybe Text
      , CopyrightDescription -> Maybe Text
_upstreamContact :: Maybe Text
      , CopyrightDescription -> Maybe Text
_upstreamSource :: Maybe Text
      , CopyrightDescription -> Maybe Text
_disclaimer :: Maybe Text
      , CopyrightDescription -> Maybe Text
_summaryComment :: Maybe Text
      , CopyrightDescription -> Maybe (License, Maybe Text)
_summaryLicense :: Maybe (License, Maybe Text)
      , CopyrightDescription -> Maybe Text
_summaryCopyright :: Maybe Text
      , CopyrightDescription -> [FilesOrLicenseDescription]
_filesAndLicenses :: [FilesOrLicenseDescription]
      } deriving (CopyrightDescription -> CopyrightDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyrightDescription -> CopyrightDescription -> Bool
$c/= :: CopyrightDescription -> CopyrightDescription -> Bool
== :: CopyrightDescription -> CopyrightDescription -> Bool
$c== :: CopyrightDescription -> CopyrightDescription -> Bool
Eq, Eq CopyrightDescription
CopyrightDescription -> CopyrightDescription -> Bool
CopyrightDescription -> CopyrightDescription -> Ordering
CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
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 :: CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
$cmin :: CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
max :: CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
$cmax :: CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
>= :: CopyrightDescription -> CopyrightDescription -> Bool
$c>= :: CopyrightDescription -> CopyrightDescription -> Bool
> :: CopyrightDescription -> CopyrightDescription -> Bool
$c> :: CopyrightDescription -> CopyrightDescription -> Bool
<= :: CopyrightDescription -> CopyrightDescription -> Bool
$c<= :: CopyrightDescription -> CopyrightDescription -> Bool
< :: CopyrightDescription -> CopyrightDescription -> Bool
$c< :: CopyrightDescription -> CopyrightDescription -> Bool
compare :: CopyrightDescription -> CopyrightDescription -> Ordering
$ccompare :: CopyrightDescription -> CopyrightDescription -> Ordering
Ord, Int -> CopyrightDescription -> ShowS
[CopyrightDescription] -> ShowS
CopyrightDescription -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CopyrightDescription] -> ShowS
$cshowList :: [CopyrightDescription] -> ShowS
show :: CopyrightDescription -> [Char]
$cshow :: CopyrightDescription -> [Char]
showsPrec :: Int -> CopyrightDescription -> ShowS
$cshowsPrec :: Int -> CopyrightDescription -> ShowS
Show, Typeable CopyrightDescription
CopyrightDescription -> DataType
CopyrightDescription -> Constr
(forall b. Data b => b -> b)
-> CopyrightDescription -> CopyrightDescription
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) -> CopyrightDescription -> u
forall u.
(forall d. Data d => d -> u) -> CopyrightDescription -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CopyrightDescription -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CopyrightDescription -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CopyrightDescription
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CopyrightDescription
-> c CopyrightDescription
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CopyrightDescription)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CopyrightDescription)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CopyrightDescription -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CopyrightDescription -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CopyrightDescription -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CopyrightDescription -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CopyrightDescription -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CopyrightDescription -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CopyrightDescription -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CopyrightDescription -> r
gmapT :: (forall b. Data b => b -> b)
-> CopyrightDescription -> CopyrightDescription
$cgmapT :: (forall b. Data b => b -> b)
-> CopyrightDescription -> CopyrightDescription
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CopyrightDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CopyrightDescription)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CopyrightDescription)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CopyrightDescription)
dataTypeOf :: CopyrightDescription -> DataType
$cdataTypeOf :: CopyrightDescription -> DataType
toConstr :: CopyrightDescription -> Constr
$ctoConstr :: CopyrightDescription -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CopyrightDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CopyrightDescription
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CopyrightDescription
-> c CopyrightDescription
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CopyrightDescription
-> c CopyrightDescription
Data, Typeable)

data FilesOrLicenseDescription
    = FilesDescription
      { FilesOrLicenseDescription -> [Char]
_filesPattern :: FilePath
      , FilesOrLicenseDescription -> Text
_filesCopyright :: Text
      , FilesOrLicenseDescription -> License
_filesLicense :: License
      , FilesOrLicenseDescription -> Maybe Text
_filesLicenseText :: Maybe Text
      , FilesOrLicenseDescription -> Maybe Text
_filesComment :: Maybe Text
      }
    | LicenseDescription
      { FilesOrLicenseDescription -> License
_license :: License
      , FilesOrLicenseDescription -> Maybe Text
_licenseText :: Maybe Text
      , FilesOrLicenseDescription -> Maybe Text
_comment :: Maybe Text
      } deriving (FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
$c/= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
== :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
$c== :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
Eq, Eq FilesOrLicenseDescription
FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
FilesOrLicenseDescription -> FilesOrLicenseDescription -> Ordering
FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
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 :: FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
$cmin :: FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
max :: FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
$cmax :: FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
>= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
$c>= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
> :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
$c> :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
<= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
$c<= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
< :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
$c< :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
compare :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Ordering
$ccompare :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Ordering
Ord, Int -> FilesOrLicenseDescription -> ShowS
[FilesOrLicenseDescription] -> ShowS
FilesOrLicenseDescription -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FilesOrLicenseDescription] -> ShowS
$cshowList :: [FilesOrLicenseDescription] -> ShowS
show :: FilesOrLicenseDescription -> [Char]
$cshow :: FilesOrLicenseDescription -> [Char]
showsPrec :: Int -> FilesOrLicenseDescription -> ShowS
$cshowsPrec :: Int -> FilesOrLicenseDescription -> ShowS
Show, Typeable FilesOrLicenseDescription
FilesOrLicenseDescription -> DataType
FilesOrLicenseDescription -> Constr
(forall b. Data b => b -> b)
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
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) -> FilesOrLicenseDescription -> u
forall u.
(forall d. Data d => d -> u) -> FilesOrLicenseDescription -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FilesOrLicenseDescription
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FilesOrLicenseDescription
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilesOrLicenseDescription
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilesOrLicenseDescription
-> c FilesOrLicenseDescription
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FilesOrLicenseDescription)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FilesOrLicenseDescription)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> FilesOrLicenseDescription -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> FilesOrLicenseDescription -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> FilesOrLicenseDescription -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> FilesOrLicenseDescription -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FilesOrLicenseDescription
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FilesOrLicenseDescription
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FilesOrLicenseDescription
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FilesOrLicenseDescription
-> r
gmapT :: (forall b. Data b => b -> b)
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
$cgmapT :: (forall b. Data b => b -> b)
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FilesOrLicenseDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FilesOrLicenseDescription)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FilesOrLicenseDescription)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FilesOrLicenseDescription)
dataTypeOf :: FilesOrLicenseDescription -> DataType
$cdataTypeOf :: FilesOrLicenseDescription -> DataType
toConstr :: FilesOrLicenseDescription -> Constr
$ctoConstr :: FilesOrLicenseDescription -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilesOrLicenseDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilesOrLicenseDescription
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilesOrLicenseDescription
-> c FilesOrLicenseDescription
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilesOrLicenseDescription
-> c FilesOrLicenseDescription
Data, Typeable)

instance Pretty CopyrightDescription where
    -- Special case encodes free format debian/copyright file
    pretty :: CopyrightDescription -> Doc
pretty x :: CopyrightDescription
x@(CopyrightDescription {_summaryComment :: CopyrightDescription -> Maybe Text
_summaryComment = Just Text
t}) | CopyrightDescription
x {_summaryComment :: Maybe Text
_summaryComment = forall a. Maybe a
Nothing} forall a. Eq a => a -> a -> Bool
== forall a. Default a => a
def = [Char] -> Doc
text (forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd Char -> Bool
isSpace (Text -> [Char]
unpack Text
t) forall a. Semigroup a => a -> a -> a
<> [Char]
"\n")
    pretty CopyrightDescription
x = forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. CopyrightDescription -> Control' Text
toControlFile forall a b. (a -> b) -> a -> b
$ CopyrightDescription
x

instance Default CopyrightDescription where
    def :: CopyrightDescription
def = CopyrightDescription
          { _format :: URI
_format = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe URI
parseURI [Char]
"https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/"
          , _upstreamName :: Maybe Text
_upstreamName = forall a. Maybe a
Nothing
          , _upstreamContact :: Maybe Text
_upstreamContact = forall a. Maybe a
Nothing
          , _upstreamSource :: Maybe Text
_upstreamSource = forall a. Maybe a
Nothing
          , _disclaimer :: Maybe Text
_disclaimer = forall a. Maybe a
Nothing
          , _summaryComment :: Maybe Text
_summaryComment = forall a. Maybe a
Nothing
          , _summaryLicense :: Maybe (License, Maybe Text)
_summaryLicense = forall a. Maybe a
Nothing
          , _summaryCopyright :: Maybe Text
_summaryCopyright = forall a. Maybe a
Nothing
          , _filesAndLicenses :: [FilesOrLicenseDescription]
_filesAndLicenses = [] }

-- | Read a 'CopyrightDescription' from the text one might obtain from
-- a @debian/copyright@ file.
readCopyrightDescription :: Text -> CopyrightDescription
readCopyrightDescription :: Text -> CopyrightDescription
readCopyrightDescription Text
t =
    case forall a.
ControlFunctions a =>
[Char] -> a -> Either ParseError (Control' a)
parseControl [Char]
"debian/copyright" Text
t of
      Left ParseError
_e -> forall a. Default a => a
def { _summaryComment :: Maybe Text
_summaryComment = forall a. a -> Maybe a
Just Text
t }
      Right Control' Text
ctl -> case [Paragraph' Text] -> Maybe CopyrightDescription
parseCopyrightDescription (forall a. Control' a -> [Paragraph' a]
unControl Control' Text
ctl) of
                     Just CopyrightDescription
cpy -> CopyrightDescription
cpy
                     Maybe CopyrightDescription
Nothing -> forall a. Default a => a
def { _summaryComment :: Maybe Text
_summaryComment = forall a. a -> Maybe a
Just Text
t }

-- | Try to parse a structured copyright file
parseCopyrightDescription :: [Paragraph' Text] -> Maybe CopyrightDescription
parseCopyrightDescription :: [Paragraph' Text] -> Maybe CopyrightDescription
parseCopyrightDescription (Paragraph' Text
hd : [Paragraph' Text]
tl) =
    let (Either (Paragraph' Text) URI
muri :: Either (Paragraph' Text) URI) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Paragraph' Text
hd) forall a b. b -> Either a b
Right (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing ([Char] -> Maybe URI
parseURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack) (forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Format" Paragraph' Text
hd)) in
    case (Either (Paragraph' Text) URI
muri, forall a b. (a -> b) -> [a] -> [b]
map Paragraph' Text
-> Either (Paragraph' Text) FilesOrLicenseDescription
parseFilesOrLicense [Paragraph' Text]
tl) of
      (Right URI
uri, [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) (forall a b. a -> b -> a
const Bool
True)) [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls ->
          forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CopyrightDescription
                   { _format :: URI
_format = URI
uri
                   , _upstreamName :: Maybe Text
_upstreamName = forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Upstream-Name" Paragraph' Text
hd
                   , _upstreamContact :: Maybe Text
_upstreamContact = forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Upstream-Contact" Paragraph' Text
hd
                   , _upstreamSource :: Maybe Text
_upstreamSource = forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Source" Paragraph' Text
hd
                   , _disclaimer :: Maybe Text
_disclaimer = forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Disclaimer" Paragraph' Text
hd
                   , _summaryComment :: Maybe Text
_summaryComment = forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Comment" Paragraph' Text
hd
                   , _summaryLicense :: Maybe (License, Maybe Text)
_summaryLicense = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> (License, Maybe Text)
readLicenseField (forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"License" Paragraph' Text
hd)
                   , _summaryCopyright :: Maybe Text
_summaryCopyright = forall a. Maybe a
Nothing -- fieldValue "Copyright" hd
                   , _filesAndLicenses :: [FilesOrLicenseDescription]
_filesAndLicenses = forall a b. [Either a b] -> [b]
rights [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls
                   }
      (Either (Paragraph' Text) URI
_, [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls) -> forall a. [Char] -> a -> a
trace ([Char]
"Not a parsable copyright file: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a b. [Either a b] -> [a]
lefts [Either (Paragraph' Text) URI
muri] forall a. [a] -> [a] -> [a]
++ forall a b. [Either a b] -> [a]
lefts [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls)) forall a. Maybe a
Nothing
parseCopyrightDescription [] = forall a. Maybe a
Nothing

readLicenseField :: Text -> (License, Maybe Text)
readLicenseField :: Text -> (License, Maybe Text)
readLicenseField Text
v
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
lns forall a. Ord a => a -> a -> Bool
> Int
1
    = (Text -> License
readLicense Text
firstLine, forall a. a -> Maybe a
Just Text
otherLines)
    | Bool
otherwise
    = (Text -> License
readLicense Text
v, forall a. Maybe a
Nothing)
  where
    lns :: [Text]
lns = Text -> [Text]
Text.lines Text
v
    firstLine :: Text
firstLine = forall a. [a] -> a
head [Text]
lns
    otherLines :: Text
otherLines = [Text] -> Text
Text.unlines (forall a. [a] -> [a]
tail [Text]
lns)

parseFilesOrLicense :: Paragraph' Text -> Either (Paragraph' Text) (FilesOrLicenseDescription)
parseFilesOrLicense :: Paragraph' Text
-> Either (Paragraph' Text) FilesOrLicenseDescription
parseFilesOrLicense Paragraph' Text
p =
    case (forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Files" Paragraph' Text
p, forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Copyright" Paragraph' Text
p, forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"License" Paragraph' Text
p) of
      (Just Text
files,
       Just Text
copyright,
       Just Text
license) ->
          let (License
l,Maybe Text
t) = Text -> (License, Maybe Text)
readLicenseField Text
license
          in forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FilesDescription
                    { _filesPattern :: [Char]
_filesPattern = Text -> [Char]
unpack Text
files
                    , _filesCopyright :: Text
_filesCopyright = Text
copyright
                    , _filesLicense :: License
_filesLicense = License
l
                    , _filesLicenseText :: Maybe Text
_filesLicenseText = Maybe Text
t
                    , _filesComment :: Maybe Text
_filesComment = forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Comment" Paragraph' Text
p }
      (Maybe Text
Nothing,
       Maybe Text
Nothing,
       Just Text
license) ->
          let (License
l,Maybe Text
t) = Text -> (License, Maybe Text)
readLicenseField Text
license
          in forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ LicenseDescription
                    { _license :: License
_license = License
l
                    , _licenseText :: Maybe Text
_licenseText = Maybe Text
t
                    , _comment :: Maybe Text
_comment = forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Comment" Paragraph' Text
p }
      (Maybe Text, Maybe Text, Maybe Text)
_ -> forall a b. a -> Either a b
Left Paragraph' Text
p

toControlFile :: CopyrightDescription -> Control' Text
toControlFile :: CopyrightDescription -> Control' Text
toControlFile CopyrightDescription
d =
    forall a. [Paragraph' a] -> Control' a
Control
    ( forall a. [Field' a] -> Paragraph' a
Paragraph
      ( [ forall a. (a, a) -> Field' a
Field (Text
"Format", (Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty (PP a) => a -> Text
ppText (CopyrightDescription -> URI
_format CopyrightDescription
d))) ] forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [forall a. (a, a) -> Field' a
Field (Text
"Upstream-Name", Text
" " forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_upstreamName CopyrightDescription
d) forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [forall a. (a, a) -> Field' a
Field (Text
"Upstream-Contact", Text
" " forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_upstreamContact CopyrightDescription
d) forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [forall a. (a, a) -> Field' a
Field (Text
"Source", Text
" " forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_upstreamSource CopyrightDescription
d) forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [forall a. (a, a) -> Field' a
Field (Text
"Disclaimer", Text
" " forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_disclaimer CopyrightDescription
d) forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(License
x,Maybe Text
t) -> [License -> Maybe Text -> Field' Text
toLicenseField License
x Maybe Text
t]) (CopyrightDescription -> Maybe (License, Maybe Text)
_summaryLicense CopyrightDescription
d) forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [forall a. (a, a) -> Field' a
Field (Text
"Copyright", Text
" " forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_summaryCopyright CopyrightDescription
d) forall a. [a] -> [a] -> [a]
++
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [forall a. (a, a) -> Field' a
Field (Text
"Comment", Text
" " forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_summaryComment CopyrightDescription
d)) forall a. a -> [a] -> [a]
:
      forall a b. (a -> b) -> [a] -> [b]
map FilesOrLicenseDescription -> Paragraph' Text
toParagraph (CopyrightDescription -> [FilesOrLicenseDescription]
_filesAndLicenses CopyrightDescription
d) )

toParagraph :: FilesOrLicenseDescription -> Paragraph' Text
toParagraph :: FilesOrLicenseDescription -> Paragraph' Text
toParagraph fd :: FilesOrLicenseDescription
fd@FilesDescription {} =
    forall a. [Field' a] -> Paragraph' a
Paragraph forall a b. (a -> b) -> a -> b
$
      [ forall a. (a, a) -> Field' a
Field (Text
"Files", Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (FilesOrLicenseDescription -> [Char]
_filesPattern FilesOrLicenseDescription
fd))
      , forall a. (a, a) -> Field' a
Field (Text
"Copyright", Text
" " forall a. Semigroup a => a -> a -> a
<> FilesOrLicenseDescription -> Text
_filesCopyright FilesOrLicenseDescription
fd)
      , License -> Maybe Text -> Field' Text
toLicenseField (FilesOrLicenseDescription -> License
_filesLicense FilesOrLicenseDescription
fd) (FilesOrLicenseDescription -> Maybe Text
_filesLicenseText FilesOrLicenseDescription
fd)
      ] forall a. [a] -> [a] -> [a]
++
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ Text
t -> [forall a. (a, a) -> Field' a
Field (Text
"Comment", Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t)]) (FilesOrLicenseDescription -> Maybe Text
_filesComment FilesOrLicenseDescription
fd)
toParagraph ld :: FilesOrLicenseDescription
ld@LicenseDescription {} =
    forall a. [Field' a] -> Paragraph' a
Paragraph forall a b. (a -> b) -> a -> b
$
      [ License -> Maybe Text -> Field' Text
toLicenseField (FilesOrLicenseDescription -> License
_license FilesOrLicenseDescription
ld) (FilesOrLicenseDescription -> Maybe Text
_licenseText FilesOrLicenseDescription
ld)
      ] forall a. [a] -> [a] -> [a]
++
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ Text
t -> [forall a. (a, a) -> Field' a
Field (Text
"Comment", Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t)]) (FilesOrLicenseDescription -> Maybe Text
_comment FilesOrLicenseDescription
ld)

toLicenseField :: License -> Maybe Text -> Field' Text
toLicenseField :: License -> Maybe Text -> Field' Text
toLicenseField License
l Maybe Text
t =
    forall a. (a, a) -> Field' a
Field (Text
"License", Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyText License
l forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ([Char] -> Text
Text.pack [Char]
"\n" forall a. Semigroup a => a -> a -> a
<>) Maybe Text
t)


sourceDefaultFilesDescription :: Maybe Text -> License -> FilesOrLicenseDescription
sourceDefaultFilesDescription :: Maybe Text -> License -> FilesOrLicenseDescription
sourceDefaultFilesDescription Maybe Text
copyrt License
license =
  FilesDescription {
    _filesPattern :: [Char]
_filesPattern = [Char]
"*"
  , _filesCopyright :: Text
_filesCopyright = forall a. a -> Maybe a -> a
fromMaybe Text
"(No copyright field in cabal file)" Maybe Text
copyrt
  , _filesLicense :: License
_filesLicense = License
license
  , _filesLicenseText :: Maybe Text
_filesLicenseText = forall a. Monoid a => a
mempty
  , _filesComment :: Maybe Text
_filesComment = forall a. Monoid a => a
mempty
  }



debianDefaultFilesDescription :: License -> FilesOrLicenseDescription
debianDefaultFilesDescription :: License -> FilesOrLicenseDescription
debianDefaultFilesDescription License
license =
  FilesDescription {
    _filesPattern :: [Char]
_filesPattern = [Char]
"debian/*"
  , _filesCopyright :: Text
_filesCopyright = Text
"held by the contributors mentioned in debian/changelog"
  , _filesLicense :: License
_filesLicense = License
license
  , _filesLicenseText :: Maybe Text
_filesLicenseText = forall a. Monoid a => a
mempty
  , _filesComment :: Maybe Text
_filesComment = forall a. Monoid a => a
mempty
  }

defaultLicenseDescriptions ::
    License -> [(FilePath, Maybe Text)] -> [FilesOrLicenseDescription]
defaultLicenseDescriptions :: License -> [([Char], Maybe Text)] -> [FilesOrLicenseDescription]
defaultLicenseDescriptions License
license = \case
    []         -> []
    [([Char]
_, Maybe Text
txt)] -> [License -> Maybe Text -> Maybe Text -> FilesOrLicenseDescription
LicenseDescription License
license Maybe Text
txt forall a. Maybe a
Nothing]
    [([Char], Maybe Text)]
pairs      -> forall a b. (a -> b) -> [a] -> [b]
map ([Char], Maybe Text) -> FilesOrLicenseDescription
mkLicenseDescription [([Char], Maybe Text)]
pairs
  where
    mkLicenseDescription :: ([Char], Maybe Text) -> FilesOrLicenseDescription
mkLicenseDescription ([Char]
path, Maybe Text
txt) =
      LicenseDescription {
          _license :: License
_license = License -> License
fromCabalLicense ([Char] -> License
Cabal.UnknownLicense [Char]
path)
        , _licenseText :: Maybe Text
_licenseText = Maybe Text
txt
        , _comment :: Maybe Text
_comment = forall a. Monoid a => a
mempty
        }

-- | Infer a 'CopyrightDescription' from a Cabal package description.
-- This will try to read any copyright files listed in the cabal
-- configuration.  Inputs include the license field from the cabal
-- file, the contents of the license files mentioned there, and the
-- provided @copyright0@ value.
defaultCopyrightDescription :: Cabal.PackageDescription -> IO CopyrightDescription
defaultCopyrightDescription :: PackageDescription -> IO CopyrightDescription
defaultCopyrightDescription PackageDescription
pkgDesc = do
#if MIN_VERSION_Cabal(3,6,0)
  let ([SymbolicPath PackageDir LicenseFile]
debianCopyrightPath, [SymbolicPath PackageDir LicenseFile]
otherLicensePaths) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Eq a => a -> a -> Bool
== forall from to. [Char] -> SymbolicPath from to
DUP.unsafeMakeSymbolicPath [Char]
"debian/copyright") (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
Cabal.licenseFiles PackageDescription
pkgDesc)
#else
  let (debianCopyrightPath, otherLicensePaths) = partition (== "debian/copyright") (Cabal.licenseFiles pkgDesc)
#endif
      license :: License
license =  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\License
x -> [Char] -> License
OtherLicense ([Char]
"SPDX license: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show License
x)) License -> License
fromCabalLicense forall a b. (a -> b) -> a -> b
$ PackageDescription -> Either License License
Cabal.licenseRaw PackageDescription
pkgDesc
      pkgname :: [Char]
pkgname = PackageName -> [Char]
unPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
Cabal.pkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
Cabal.package forall a b. (a -> b) -> a -> b
$ PackageDescription
pkgDesc
      maintainer :: ShortText
maintainer = PackageDescription -> ShortText
Cabal.maintainer forall a b. (a -> b) -> a -> b
$ PackageDescription
pkgDesc
  -- This is an @Nothing@ unless debian/copyright is (for some
  -- reason) mentioned in the cabal file.
#if MIN_VERSION_Cabal(3,6,0)
  Maybe Text
debianCopyrightText <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char] -> IO (Maybe Text)
readFileMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> [Char]
DUP.getSymbolicPath) [SymbolicPath PackageDir LicenseFile]
debianCopyrightPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
  [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
licenseCommentPairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char] -> IO (Maybe Text)
readFileMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> [Char]
DUP.getSymbolicPath) [SymbolicPath PackageDir LicenseFile]
otherLicensePaths forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [SymbolicPath PackageDir LicenseFile]
otherLicensePaths
#else
  debianCopyrightText <- mapM readFileMaybe debianCopyrightPath >>= return . listToMaybe . catMaybes
  licenseCommentPairs <- mapM readFileMaybe otherLicensePaths >>= return . filter (isJust . snd) . zip otherLicensePaths
#endif
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Text
debianCopyrightText of
    Just Text
t ->
        forall a. Default a => a
def { _summaryComment :: Maybe Text
_summaryComment = forall a. a -> Maybe a
Just Text
t }
    Maybe Text
Nothing ->
        -- All we have is the name of the license
        let copyrt :: Maybe Text
copyrt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
dots forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> a -> Maybe a
nothingIf (Text -> Bool
Text.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip) (ShortText -> Text
toText (PackageDescription -> ShortText
Cabal.copyright PackageDescription
pkgDesc)) in
        forall a. Default a => a
def { _filesAndLicenses :: [FilesOrLicenseDescription]
_filesAndLicenses =
                  [ Maybe Text -> License -> FilesOrLicenseDescription
sourceDefaultFilesDescription Maybe Text
copyrt License
license,
                    License -> FilesOrLicenseDescription
debianDefaultFilesDescription License
license ] forall a. [a] -> [a] -> [a]
++
#if MIN_VERSION_Cabal(3,6,0)
                  License -> [([Char], Maybe Text)] -> [FilesOrLicenseDescription]
defaultLicenseDescriptions License
license (forall a b. (a -> b) -> [a] -> [b]
map (\(SymbolicPath PackageDir LicenseFile
x,Maybe Text
y) -> (forall from to. SymbolicPath from to -> [Char]
DUP.getSymbolicPath SymbolicPath PackageDir LicenseFile
x, Maybe Text
y)) [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
licenseCommentPairs)
#else
                  defaultLicenseDescriptions license licenseCommentPairs
#endif
            , _upstreamName :: Maybe Text
_upstreamName = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ [Char]
pkgname
            , _upstreamSource :: Maybe Text
_upstreamSource = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ [Char]
"https://hackage.haskell.org/package/" forall a. [a] -> [a] -> [a]
++ [Char]
pkgname
            , _upstreamContact :: Maybe Text
_upstreamContact = forall a. (a -> Bool) -> a -> Maybe a
nothingIf Text -> Bool
Text.null (ShortText -> Text
toText ShortText
maintainer)
            }
  where
    toText :: ShortText -> Text
toText =
#if MIN_VERSION_Cabal(3,2,0)
        [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> [Char]
ST.fromShortText
#else
        pack
#endif

{-
  -- We don't really have a way to associate licenses with
  -- file patterns, so we will just cover some simple cases,
  -- a single license, no license, etc.
  -- It is possible we might interpret the license file path
  -- as a license name, so I hang on to it here.
  return $ cabalToCopyrightDescription pkgDesc licenseComments (maybe def readCopyrightDescription debianCopyrightText)
    where
      cabalToCopyrightDescription :: Cabal.PackageDescription -> [Maybe Text] -> CopyrightDescription -> CopyrightDescription
      cabalToCopyrightDescription pkgDesc licenseComments copyright0 =
          let copyrt = fmap dots $ nothingIf (Text.null . strip) (pack (Cabal.copyright pkgDesc))
              license = Cabal.license pkgDesc in
          copyright0 { _filesAndLicenses =
                           map (\ comment ->
                                    FilesDescription
                                    { _filesPattern = "*"
                                    , _filesCopyright = fromMaybe (pack "(No copyright field in cabal file)") copyrt
                                    , _filesLicense = fromCabalLicense license
                                    , _filesComment = comment }) licenseComments }
-}

-- | Replace empty lines with single dots
dots :: Text -> Text
dots :: Text -> Text
dots = [Text] -> Text
Text.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ Text
line -> if Text -> Bool
Text.null Text
line then Text
"." else Text
line) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> Text -> Text
Text.dropWhileEnd Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines

$(makeLenses ''CopyrightDescription)
$(makeLenses ''FilesOrLicenseDescription)