-
Notifications
You must be signed in to change notification settings - Fork 21
/
PackageId.hs
126 lines (104 loc) · 3.8 KB
/
PackageId.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
-- | Portage package identifiers, which unlike Cabal ones include a category.
--
module Portage.PackageId (
Category(..),
PackageName(..),
PackageId(..),
Portage.Version(..),
mkPackageName,
fromCabalPackageId,
toCabalPackageId,
parseFriendlyPackage,
normalizeCabalPackageName,
normalizeCabalPackageId,
packageIdToFilePath
) where
import qualified Distribution.Package as Cabal
import Distribution.Text (Text(..))
import qualified Distribution.Compat.ReadP as Parse
import qualified Portage.Version as Portage
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>))
import qualified Data.Char as Char (isAlphaNum, isSpace, toLower)
import Distribution.Text(display)
import System.FilePath ( (</>) )
newtype Category = Category { unCategory :: String }
deriving (Eq, Ord, Show, Read)
data PackageName = PackageName Category Cabal.PackageName
deriving (Eq, Ord, Show, Read)
data PackageId = PackageId { packageId :: PackageName, pkgVersion :: Portage.Version }
deriving (Eq, Ord, Show, Read)
{-
instance Text PN where
disp (PN n) = Disp.text n
parse = do
ns <- Parse.sepBy1 component (Parse.char '-')
return (PN (concat (intersperse "-" ns)))
where
component = do
cs <- Parse.munch1 Char.isAlphaNum
if all Char.isDigit cs then Parse.pfail else return cs
-- each component must contain an alphabetic character, to avoid
-- ambiguity in identifiers like foo-1 (the 1 is the version number).
-}
packageIdToFilePath :: PackageId -> FilePath
packageIdToFilePath (PackageId (PackageName cat pn) version) =
display cat </> display pn </> display pn <-> display version <.> "ebuild"
where
a <-> b = a ++ '-':b
a <.> b = a ++ '.':b
mkPackageName :: String -> String -> PackageName
mkPackageName cat package = PackageName (Category cat) (Cabal.PackageName package)
fromCabalPackageId :: Category -> Cabal.PackageIdentifier -> PackageId
fromCabalPackageId category (Cabal.PackageIdentifier name version) =
PackageId (PackageName category (normalizeCabalPackageName name))
(Portage.fromCabalVersion version)
normalizeCabalPackageName :: Cabal.PackageName -> Cabal.PackageName
normalizeCabalPackageName (Cabal.PackageName name) =
Cabal.PackageName (map Char.toLower name)
normalizeCabalPackageId :: Cabal.PackageIdentifier -> Cabal.PackageIdentifier
normalizeCabalPackageId (Cabal.PackageIdentifier name version) =
Cabal.PackageIdentifier (normalizeCabalPackageName name) version
toCabalPackageId :: PackageId -> Maybe Cabal.PackageIdentifier
toCabalPackageId (PackageId (PackageName _cat name) version) =
fmap (Cabal.PackageIdentifier name)
(Portage.toCabalVersion version)
instance Text Category where
disp (Category c) = Disp.text c
parse = fmap Category (Parse.munch1 categoryChar)
where
categoryChar c = Char.isAlphaNum c || c == '-'
instance Text PackageName where
disp (PackageName category name) =
disp category <> Disp.char '/' <> disp name
parse = do
category <- parse
_ <- Parse.char '/'
name <- parse
return (PackageName category name)
instance Text PackageId where
disp (PackageId name version) =
disp name <> Disp.char '-' <> disp version
parse = do
name <- parse
_ <- Parse.char '-'
version <- parse
return (PackageId name version)
parseFriendlyPackage :: String -> Maybe (Maybe Category, Cabal.PackageName, Maybe Portage.Version)
parseFriendlyPackage str =
case [ p | (p,s) <- Parse.readP_to_S parser str
, all Char.isSpace s ] of
[] -> Nothing
(x:_) -> Just x
where
parser = do
mc <- Parse.option Nothing $ do
c <- parse
_ <- Parse.char '/'
return (Just c)
p <- parse
mv <- Parse.option Nothing $ do
_ <- Parse.char '-'
v <- parse
return (Just v)
return (mc, p, mv)