module Debian.Debianize.Types.CopyrightDescription
( CopyrightDescription(..)
, FilesOrLicenseDescription(..)
, format
, upstreamName
, upstreamContact
, source
, disclaimer
, summaryComment
, summaryLicense
, summaryCopyright
, filesAndLicenses
, filesPattern
, filesCopyright
, filesLicense
, filesComment
, license
, comment
, newCopyrightDescription
, readCopyrightDescription
, parseCopyrightDescription
) where
import Data.Char (isSpace)
import Data.Generics (Data, Typeable)
import Data.Lens.Template (makeLenses)
import Data.List (dropWhileEnd)
import Data.Maybe (isJust, catMaybes, fromJust)
import Data.Monoid ((<>))
import Data.Text (Text, pack, unpack)
import Debian.Control (Field'(Field), lookupP, Paragraph'(Paragraph), Control'(Control, unControl), parseControl)
import Debian.Orphans ()
import Debian.Policy (License(..), readLicense)
import Debian.Pretty (PP(PP, unPP), display', ppDisplay', ppPrint)
import Network.URI (URI, parseURI)
import Prelude hiding (init, init, log, log, unlines, readFile)
import Text.PrettyPrint.HughesPJClass (Pretty(pPrint), text)
data CopyrightDescription
= CopyrightDescription
{ _format :: URI
, _upstreamName :: Maybe Text
, _upstreamContact :: Maybe Text
, _source :: Maybe Text
, _disclaimer :: Maybe Text
, _summaryComment :: Maybe Text
, _summaryLicense :: Maybe License
, _summaryCopyright :: Maybe Text
, _filesAndLicenses :: [FilesOrLicenseDescription]
} deriving (Eq, Ord, Show, Data, Typeable)
data FilesOrLicenseDescription
= FilesDescription
{ _filesPattern :: FilePath
, _filesCopyright :: Text
, _filesLicense :: License
, _filesComment :: Maybe Text
}
| LicenseDescription
{ _license :: License
, _comment :: Maybe Text
} deriving (Eq, Ord, Show, Data, Typeable)
instance Pretty (PP CopyrightDescription) where
pPrint (PP x@(CopyrightDescription {_summaryComment = Just t})) | x {_summaryComment = Nothing} == newCopyrightDescription = text (dropWhileEnd isSpace (unpack t) <> "\n")
pPrint x = ppPrint . toControlFile . unPP $ x
newCopyrightDescription :: CopyrightDescription
newCopyrightDescription =
CopyrightDescription
{ _format = fromJust $ parseURI "http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/"
, _upstreamName = Nothing
, _upstreamContact = Nothing
, _source = Nothing
, _disclaimer = Nothing
, _summaryComment = Nothing
, _summaryLicense = Nothing
, _summaryCopyright = Nothing
, _filesAndLicenses = [] }
readCopyrightDescription :: Text -> CopyrightDescription
readCopyrightDescription t =
case parseControl "debian/copyright" t of
Left _e -> newCopyrightDescription { _summaryComment = Just t }
Right ctl -> case parseCopyrightDescription (unControl ctl) of
Just cpy -> cpy
Nothing -> newCopyrightDescription { _summaryComment = Just t }
parseCopyrightDescription :: [Paragraph' Text] -> Maybe CopyrightDescription
parseCopyrightDescription (hd : tl) =
let (muri :: Maybe URI) = maybe Nothing (\ (Field (_, t)) -> parseURI . unpack $ t) (lookupP "Format" hd) in
case (muri, map parseFilesOrLicense tl) of
(Just uri, fnls) | all isJust fnls ->
Just $ CopyrightDescription
{ _format = uri
, _upstreamName = fmap (\ (Field (_, x)) -> x) $ lookupP "Upstream-Name" hd
, _upstreamContact = fmap (\ (Field (_, x)) -> x) $ lookupP "Upstream-Contact" hd
, _source = fmap (\ (Field (_, x)) -> x) $ lookupP "Source" hd
, _disclaimer = fmap (\ (Field (_, x)) -> x) $ lookupP "Disclaimer" hd
, _summaryComment = fmap (\ (Field (_, x)) -> x) $ lookupP "Comment" hd
, _summaryLicense = fmap (\ (Field (_, x)) -> readLicense x) $ lookupP "License" hd
, _summaryCopyright = Nothing
, _filesAndLicenses = catMaybes fnls
}
_ -> Nothing
parseCopyrightDescription [] = Nothing
parseFilesOrLicense :: Paragraph' Text -> Maybe (FilesOrLicenseDescription)
parseFilesOrLicense p =
case (lookupP "Files" p, lookupP "Copyright" p, lookupP "License" p) of
(Just (Field (_, files)),
Just (Field (_, copyright)),
Just (Field (_, license))) ->
Just $ FilesDescription
{ _filesPattern = unpack files
, _filesCopyright = copyright
, _filesLicense = readLicense license
, _filesComment = maybe Nothing (\ (Field (_, comment)) -> Just comment) (lookupP "Comment" p) }
(Nothing,
Nothing,
Just (Field (_, license))) ->
Just $ LicenseDescription
{ _license = readLicense license
, _comment = maybe Nothing (\ (Field (_, comment)) -> Just comment) (lookupP "Comment" p) }
_ -> Nothing
toControlFile :: CopyrightDescription -> Control' Text
toControlFile d =
Control
( Paragraph
( [ Field ("Format", (" " <> ppDisplay' (_format d))) ] ++
maybe [] (\x -> [Field ("Upstream-Name", " " <> x)]) (_upstreamName d) ++
maybe [] (\x -> [Field ("Upstream-Contact", " " <> x)]) (_upstreamContact d) ++
maybe [] (\x -> [Field ("Source", " " <> x)]) (_source d) ++
maybe [] (\x -> [Field ("Disclaimer", " " <> x)]) (_disclaimer d) ++
maybe [] (\x -> [Field ("License", " " <> display' x)]) (_summaryLicense d) ++
maybe [] (\x -> [Field ("Copyright", " " <> x)]) (_summaryCopyright d) ++
maybe [] (\x -> [Field ("Comment", " " <> x)]) (_summaryComment d)) :
map toParagraph (_filesAndLicenses d) )
toParagraph :: FilesOrLicenseDescription -> Paragraph' Text
toParagraph fd@FilesDescription {} =
Paragraph $
[ Field ("Files", " " <> pack (_filesPattern fd))
, Field ("Copyright", " " <> _filesCopyright fd)
, Field ("License", " " <> display' (_filesLicense fd)) ] ++
maybe [] (\ t -> [Field ("Comment", " " <> t)]) (_filesComment fd)
toParagraph ld@LicenseDescription {} =
Paragraph $
[ Field ("License", " " <> display' (_license ld)) ] ++
maybe [] (\ t -> [Field ("Comment", " " <> t)]) (_comment ld)
$(makeLenses [''CopyrightDescription, ''FilesOrLicenseDescription])