diff options
Diffstat (limited to 'src/FSD/Copyright.hs')
-rw-r--r-- | src/FSD/Copyright.hs | 106 |
1 files changed, 106 insertions, 0 deletions
diff --git a/src/FSD/Copyright.hs b/src/FSD/Copyright.hs new file mode 100644 index 0000000..68b7b50 --- /dev/null +++ b/src/FSD/Copyright.hs @@ -0,0 +1,106 @@ +{- +Copyright (C) 2022 Yuchen Pei. + +This file is part of fsd. + +fsd is free software: you can redistribute it and/or modify it under +the terms of the GNU Affero General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +fsd is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General +Public License for more details. + +You should have received a copy of the GNU Affero General Public +License along with fsd. If not, see <https://www.gnu.org/licenses/>. + +-} + +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} + +module FSD.Copyright where + +import FSD.Control +import Data.Map hiding (filter) +import Data.Maybe +import Data.Text (Text) +import Data.Text qualified as T +import Debian.Control +import Text.Regex.TDFA +import FSD.Types + +parseCopyright :: Text -> Control -> Maybe (Upstream, Copyright) +parseCopyright package control = + case unControl control of + [] -> Nothing + header : rest -> + -- no parse if header is wrong + if fromMaybe "" (firstFieldName header) /= "Format" + then Nothing + else + Just + ( getUpstream package header, + Copyright package (getLicenses (header : files) licenses) + ) + where + files = filter (\para -> + fromMaybe "" (firstFieldName para) == "Files") rest + licenses = filter + (\para -> + fromMaybe "" (firstFieldName para) == "License") rest + +getUpstream :: Text -> Paragraph -> Upstream +getUpstream package para = + Upstream package uName contacts (SourceUrls source) + where + uName = T.pack <$> fieldValue "Upstream-Name" para + contacts = case fieldValue "Upstream-Contact" para of + Just contact -> parseContacts $ lbListFV contact + Nothing -> [] + source = case fieldValue "Source" para of + Just source -> parseSource $ multilineFV source + Nothing -> [] + +parseContacts :: [Text] -> [Contact] +parseContacts = catMaybes . fmap parseContact + +parseContact :: Text -> Maybe Contact +parseContact raw = + case T.unpack raw =~ ("^(.*)<(.*@.*)>$" :: String) :: [[String]] of + [[_, "", email]] -> Just $ Contact Nothing (T.pack email) + [[_, name, email]] -> + Just $ + Contact + (Just $ T.strip $ T.pack name) + (T.pack email) + _ -> Nothing + +parseSource :: Text -> [Text] +parseSource = fmap T.strip . T.splitOn "\n" + +getLicenses :: [Paragraph] -> [Paragraph] -> [LicenseInfo] +getLicenses paras licenses = + catMaybes $ getLicense (getLicenseMap licenses) <$> paras + +getLicense :: Map Text Text -> Paragraph -> Maybe LicenseInfo +getLicense licMap para = case fSynFV <$> fieldValue "License" para of + Just ("", _) -> Nothing + Nothing -> Nothing + Just (name, desc) -> + Just $ + LicenseInfo + (multilineFV <$> fieldValue "Copyright" para) + name + (if T.null desc then Data.Map.lookup name licMap else Just desc) + +getLicenseMap :: [Paragraph] -> Map Text Text +getLicenseMap licenses = fromList $ catMaybes $ toPair <$> licenses + where + toPair license = case fSynFV <$> fieldValue "License" license of + Just ("", _) -> Nothing + Just (_, "") -> Nothing + Just (name, desc) -> Just (name, desc) + Nothing -> Nothing |