module Distribution.ArchLinux.PkgBuild (
PkgBuild(..),
emptyPkgBuild,
AnnotatedPkgBuild(..),
ArchList(..),
ArchDep(..),
pkgnameFromArchDep,
decodePackage,
pkg2doc
) where
import Distribution.Text
import Distribution.Version
import Distribution.PackageDescription
import Distribution.Package
import Distribution.License
import Text.PrettyPrint
import Data.List
import Data.Monoid
import Data.Maybe
import Debug.Trace
import Control.Monad
import Control.Monad.Instances
import Data.Char
import Numeric
data PkgBuild =
PkgBuild
{ arch_pkgname :: String
, arch_pkgver :: Version
, arch_pkgrel :: !Int
, arch_pkgdesc :: String
, arch_arch :: ArchList ArchArch
, arch_url :: String
, arch_license :: ArchList License
, arch_makedepends :: ArchList ArchDep
, arch_depends :: ArchList ArchDep
, arch_source :: ArchList String
, arch_md5sum :: ArchList String
, arch_build :: [String]
, arch_package :: [String]
, arch_install :: Maybe String
, arch_options :: ArchList ArchOptions
}
deriving (Show, Eq)
data ArchOptions
= Strip
deriving (Show, Eq)
emptyPkgBuild :: PkgBuild
emptyPkgBuild =
PkgBuild
{ arch_pkgname = display $ pkgName (package e)
, arch_pkgver = pkgVersion (package e)
, arch_pkgrel = 1
, arch_pkgdesc = synopsis e
, arch_arch = ArchList [Arch_X86, Arch_X86_64]
, arch_url = homepage e
, arch_license = ArchList [license e]
, arch_makedepends = ArchList
[(ArchDep (Dependency (PackageName "ghc") AnyVersion))
,(ArchDep (Dependency (PackageName "haskell-cabal") AnyVersion))
]
, arch_depends = ArchList []
, arch_source = ArchList []
, arch_md5sum = ArchList []
, arch_build = []
, arch_package = []
, arch_install = Nothing
, arch_options = ArchList [Strip]
}
where
e = emptyPackageDescription
newtype ArchDep = ArchDep Dependency
deriving (Eq,Show)
instance Text ArchOptions where
disp Strip = text "strip"
parse = undefined
instance Text ArchDep where
disp (ArchDep (Dependency name ver)) =
text (display name) <> mydisp ver
where
mydisp AnyVersion = empty
mydisp (ThisVersion v) = text "=" <> disp v
mydisp (LaterVersion v) = char '>' <> disp v
mydisp (EarlierVersion v) = char '<' <> disp v
mydisp (UnionVersionRanges (ThisVersion v1) (LaterVersion v2))
| v1 == v2 = text ">=" <> disp v1
mydisp (UnionVersionRanges (LaterVersion v2) (ThisVersion v1))
| v1 == v2 = text ">=" <> disp v1
mydisp (UnionVersionRanges (ThisVersion v1) (EarlierVersion v2))
| v1 == v2 = text "<=" <> disp v1
mydisp (UnionVersionRanges (EarlierVersion v2) (ThisVersion v1))
| v1 == v2 = text "<=" <> disp v1
mydisp x = trace ("WARNING: Can't handle this version format yet: " ++ show x ++ "\ncheck the dependencies by hand.")$ empty
parse = undefined
pkgnameFromArchDep :: ArchDep -> String
pkgnameFromArchDep (ArchDep (Dependency (PackageName p) v)) = p
data ArchArch = Arch_X86 | Arch_X86_64
deriving (Show, Eq)
instance Text ArchArch where
disp x = case x of
Arch_X86 -> text "i686"
Arch_X86_64 -> text "x86_64"
parse = error "Text.parrse not defined for ArchList"
newtype ArchList a = ArchList [a]
deriving (Show, Eq, Monoid, Functor)
instance Text String where
disp s = text s
parse = error "Text.parse not defined for String"
instance Text a => Text (ArchList a) where
disp (ArchList xs) =
parens (hcat
(intersperse space
(map (quotes . disp) xs)))
parse = error "Text.parse not defined for ArchList"
dispNoQuotes :: Text a => ArchList a -> Doc
dispNoQuotes (ArchList xs) =
parens (hcat
(intersperse space
(map disp xs)))
data AnnotatedPkgBuild =
AnnotatedPkgBuild
{pkgBuiltWith :: Maybe Version
,pkgHeader :: String
,pkgBody :: PkgBuild }
deriving (Eq, Show)
emptyPkg :: AnnotatedPkgBuild
emptyPkg = AnnotatedPkgBuild
{ pkgBuiltWith = Nothing
, pkgHeader = []
, pkgBody = emptyPkgBuild { arch_options = ArchList []
, arch_makedepends = ArchList []
}
}
type ResultP a = Either String a
decodePackage :: String -> ResultP AnnotatedPkgBuild
decodePackage s = runGetPKG (readPackage emptyPkg) s
newtype GetPKG a = GetPKG { un :: String -> Either String (a,String) }
instance Functor GetPKG where fmap = liftM
instance Monad GetPKG where
return x = GetPKG (\s -> Right (x,s))
fail x = GetPKG (\_ -> Left x)
GetPKG m >>= f = GetPKG (\s -> case m s of
Left err -> Left err
Right (a,s1) -> un (f a) s1)
runGetPKG :: GetPKG a -> String -> ResultP a
runGetPKG (GetPKG m) s = case m s of
Left err -> Left err
Right (a,t) -> case t of
[] -> Right a
_ -> Left $ "Invalid tokens at end of PKG string: "++ show (take 10 t)
getInput :: GetPKG String
getInput = GetPKG (\s -> Right (s,s))
setInput :: String -> GetPKG ()
setInput s = GetPKG (\_ -> Right ((),s))
(<$>) :: Functor f => (a -> b) -> f a -> f b
x <$> y = fmap x y
line s = case break (== '\n') s of
(h , _ : rest) -> do
setInput rest
return h
readPackage :: AnnotatedPkgBuild -> GetPKG AnnotatedPkgBuild
readPackage st = do
cs <- getInput
case cs of
_ | "# Contributor" `isPrefixOf` cs -> do
h <- line cs
readPackage st { pkgHeader = h }
| "# Package generated" `isPrefixOf` cs -> do
h <- line cs
let v = simpleParse
. reverse
. takeWhile (not . isSpace)
. reverse $ h
readPackage st { pkgBuiltWith = v }
| "pkgname=" `isPrefixOf` cs -> do
h <- line cs
let s = drop 8 h
readPackage st { pkgBody = (pkgBody st) { arch_pkgname = s } }
| "pkgrel=" `isPrefixOf` cs -> do
h <- line cs
let s = drop 7 h
readPackage st { pkgBody = (pkgBody st) { arch_pkgrel = read s } }
| "pkgver=" `isPrefixOf` cs -> do
h <- line cs
let s = drop 7 h
case simpleParse s of
Nothing -> fail $ "Unable to parse package version"
Just v -> readPackage st { pkgBody = (pkgBody st) { arch_pkgver = v } }
| "pkgdesc=" `isPrefixOf` cs -> do
h <- line cs
let s = drop 8 h
readPackage st { pkgBody = (pkgBody st) { arch_pkgdesc = s } }
| "url=" `isPrefixOf` cs -> do
h <- line cs
let s = drop 4 h
readPackage st { pkgBody = (pkgBody st) { arch_url = s } }
| "license=" `isPrefixOf` cs -> do
h <- line cs
let s = takeWhile (/= '\'')
. drop 1
. dropWhile (/= '\'')
. drop 8 $ h
s' | "custom:" `isPrefixOf` s = drop 7 s
| otherwise = s
case simpleParse s' of
Nothing -> readPackage st { pkgBody = (pkgBody st) { arch_license = ArchList [UnknownLicense s'] } }
Just l -> readPackage st { pkgBody = (pkgBody st) { arch_license = ArchList [l] } }
| "depends=(" `isPrefixOf` cs -> do
h <- line cs
let s = drop 9 h
readPackage st { pkgBody = (pkgBody st) { arch_depends = readDepends s } }
| "makedepends=(" `isPrefixOf` cs -> do
h <- line cs
let s = drop 13 h
readPackage st { pkgBody = (pkgBody st) { arch_makedepends = readDepends s } }
| "arch=" `isPrefixOf` cs
-> do _ <- line cs ; readPackage st
| "options=" `isPrefixOf` cs
-> do _ <- line cs ; readPackage st
| "source=" `isPrefixOf` cs
-> do _ <- line cs ; readPackage st
| "install=" `isPrefixOf` cs
-> do _ <- line cs ; readPackage st
| "md5sums=" `isPrefixOf` cs
-> do _ <- line cs ; readPackage st
| "build()" `isPrefixOf` cs
-> do setInput [] ; return st
| "package()" `isPrefixOf` cs
-> do setInput [] ; return st
| "#" `isPrefixOf` cs
-> do _ <- line cs ; readPackage st
| otherwise -> fail $ "Malformed PKGBUILD: " ++ take 80 cs
readDepends :: String -> ArchList ArchDep
readDepends s =
let s1 = dropWhile (\x -> x `elem` "' )") s
in case s1 of
"" -> ArchList []
_ -> ArchList (d:ds)
where dep = takeWhile (\x -> x `notElem` "' ") s1
s2 = dropWhile (\x -> x `notElem` "' ") s1
s3 = dropWhile (\x -> x `elem` "' ") s2
d = str2archdep dep
ArchList ds = readDepends s3
str2archdep :: String -> ArchDep
str2archdep s = case v of
Nothing -> ArchDep (Dependency (PackageName name) AnyVersion)
Just w -> ArchDep (Dependency (PackageName name) w)
where name = takeWhile (\x -> x `notElem` "<=>") s
vspec = dropWhile (\x -> x `notElem` "<=>") s
v = simpleParse vspec
(<=>) :: Doc -> Doc -> Doc
x <=> y = x <> char '=' <> y
rawpkg2doc :: PkgBuild -> Doc
rawpkg2doc pkg = vcat
[ text "pkgname"
<=> text (arch_pkgname pkg)
, text "pkgrel"
<=> int (arch_pkgrel pkg)
, text "pkgver"
<=> disp (arch_pkgver pkg)
, text "pkgdesc"
<=> text (show (arch_pkgdesc pkg))
, text "url"
<=> doubleQuotes (text (arch_url pkg))
, text "license"
<=> disp (arch_license pkg)
, text "arch"
<=> disp (arch_arch pkg)
, text "makedepends"
<=> disp (arch_makedepends pkg)
, case arch_depends pkg of
ArchList [] -> empty
_ -> text "depends" <=> disp (arch_depends pkg)
, text "options" <=> disp (arch_options pkg)
, text "source"
<=> dispNoQuotes (arch_source pkg)
, case arch_install pkg of
Nothing -> empty
Just p -> text "install" <=> disp p
, text "md5sums"
<=> disp (arch_md5sum pkg)
, hang
(text "build() {") 4
(vcat $ (map text) (arch_build pkg))
$$ char '}'
, hang
(text "package() {") 4
(vcat $ (map text) (arch_package pkg))
$$ char '}'
]
instance Text PkgBuild where
disp p = rawpkg2doc p
parse = undefined
instance Text AnnotatedPkgBuild where
disp AnnotatedPkgBuild {
pkgBuiltWith = ver,
pkgHeader = head,
pkgBody = pkg
} = case ver of
Nothing -> empty
Just v -> text "# Package generated by cabal2arch" <+> (disp v)
$$ text head $$ disp pkg
parse = undefined
pkg2doc :: String -> AnnotatedPkgBuild -> Doc
pkg2doc email pkg = text "# Contributor:" <+> text email $$ disp pkg
data ArchPackage = ArchPackage
{ archpkg_pkgbuild :: AnnotatedPkgBuild
, archpkg_install :: Maybe String
, archpkg_others :: [(String, String)]
}
emptyArchPkg :: ArchPackage
emptyArchPkg = ArchPackage
{ archpkg_pkgbuild = emptyPkg
, archpkg_install = Nothing
, archpkg_others = []
}