{-|
Module      : Portage.EMeta
License     : GPL-3+
Maintainer  : haskell@gentoo.org

Functions to propagate existing ebuild information
(such as its licence, description, switched flags etc.) to
a new ebuild.
-}
module Portage.EMeta
  ( EMeta(..)
  , findExistingMeta
  ) where

import Control.Monad
import Data.Char (isSpace)
import qualified Data.List as L

import System.Directory (doesDirectoryExist, getDirectoryContents)
import System.FilePath ((</>))
import Text.Printf

-- | Extract a value of variable in \'var=\"val\"\' format.
-- There should be exactly one variable assignment in the ebuild.
-- It's a bit of an artificial limitation, but it's common for \'if / else\' blocks.
extract_quoted_string :: FilePath -> String -> String -> Maybe String
extract_quoted_string :: FilePath -> FilePath -> FilePath -> Maybe FilePath
extract_quoted_string FilePath
ebuild_path FilePath
s_ebuild FilePath
var_name =
    case (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf FilePath
var_prefix (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
ltrim) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
s_ebuild of
        []        -> Maybe FilePath
forall a. Maybe a
Nothing
        [FilePath
kw_line] -> FilePath -> Maybe FilePath
up_to_quote (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
skip_prefix (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
ltrim FilePath
kw_line
        [FilePath]
other     -> FilePath -> Maybe FilePath
forall e. FilePath -> e
bail_out (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"strange '%s' assignments:\n%s" FilePath
var_name ([FilePath] -> FilePath
unlines [FilePath]
other)

    where ltrim :: String -> String
          ltrim :: FilePath -> FilePath
ltrim = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
          var_prefix :: FilePath
var_prefix = FilePath
var_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"=\""
          skip_prefix :: [a] -> [a]
skip_prefix = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
var_prefix)
          up_to_quote :: FilePath -> Maybe FilePath
up_to_quote FilePath
l = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') FilePath
l of
                              (FilePath
"", FilePath
_)  -> Maybe FilePath
forall a. Maybe a
Nothing -- empty line
                              (FilePath
_, FilePath
"")  -> FilePath -> Maybe FilePath
forall e. FilePath -> e
bail_out (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"failed to find closing quote for '%s'" FilePath
l
                              (FilePath
val, FilePath
_) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
val
          bail_out :: String -> e
          bail_out :: FilePath -> e
bail_out FilePath
msg = FilePath -> e
forall a. HasCallStack => FilePath -> a
error (FilePath -> e) -> FilePath -> e
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%s:extract_quoted_string %s" FilePath
ebuild_path FilePath
msg

-- | Extract a value of variable in \'#hackport: var: val\' format.
-- There should be exactly one variable assignment in the ebuild.
extract_hackport_var :: FilePath -> String -> String -> Maybe String
extract_hackport_var :: FilePath -> FilePath -> FilePath -> Maybe FilePath
extract_hackport_var FilePath
ebuild_path FilePath
s_ebuild FilePath
var_name =
    case (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf FilePath
var_prefix) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
s_ebuild of
        []         -> Maybe FilePath
forall a. Maybe a
Nothing
        [FilePath
var_line] -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
skip_prefix FilePath
var_line
        [FilePath]
other      -> FilePath -> Maybe FilePath
forall e. FilePath -> e
bail_out (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"strange '%s' assignmets:\n%s" FilePath
var_name ([FilePath] -> FilePath
unlines [FilePath]
other)

    where var_prefix :: FilePath
var_prefix = FilePath
"#hackport: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
var_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": "
          skip_prefix :: [a] -> [a]
skip_prefix = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
var_prefix)
          bail_out :: String -> e
          bail_out :: FilePath -> e
bail_out FilePath
msg = FilePath -> e
forall a. HasCallStack => FilePath -> a
error (FilePath -> e) -> FilePath -> e
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%s:extract_hackport_var %s" FilePath
ebuild_path FilePath
msg

-- | Extract the existing keywords from an ebuild.
extractKeywords :: FilePath -> String -> Maybe [String]
extractKeywords :: FilePath -> FilePath -> Maybe [FilePath]
extractKeywords FilePath
ebuild_path FilePath
s_ebuild =
    FilePath -> [FilePath]
words `fmap ` FilePath -> FilePath -> FilePath -> Maybe FilePath
extract_quoted_string FilePath
ebuild_path FilePath
s_ebuild FilePath
"KEYWORDS"

-- | Extract the existing license from an ebuild.
extractLicense :: FilePath -> String -> Maybe String
extractLicense :: FilePath -> FilePath -> Maybe FilePath
extractLicense FilePath
ebuild_path FilePath
s_ebuild =
    FilePath -> FilePath -> FilePath -> Maybe FilePath
extract_quoted_string FilePath
ebuild_path FilePath
s_ebuild FilePath
"LICENSE"

-- | Extract the existing Cabal flags from an ebuild.
extractCabalFlags :: FilePath -> String -> Maybe String
extractCabalFlags :: FilePath -> FilePath -> Maybe FilePath
extractCabalFlags FilePath
ebuild_path FilePath
s_ebuild =
    FilePath -> FilePath -> FilePath -> Maybe FilePath
extract_hackport_var FilePath
ebuild_path FilePath
s_ebuild FilePath
"flags"

-- | Extract the existing description from an ebuild.
extractDescription :: FilePath -> String -> Maybe String
extractDescription :: FilePath -> FilePath -> Maybe FilePath
extractDescription FilePath
ebuild_path FilePath
s_ebuild =
    FilePath -> FilePath -> FilePath -> Maybe FilePath
extract_quoted_string FilePath
ebuild_path FilePath
s_ebuild FilePath
"DESCRIPTION"

-- | Type representing the aggregated (best inferred) metadata for a
-- new ebuild of a package.
data EMeta = EMeta { EMeta -> Maybe [FilePath]
keywords :: Maybe [String]
                   , EMeta -> Maybe FilePath
license  :: Maybe String
                   , EMeta -> Maybe FilePath
cabal_flags :: Maybe String
                   , EMeta -> Maybe FilePath
description :: Maybe String
                   }

-- | Find the existing package metadata from the last available ebuild.
findExistingMeta :: FilePath -> IO EMeta
findExistingMeta :: FilePath -> IO EMeta
findExistingMeta FilePath
pkgdir =
    do [FilePath]
ebuilds <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isSuffixOf FilePath
".ebuild") ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` do Bool
b <- FilePath -> IO Bool
doesDirectoryExist FilePath
pkgdir
                                                            if Bool
b then FilePath -> IO [FilePath]
getDirectoryContents FilePath
pkgdir
                                                                 else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
       -- TODO: version sort
       [EMeta]
e_metas <- [FilePath] -> (FilePath -> IO EMeta) -> IO [EMeta]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
ebuilds ((FilePath -> IO EMeta) -> IO [EMeta])
-> (FilePath -> IO EMeta) -> IO [EMeta]
forall a b. (a -> b) -> a -> b
$ \FilePath
e ->
                      do let e_path :: FilePath
e_path = FilePath
pkgdir FilePath -> FilePath -> FilePath
</> FilePath
e
                         FilePath
e_conts <- FilePath -> IO FilePath
readFile FilePath
e_path
                         EMeta -> IO EMeta
forall (m :: * -> *) a. Monad m => a -> m a
return EMeta :: Maybe [FilePath]
-> Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> EMeta
EMeta { keywords :: Maybe [FilePath]
keywords = FilePath -> FilePath -> Maybe [FilePath]
extractKeywords FilePath
e FilePath
e_conts
                                      , license :: Maybe FilePath
license = FilePath -> FilePath -> Maybe FilePath
extractLicense  FilePath
e FilePath
e_conts
                                      , cabal_flags :: Maybe FilePath
cabal_flags = FilePath -> FilePath -> Maybe FilePath
extractCabalFlags FilePath
e FilePath
e_conts
                                      , description :: Maybe FilePath
description = FilePath -> FilePath -> Maybe FilePath
extractDescription FilePath
e FilePath
e_conts
                                      }
       let get_latest :: [Maybe a] -> Maybe a
get_latest [Maybe a]
candidates = [Maybe a] -> Maybe a
forall a. [a] -> a
last (Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: (Maybe a -> Bool) -> [Maybe a] -> [Maybe a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe a
forall a. Maybe a
Nothing) [Maybe a]
candidates)
           aggregated_meta :: EMeta
aggregated_meta = EMeta :: Maybe [FilePath]
-> Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> EMeta
EMeta { keywords :: Maybe [FilePath]
keywords = [Maybe [FilePath]] -> Maybe [FilePath]
forall a. Eq a => [Maybe a] -> Maybe a
get_latest ([Maybe [FilePath]] -> Maybe [FilePath])
-> [Maybe [FilePath]] -> Maybe [FilePath]
forall a b. (a -> b) -> a -> b
$ (EMeta -> Maybe [FilePath]) -> [EMeta] -> [Maybe [FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map EMeta -> Maybe [FilePath]
keywords [EMeta]
e_metas
                                   , license :: Maybe FilePath
license = [Maybe FilePath] -> Maybe FilePath
forall a. Eq a => [Maybe a] -> Maybe a
get_latest ([Maybe FilePath] -> Maybe FilePath)
-> [Maybe FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ (EMeta -> Maybe FilePath) -> [EMeta] -> [Maybe FilePath]
forall a b. (a -> b) -> [a] -> [b]
map EMeta -> Maybe FilePath
license [EMeta]
e_metas
                                   , cabal_flags :: Maybe FilePath
cabal_flags = [Maybe FilePath] -> Maybe FilePath
forall a. Eq a => [Maybe a] -> Maybe a
get_latest ([Maybe FilePath] -> Maybe FilePath)
-> [Maybe FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ (EMeta -> Maybe FilePath) -> [EMeta] -> [Maybe FilePath]
forall a b. (a -> b) -> [a] -> [b]
map EMeta -> Maybe FilePath
cabal_flags [EMeta]
e_metas
                                   , description :: Maybe FilePath
description = [Maybe FilePath] -> Maybe FilePath
forall a. Eq a => [Maybe a] -> Maybe a
get_latest ([Maybe FilePath] -> Maybe FilePath)
-> [Maybe FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ (EMeta -> Maybe FilePath) -> [EMeta] -> [Maybe FilePath]
forall a b. (a -> b) -> [a] -> [b]
map EMeta -> Maybe FilePath
description [EMeta]
e_metas
                                   }
       EMeta -> IO EMeta
forall (m :: * -> *) a. Monad m => a -> m a
return EMeta
aggregated_meta