Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
242 lines (212 sloc) 7.74 KB
{-# LANGUAGE CPP #-}
module Portage.EBuild
( EBuild(..)
, ebuildTemplate
, showEBuild
, src_uri
) where
import Portage.Dependency
import qualified Portage.Dependency.Normalize as PN
import Data.String.Utils
import qualified Data.Time.Clock as TC
import qualified Data.Time.Format as TC
import qualified Data.Function as F
import qualified Data.List as L
import Data.Version(Version(..))
import qualified Paths_hackport(version)
#if ! MIN_VERSION_time(1,5,0)
import qualified System.Locale as TC
#endif
data EBuild = EBuild {
name :: String,
category :: String,
hackage_name :: String, -- might differ a bit (we mangle case)
version :: String,
hackportVersion :: String,
description :: String,
long_desc :: String,
homepage :: String,
license :: Either String String,
slot :: String,
keywords :: [String],
iuse :: [String],
depend :: Dependency,
depend_extra :: [String],
rdepend :: Dependency,
rdepend_extra :: [String],
features :: [String],
my_pn :: Maybe String -- ^ Just 'myOldName' if the package name contains upper characters
, src_prepare :: [String] -- ^ raw block for src_prepare() contents
, src_configure :: [String] -- ^ raw block for src_configure() contents
, used_options :: [(String, String)] -- ^ hints to ebuild writers/readers
-- on what hackport options were used to produce an ebuild
}
getHackportVersion :: Version -> String
getHackportVersion Version {versionBranch=(x:s)} = foldl (\y z -> y ++ "." ++ (show z)) (show x) s
getHackportVersion Version {versionBranch=[]} = ""
ebuildTemplate :: EBuild
ebuildTemplate = EBuild {
name = "foobar",
category = "dev-haskell",
hackage_name = "FooBar",
version = "0.1",
hackportVersion = getHackportVersion Paths_hackport.version,
description = "",
long_desc = "",
homepage = "http://hackage.haskell.org/package/${HACKAGE_N}",
license = Left "unassigned license?",
slot = "0",
keywords = ["~amd64","~x86"],
iuse = [],
depend = empty_dependency,
depend_extra = [],
rdepend = empty_dependency,
rdepend_extra = [],
features = [],
my_pn = Nothing
, src_prepare = []
, src_configure = []
, used_options = []
}
-- | Given an EBuild, give the URI to the tarball of the source code.
-- Assumes that the server is always hackage.haskell.org.
src_uri :: EBuild -> String
src_uri e =
case my_pn e of
-- use standard address given that the package name has no upper
-- characters
Nothing -> "http://hackage.haskell.org/packages/archive/${PN}/${PV}/${P}.tar.gz"
-- use MY_X variables (defined in showEBuild) as we've renamed the
-- package
Just _ -> "http://hackage.haskell.org/packages/archive/${MY_PN}/${PV}/${MY_P}.tar.gz"
showEBuild :: TC.UTCTime -> EBuild -> String
showEBuild now ebuild =
ss ("# Copyright 1999-" ++ this_year ++ " Gentoo Foundation"). nl.
ss "# Distributed under the terms of the GNU General Public License v2". nl.
ss "# $Id$". nl.
nl.
ss "EAPI=6". nl.
nl.
ss ("# ebuild generated by hackport " ++ hackportVersion ebuild). nl.
sconcat (map (\(k, v) -> ss "#hackport: " . ss k . ss ": " . ss v . nl) $ used_options ebuild).
nl.
ss "CABAL_FEATURES=". quote' (sepBy " " $ features ebuild). nl.
ss "inherit haskell-cabal". nl.
nl.
(case my_pn ebuild of
Nothing -> id
Just pn -> ss "MY_PN=". quote pn. nl.
ss "MY_P=". quote "${MY_PN}-${PV}". nl. nl).
ss "DESCRIPTION=". quote (drop_tdot $ description ebuild). nl.
ss "HOMEPAGE=". quote (toHttps $ expandVars (homepage ebuild)). nl.
ss "SRC_URI=". quote (toMirror $ src_uri ebuild). nl.
nl.
ss "LICENSE=". (either (\err -> quote "" . ss ("\t# FIXME: " ++ err))
quote
(license ebuild)). nl.
ss "SLOT=". quote (slot ebuild). nl.
ss "KEYWORDS=". quote' (sepBy " " $ keywords ebuild).nl.
ss "IUSE=". quote' (sepBy " " . sort_iuse $ iuse ebuild). nl.
nl.
dep_str "RDEPEND" (rdepend_extra ebuild) (rdepend ebuild).
dep_str "DEPEND" ( depend_extra ebuild) ( depend ebuild).
(case my_pn ebuild of
Nothing -> id
Just _ -> nl. ss "S=". quote ("${WORKDIR}/${MY_P}"). nl).
verbatim (nl . ss "src_prepare() {" . nl)
(src_prepare ebuild)
(ss "}" . nl).
verbatim (nl. ss "src_configure() {" . nl)
(src_configure ebuild)
(ss "}" . nl).
id $ []
where
expandVars = replaceMultiVars [ ( name ebuild, "${PN}")
, (hackage_name ebuild, "${HACKAGE_N}")
]
toMirror = replace "http://hackage.haskell.org/" "mirror://hackage/"
-- TODO: this needs to be more generic
toHttps = replace "http://github.com/" "https://github.com/"
this_year :: String
this_year = TC.formatTime TC.defaultTimeLocale "%Y" now
-- "+a" -> "a"
-- "b" -> "b"
sort_iuse :: [String] -> [String]
sort_iuse = L.sortBy (compare `F.on` dropWhile ( `elem` "+"))
-- drops trailing dot
drop_tdot :: String -> String
drop_tdot = reverse . dropWhile (== '.') . reverse
type DString = String -> String
ss :: String -> DString
ss = showString
sc :: Char -> DString
sc = showChar
nl :: DString
nl = sc '\n'
verbatim :: DString -> [String] -> DString -> DString
verbatim pre s post =
if null s
then id
else pre .
(foldl (\acc v -> acc . ss "\t" . ss v . nl) id s) .
post
sconcat :: [DString] -> DString
sconcat = L.foldl' (.) id
-- takes string and substitutes tabs to spaces
-- ebuild's convention is 4 spaces for one tab,
-- BUT! nested USE flags get moved too much to
-- right. Thus 8 :]
tab_size :: Int
tab_size = 8
tabify_line :: String -> String
tabify_line l = replicate need_tabs '\t' ++ nonsp
where (sp, nonsp) = break (/= ' ') l
(full_tabs, t) = length sp `divMod` tab_size
need_tabs = full_tabs + if t > 0 then 1 else 0
tabify :: String -> String
tabify = unlines . map tabify_line . lines
dep_str :: String -> [String] -> Dependency -> DString
dep_str var extra dep = ss var. sc '='. quote' (ss $ drop_leadings $ unlines extra ++ deps_s). nl
where indent = 1 * tab_size
deps_s = tabify (dep2str indent $ PN.normalize_depend dep)
drop_leadings = dropWhile (== '\t')
quote :: String -> DString
quote str = sc '"'. ss (esc str). sc '"'
where
esc = concatMap esc'
esc' c =
case c of
'"' -> "\\\""
'\n' -> " "
'`' -> "'"
_ -> [c]
quote' :: DString -> DString
quote' str = sc '"'. str. sc '"'
sepBy :: String -> [String] -> ShowS
sepBy _ [] = id
sepBy _ [x] = ss x
sepBy s (x:xs) = ss x. ss s. sepBy s xs
getRestIfPrefix ::
String -> -- ^ the prefix
String -> -- ^ the string
Maybe String
getRestIfPrefix (p:ps) (x:xs) = if p==x then getRestIfPrefix ps xs else Nothing
getRestIfPrefix [] rest = Just rest
getRestIfPrefix _ [] = Nothing
subStr ::
String -> -- ^ the search string
String -> -- ^ the string to be searched
Maybe (String,String) -- ^ Just (pre,post) if string is found
subStr sstr str = case getRestIfPrefix sstr str of
Nothing -> if null str then Nothing else case subStr sstr (tail str) of
Nothing -> Nothing
Just (pre,post) -> Just (head str:pre,post)
Just rest -> Just ([],rest)
replaceMultiVars ::
[(String,String)] -> -- ^ pairs of variable name and content
String -> -- ^ string to be searched
String -- ^ the result
replaceMultiVars [] str = str
replaceMultiVars whole@((pname,cont):rest) str = case subStr cont str of
Nothing -> replaceMultiVars rest str
Just (pre,post) -> (replaceMultiVars rest pre)++pname++(replaceMultiVars whole post)
Something went wrong with that request. Please try again.