-- | <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
(CopyrightDescription -> CopyrightDescription -> Bool)
-> (CopyrightDescription -> CopyrightDescription -> Bool)
-> Eq CopyrightDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CopyrightDescription -> CopyrightDescription -> Bool
== :: CopyrightDescription -> CopyrightDescription -> Bool
$c/= :: CopyrightDescription -> CopyrightDescription -> Bool
/= :: CopyrightDescription -> CopyrightDescription -> Bool
Eq, Eq CopyrightDescription
Eq CopyrightDescription =>
(CopyrightDescription -> CopyrightDescription -> Ordering)
-> (CopyrightDescription -> CopyrightDescription -> Bool)
-> (CopyrightDescription -> CopyrightDescription -> Bool)
-> (CopyrightDescription -> CopyrightDescription -> Bool)
-> (CopyrightDescription -> CopyrightDescription -> Bool)
-> (CopyrightDescription
    -> CopyrightDescription -> CopyrightDescription)
-> (CopyrightDescription
    -> CopyrightDescription -> CopyrightDescription)
-> Ord 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
$ccompare :: CopyrightDescription -> CopyrightDescription -> Ordering
compare :: CopyrightDescription -> CopyrightDescription -> Ordering
$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
>= :: CopyrightDescription -> CopyrightDescription -> Bool
$cmax :: CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
max :: CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
$cmin :: CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
min :: CopyrightDescription
-> CopyrightDescription -> CopyrightDescription
Ord, Int -> CopyrightDescription -> ShowS
[CopyrightDescription] -> ShowS
CopyrightDescription -> [Char]
(Int -> CopyrightDescription -> ShowS)
-> (CopyrightDescription -> [Char])
-> ([CopyrightDescription] -> ShowS)
-> Show CopyrightDescription
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyrightDescription -> ShowS
showsPrec :: Int -> CopyrightDescription -> ShowS
$cshow :: CopyrightDescription -> [Char]
show :: CopyrightDescription -> [Char]
$cshowList :: [CopyrightDescription] -> ShowS
showList :: [CopyrightDescription] -> ShowS
Show, Typeable CopyrightDescription
Typeable CopyrightDescription =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CopyrightDescription
 -> c CopyrightDescription)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CopyrightDescription)
-> (CopyrightDescription -> Constr)
-> (CopyrightDescription -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> CopyrightDescription -> CopyrightDescription)
-> (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 u.
    (forall d. Data d => d -> u) -> CopyrightDescription -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CopyrightDescription -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CopyrightDescription -> m CopyrightDescription)
-> Data CopyrightDescription
CopyrightDescription -> Constr
CopyrightDescription -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CopyrightDescription
-> c CopyrightDescription
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CopyrightDescription
-> c CopyrightDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CopyrightDescription
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CopyrightDescription
$ctoConstr :: CopyrightDescription -> Constr
toConstr :: CopyrightDescription -> Constr
$cdataTypeOf :: CopyrightDescription -> DataType
dataTypeOf :: CopyrightDescription -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CopyrightDescription)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CopyrightDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CopyrightDescription)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CopyrightDescription)
$cgmapT :: (forall b. Data b => b -> b)
-> CopyrightDescription -> CopyrightDescription
gmapT :: (forall b. Data b => b -> b)
-> CopyrightDescription -> CopyrightDescription
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CopyrightDescription -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CopyrightDescription -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> CopyrightDescription -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> CopyrightDescription -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CopyrightDescription -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CopyrightDescription -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m CopyrightDescription
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CopyrightDescription -> m 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
(FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool)
-> (FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool)
-> Eq FilesOrLicenseDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
== :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
$c/= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
/= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
Eq, Eq FilesOrLicenseDescription
Eq FilesOrLicenseDescription =>
(FilesOrLicenseDescription
 -> FilesOrLicenseDescription -> Ordering)
-> (FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool)
-> (FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool)
-> (FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool)
-> (FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool)
-> (FilesOrLicenseDescription
    -> FilesOrLicenseDescription -> FilesOrLicenseDescription)
-> (FilesOrLicenseDescription
    -> FilesOrLicenseDescription -> FilesOrLicenseDescription)
-> Ord 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
$ccompare :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Ordering
compare :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Ordering
$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
>= :: FilesOrLicenseDescription -> FilesOrLicenseDescription -> Bool
$cmax :: FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
max :: FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
$cmin :: FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
min :: FilesOrLicenseDescription
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
Ord, Int -> FilesOrLicenseDescription -> ShowS
[FilesOrLicenseDescription] -> ShowS
FilesOrLicenseDescription -> [Char]
(Int -> FilesOrLicenseDescription -> ShowS)
-> (FilesOrLicenseDescription -> [Char])
-> ([FilesOrLicenseDescription] -> ShowS)
-> Show FilesOrLicenseDescription
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilesOrLicenseDescription -> ShowS
showsPrec :: Int -> FilesOrLicenseDescription -> ShowS
$cshow :: FilesOrLicenseDescription -> [Char]
show :: FilesOrLicenseDescription -> [Char]
$cshowList :: [FilesOrLicenseDescription] -> ShowS
showList :: [FilesOrLicenseDescription] -> ShowS
Show, Typeable FilesOrLicenseDescription
Typeable FilesOrLicenseDescription =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> FilesOrLicenseDescription
 -> c FilesOrLicenseDescription)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FilesOrLicenseDescription)
-> (FilesOrLicenseDescription -> Constr)
-> (FilesOrLicenseDescription -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> FilesOrLicenseDescription -> FilesOrLicenseDescription)
-> (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 u.
    (forall d. Data d => d -> u) -> FilesOrLicenseDescription -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> FilesOrLicenseDescription -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FilesOrLicenseDescription -> m FilesOrLicenseDescription)
-> Data FilesOrLicenseDescription
FilesOrLicenseDescription -> Constr
FilesOrLicenseDescription -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilesOrLicenseDescription
-> c FilesOrLicenseDescription
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FilesOrLicenseDescription
-> c FilesOrLicenseDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilesOrLicenseDescription
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FilesOrLicenseDescription
$ctoConstr :: FilesOrLicenseDescription -> Constr
toConstr :: FilesOrLicenseDescription -> Constr
$cdataTypeOf :: FilesOrLicenseDescription -> DataType
dataTypeOf :: FilesOrLicenseDescription -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FilesOrLicenseDescription)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FilesOrLicenseDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FilesOrLicenseDescription)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FilesOrLicenseDescription)
$cgmapT :: (forall b. Data b => b -> b)
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
gmapT :: (forall b. Data b => b -> b)
-> FilesOrLicenseDescription -> FilesOrLicenseDescription
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FilesOrLicenseDescription
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FilesOrLicenseDescription
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> FilesOrLicenseDescription -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> FilesOrLicenseDescription -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> FilesOrLicenseDescription -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> FilesOrLicenseDescription -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m FilesOrLicenseDescription
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FilesOrLicenseDescription -> m 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 = Nothing} CopyrightDescription -> CopyrightDescription -> Bool
forall a. Eq a => a -> a -> Bool
== CopyrightDescription
forall a. Default a => a
def = [Char] -> Doc
text ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd Char -> Bool
isSpace (Text -> [Char]
unpack Text
t) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n")
    pretty CopyrightDescription
x = Control' Text -> Doc
forall a. Pretty a => a -> Doc
pretty (Control' Text -> Doc)
-> (CopyrightDescription -> Control' Text)
-> CopyrightDescription
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CopyrightDescription -> Control' Text
toControlFile (CopyrightDescription -> Doc) -> CopyrightDescription -> Doc
forall a b. (a -> b) -> a -> b
$ CopyrightDescription
x

instance Default CopyrightDescription where
    def :: CopyrightDescription
def = CopyrightDescription
          { _format :: URI
_format = Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe URI -> URI) -> Maybe URI -> URI
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 = Maybe Text
forall a. Maybe a
Nothing
          , _upstreamContact :: Maybe Text
_upstreamContact = Maybe Text
forall a. Maybe a
Nothing
          , _upstreamSource :: Maybe Text
_upstreamSource = Maybe Text
forall a. Maybe a
Nothing
          , _disclaimer :: Maybe Text
_disclaimer = Maybe Text
forall a. Maybe a
Nothing
          , _summaryComment :: Maybe Text
_summaryComment = Maybe Text
forall a. Maybe a
Nothing
          , _summaryLicense :: Maybe (License, Maybe Text)
_summaryLicense = Maybe (License, Maybe Text)
forall a. Maybe a
Nothing
          , _summaryCopyright :: Maybe Text
_summaryCopyright = Maybe Text
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 [Char] -> Text -> Either ParseError (Control' Text)
forall a.
ControlFunctions a =>
[Char] -> a -> Either ParseError (Control' a)
parseControl [Char]
"debian/copyright" Text
t of
      Left ParseError
_e -> CopyrightDescription
forall a. Default a => a
def { _summaryComment = Just t }
      Right Control' Text
ctl -> case [Paragraph' Text] -> Maybe CopyrightDescription
parseCopyrightDescription (Control' Text -> [Paragraph' Text]
forall a. Control' a -> [Paragraph' a]
unControl Control' Text
ctl) of
                     Just CopyrightDescription
cpy -> CopyrightDescription
cpy
                     Maybe CopyrightDescription
Nothing -> CopyrightDescription
forall a. Default a => a
def { _summaryComment = Just 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) = Either (Paragraph' Text) URI
-> (URI -> Either (Paragraph' Text) URI)
-> Maybe URI
-> Either (Paragraph' Text) URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Paragraph' Text -> Either (Paragraph' Text) URI
forall a b. a -> Either a b
Left Paragraph' Text
hd) URI -> Either (Paragraph' Text) URI
forall a b. b -> Either a b
Right (Maybe URI -> (Text -> Maybe URI) -> Maybe Text -> Maybe URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe URI
forall a. Maybe a
Nothing ([Char] -> Maybe URI
parseURI ([Char] -> Maybe URI) -> (Text -> [Char]) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack) ([Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Format" Paragraph' Text
hd)) in
    case (Either (Paragraph' Text) URI
muri, (Paragraph' Text
 -> Either (Paragraph' Text) FilesOrLicenseDescription)
-> [Paragraph' Text]
-> [Either (Paragraph' Text) FilesOrLicenseDescription]
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) | (Either (Paragraph' Text) FilesOrLicenseDescription -> Bool)
-> [Either (Paragraph' Text) FilesOrLicenseDescription] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Paragraph' Text -> Bool)
-> (FilesOrLicenseDescription -> Bool)
-> Either (Paragraph' Text) FilesOrLicenseDescription
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> Paragraph' Text -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> FilesOrLicenseDescription -> Bool
forall a b. a -> b -> a
const Bool
True)) [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls ->
          CopyrightDescription -> Maybe CopyrightDescription
forall a. a -> Maybe a
Just (CopyrightDescription -> Maybe CopyrightDescription)
-> CopyrightDescription -> Maybe CopyrightDescription
forall a b. (a -> b) -> a -> b
$ CopyrightDescription
                   { _format :: URI
_format = URI
uri
                   , _upstreamName :: Maybe Text
_upstreamName = [Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Upstream-Name" Paragraph' Text
hd
                   , _upstreamContact :: Maybe Text
_upstreamContact = [Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Upstream-Contact" Paragraph' Text
hd
                   , _upstreamSource :: Maybe Text
_upstreamSource = [Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Source" Paragraph' Text
hd
                   , _disclaimer :: Maybe Text
_disclaimer = [Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Disclaimer" Paragraph' Text
hd
                   , _summaryComment :: Maybe Text
_summaryComment = [Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Comment" Paragraph' Text
hd
                   , _summaryLicense :: Maybe (License, Maybe Text)
_summaryLicense = (Text -> (License, Maybe Text))
-> Maybe Text -> Maybe (License, Maybe Text)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> (License, Maybe Text)
readLicenseField ([Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"License" Paragraph' Text
hd)
                   , _summaryCopyright :: Maybe Text
_summaryCopyright = Maybe Text
forall a. Maybe a
Nothing -- fieldValue "Copyright" hd
                   , _filesAndLicenses :: [FilesOrLicenseDescription]
_filesAndLicenses = [Either (Paragraph' Text) FilesOrLicenseDescription]
-> [FilesOrLicenseDescription]
forall a b. [Either a b] -> [b]
rights [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls
                   }
      (Either (Paragraph' Text) URI
_, [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls) -> [Char] -> Maybe CopyrightDescription -> Maybe CopyrightDescription
forall a. [Char] -> a -> a
trace ([Char]
"Not a parsable copyright file: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Paragraph' Text] -> [Char]
forall a. Show a => a -> [Char]
show ([Either (Paragraph' Text) URI] -> [Paragraph' Text]
forall a b. [Either a b] -> [a]
lefts [Either (Paragraph' Text) URI
muri] [Paragraph' Text] -> [Paragraph' Text] -> [Paragraph' Text]
forall a. [a] -> [a] -> [a]
++ [Either (Paragraph' Text) FilesOrLicenseDescription]
-> [Paragraph' Text]
forall a b. [Either a b] -> [a]
lefts [Either (Paragraph' Text) FilesOrLicenseDescription]
fnls)) Maybe CopyrightDescription
forall a. Maybe a
Nothing
parseCopyrightDescription [] = Maybe CopyrightDescription
forall a. Maybe a
Nothing

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

parseFilesOrLicense :: Paragraph' Text -> Either (Paragraph' Text) (FilesOrLicenseDescription)
parseFilesOrLicense :: Paragraph' Text
-> Either (Paragraph' Text) FilesOrLicenseDescription
parseFilesOrLicense Paragraph' Text
p =
    case ([Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Files" Paragraph' Text
p, [Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Copyright" Paragraph' Text
p, [Char] -> Paragraph' Text -> Maybe Text
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 FilesOrLicenseDescription
-> Either (Paragraph' Text) FilesOrLicenseDescription
forall a b. b -> Either a b
Right (FilesOrLicenseDescription
 -> Either (Paragraph' Text) FilesOrLicenseDescription)
-> FilesOrLicenseDescription
-> Either (Paragraph' Text) FilesOrLicenseDescription
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 = [Char] -> Paragraph' Text -> Maybe Text
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 FilesOrLicenseDescription
-> Either (Paragraph' Text) FilesOrLicenseDescription
forall a b. b -> Either a b
Right (FilesOrLicenseDescription
 -> Either (Paragraph' Text) FilesOrLicenseDescription)
-> FilesOrLicenseDescription
-> Either (Paragraph' Text) FilesOrLicenseDescription
forall a b. (a -> b) -> a -> b
$ LicenseDescription
                    { _license :: License
_license = License
l
                    , _licenseText :: Maybe Text
_licenseText = Maybe Text
t
                    , _comment :: Maybe Text
_comment = [Char] -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => [Char] -> Paragraph' a -> Maybe a
fieldValue [Char]
"Comment" Paragraph' Text
p }
      (Maybe Text, Maybe Text, Maybe Text)
_ -> Paragraph' Text
-> Either (Paragraph' Text) FilesOrLicenseDescription
forall a b. a -> Either a b
Left Paragraph' Text
p

toControlFile :: CopyrightDescription -> Control' Text
toControlFile :: CopyrightDescription -> Control' Text
toControlFile CopyrightDescription
d =
    [Paragraph' Text] -> Control' Text
forall a. [Paragraph' a] -> Control' a
Control
    ( [Field' Text] -> Paragraph' Text
forall a. [Field' a] -> Paragraph' a
Paragraph
      ( [ (Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Format", (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> URI -> Text
forall a. Pretty (PP a) => a -> Text
ppText (CopyrightDescription -> URI
_format CopyrightDescription
d))) ] [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
        [Field' Text]
-> (Text -> [Field' Text]) -> Maybe Text -> [Field' Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Upstream-Name", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_upstreamName CopyrightDescription
d) [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
        [Field' Text]
-> (Text -> [Field' Text]) -> Maybe Text -> [Field' Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Upstream-Contact", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_upstreamContact CopyrightDescription
d) [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
        [Field' Text]
-> (Text -> [Field' Text]) -> Maybe Text -> [Field' Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Source", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_upstreamSource CopyrightDescription
d) [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
        [Field' Text]
-> (Text -> [Field' Text]) -> Maybe Text -> [Field' Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Disclaimer", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_disclaimer CopyrightDescription
d) [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
        [Field' Text]
-> ((License, Maybe Text) -> [Field' Text])
-> Maybe (License, Maybe Text)
-> [Field' Text]
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) [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
        [Field' Text]
-> (Text -> [Field' Text]) -> Maybe Text -> [Field' Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Copyright", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_summaryCopyright CopyrightDescription
d) [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
        [Field' Text]
-> (Text -> [Field' Text]) -> Maybe Text -> [Field' Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [(Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Comment", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)]) (CopyrightDescription -> Maybe Text
_summaryComment CopyrightDescription
d)) Paragraph' Text -> [Paragraph' Text] -> [Paragraph' Text]
forall a. a -> [a] -> [a]
:
      (FilesOrLicenseDescription -> Paragraph' Text)
-> [FilesOrLicenseDescription] -> [Paragraph' Text]
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 {} =
    [Field' Text] -> Paragraph' Text
forall a. [Field' a] -> Paragraph' a
Paragraph ([Field' Text] -> Paragraph' Text)
-> [Field' Text] -> Paragraph' Text
forall a b. (a -> b) -> a -> b
$
      [ (Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Files", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (FilesOrLicenseDescription -> [Char]
_filesPattern FilesOrLicenseDescription
fd))
      , (Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Copyright", Text
" " Text -> Text -> 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)
      ] [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
      [Field' Text]
-> (Text -> [Field' Text]) -> Maybe Text -> [Field' Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ Text
t -> [(Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Comment", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)]) (FilesOrLicenseDescription -> Maybe Text
_filesComment FilesOrLicenseDescription
fd)
toParagraph ld :: FilesOrLicenseDescription
ld@LicenseDescription {} =
    [Field' Text] -> Paragraph' Text
forall a. [Field' a] -> Paragraph' a
Paragraph ([Field' Text] -> Paragraph' Text)
-> [Field' Text] -> Paragraph' Text
forall a b. (a -> b) -> a -> b
$
      [ License -> Maybe Text -> Field' Text
toLicenseField (FilesOrLicenseDescription -> License
_license FilesOrLicenseDescription
ld) (FilesOrLicenseDescription -> Maybe Text
_licenseText FilesOrLicenseDescription
ld)
      ] [Field' Text] -> [Field' Text] -> [Field' Text]
forall a. [a] -> [a] -> [a]
++
      [Field' Text]
-> (Text -> [Field' Text]) -> Maybe Text -> [Field' Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ Text
t -> [(Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"Comment", Text
" " Text -> Text -> 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 =
    (Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (Text
"License", Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> License -> Text
forall a. Pretty a => a -> Text
prettyText License
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty ([Char] -> Text
Text.pack [Char]
"\n" Text -> Text -> Text
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 = Text -> Maybe Text -> Text
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 = Maybe Text
forall a. Monoid a => a
mempty
  , _filesComment :: Maybe Text
_filesComment = Maybe Text
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 = Maybe Text
forall a. Monoid a => a
mempty
  , _filesComment :: Maybe Text
_filesComment = Maybe Text
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 Maybe Text
forall a. Maybe a
Nothing]
    [([Char], Maybe Text)]
pairs      -> (([Char], Maybe Text) -> FilesOrLicenseDescription)
-> [([Char], Maybe Text)] -> [FilesOrLicenseDescription]
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 = Maybe Text
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) = (SymbolicPath PackageDir LicenseFile -> Bool)
-> [SymbolicPath PackageDir LicenseFile]
-> ([SymbolicPath PackageDir LicenseFile],
    [SymbolicPath PackageDir LicenseFile])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (SymbolicPath PackageDir LicenseFile
-> SymbolicPath PackageDir LicenseFile -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> SymbolicPath PackageDir LicenseFile
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 =  (License -> License)
-> (License -> License) -> Either License License -> License
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\License
x -> [Char] -> License
OtherLicense ([Char]
"SPDX license: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ License -> [Char]
forall a. Show a => a -> [Char]
show License
x)) License -> License
fromCabalLicense (Either License License -> License)
-> Either License License -> License
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Either License License
Cabal.licenseRaw PackageDescription
pkgDesc
      pkgname :: [Char]
pkgname = PackageName -> [Char]
unPackageName (PackageName -> [Char])
-> (PackageDescription -> PackageName)
-> PackageDescription
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
Cabal.pkgName (PackageIdentifier -> PackageName)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
Cabal.package (PackageDescription -> [Char]) -> PackageDescription -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkgDesc
      maintainer :: ShortText
maintainer = PackageDescription -> ShortText
Cabal.maintainer (PackageDescription -> ShortText)
-> PackageDescription -> ShortText
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 <- (SymbolicPath PackageDir LicenseFile -> IO (Maybe Text))
-> [SymbolicPath PackageDir LicenseFile] -> IO [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> IO (Maybe Text)
readFileMaybe ([Char] -> IO (Maybe Text))
-> (SymbolicPath PackageDir LicenseFile -> [Char])
-> SymbolicPath PackageDir LicenseFile
-> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath PackageDir LicenseFile -> [Char]
forall from to. SymbolicPath from to -> [Char]
DUP.getSymbolicPath) [SymbolicPath PackageDir LicenseFile]
debianCopyrightPath IO [Maybe Text]
-> ([Maybe Text] -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text))
-> ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
  [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
licenseCommentPairs <- (SymbolicPath PackageDir LicenseFile -> IO (Maybe Text))
-> [SymbolicPath PackageDir LicenseFile] -> IO [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> IO (Maybe Text)
readFileMaybe ([Char] -> IO (Maybe Text))
-> (SymbolicPath PackageDir LicenseFile -> [Char])
-> SymbolicPath PackageDir LicenseFile
-> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath PackageDir LicenseFile -> [Char]
forall from to. SymbolicPath from to -> [Char]
DUP.getSymbolicPath) [SymbolicPath PackageDir LicenseFile]
otherLicensePaths IO [Maybe Text]
-> ([Maybe Text]
    -> IO [(SymbolicPath PackageDir LicenseFile, Maybe Text)])
-> IO [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
-> IO [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SymbolicPath PackageDir LicenseFile, Maybe Text)]
 -> IO [(SymbolicPath PackageDir LicenseFile, Maybe Text)])
-> ([Maybe Text]
    -> [(SymbolicPath PackageDir LicenseFile, Maybe Text)])
-> [Maybe Text]
-> IO [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SymbolicPath PackageDir LicenseFile, Maybe Text) -> Bool)
-> [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
-> [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> ((SymbolicPath PackageDir LicenseFile, Maybe Text)
    -> Maybe Text)
-> (SymbolicPath PackageDir LicenseFile, Maybe Text)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolicPath PackageDir LicenseFile, Maybe Text) -> Maybe Text
forall a b. (a, b) -> b
snd) ([(SymbolicPath PackageDir LicenseFile, Maybe Text)]
 -> [(SymbolicPath PackageDir LicenseFile, Maybe Text)])
-> ([Maybe Text]
    -> [(SymbolicPath PackageDir LicenseFile, Maybe Text)])
-> [Maybe Text]
-> [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SymbolicPath PackageDir LicenseFile]
-> [Maybe Text]
-> [(SymbolicPath PackageDir LicenseFile, Maybe Text)]
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
  CopyrightDescription -> IO CopyrightDescription
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CopyrightDescription -> IO CopyrightDescription)
-> CopyrightDescription -> IO CopyrightDescription
forall a b. (a -> b) -> a -> b
$ case Maybe Text
debianCopyrightText of
    Just Text
t ->
        CopyrightDescription
forall a. Default a => a
def { _summaryComment = Just t }
    Maybe Text
Nothing ->
        -- All we have is the name of the license
        let copyrt :: Maybe Text
copyrt = (Text -> Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
dots (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> Text -> Maybe Text
forall a. (a -> Bool) -> a -> Maybe a
nothingIf (Text -> Bool
Text.null (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip) (ShortText -> Text
toText (PackageDescription -> ShortText
Cabal.copyright PackageDescription
pkgDesc)) in
        CopyrightDescription
forall a. Default a => a
def { _filesAndLicenses =
                  [ sourceDefaultFilesDescription copyrt license,
                    debianDefaultFilesDescription license ] ++
#if MIN_VERSION_Cabal(3,6,0)
                  defaultLicenseDescriptions license (map (\(SymbolicPath PackageDir LicenseFile
x,Maybe Text
y) -> (SymbolicPath PackageDir LicenseFile -> [Char]
forall from to. SymbolicPath from to -> [Char]
DUP.getSymbolicPath SymbolicPath PackageDir LicenseFile
x, Maybe Text
y)) licenseCommentPairs)
#else
                  defaultLicenseDescriptions license licenseCommentPairs
#endif
            , _upstreamName = Just . pack $ pkgname
            , _upstreamSource = Just . pack $ "https://hackage.haskell.org/package/" ++ pkgname
            , _upstreamContact = nothingIf Text.null (toText maintainer)
            }
  where
    toText :: ShortText -> Text
toText =
#if MIN_VERSION_Cabal(3,2,0)
        [Char] -> Text
pack ([Char] -> Text) -> (ShortText -> [Char]) -> ShortText -> Text
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 ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\ Text
line -> if Text -> Bool
Text.null Text
line then Text
"." else Text
line) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> Text -> Text
Text.dropWhileEnd Char -> Bool
isSpace) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines

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