{-
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