summaryrefslogtreecommitdiff
path: root/Portage/PackageId.hs
blob: ffaa3240eeca8404b5812ced38dfc814e3408063 (plain)
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
{-# LANGUAGE CPP #-}

-- | Portage package identifiers, which unlike Cabal ones include a category.
--
module Portage.PackageId (
    Category(..),
    PackageName(..),
    PackageId(..),
    Portage.Version(..),
    mkPackageName,
    fromCabalPackageId,
    toCabalPackageId,
    parseFriendlyPackage,
    normalizeCabalPackageName,
    normalizeCabalPackageId,
    filePathToPackageId,
    packageIdToFilePath,
    cabal_pn_to_PN
  ) where

import Data.Char

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 ((</>), dropExtension)

#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif

newtype Category = Category { unCategory :: String }
  deriving (Eq, Ord, Show, Read)

data PackageName = PackageName { category :: Category, cabalPkgName :: 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

-- | Attempt to generate a PackageId from a FilePath. If not, return
-- the provided PackageId as-is.
filePathToPackageId :: PackageId -> FilePath -> PackageId
filePathToPackageId pkgId fp = do
      -- take package name from provided FilePath
  let pn = take (length
                 $ Cabal.unPackageName . cabalPkgName . packageId
                 $ pkgId) fp
      -- drop .ebuild file extension
      p = dropExtension fp
      -- drop package name and the following dash
      v = drop ((length pn) +1) p
      c = unCategory . category . packageId $ pkgId
      -- parse and extract version
      parsed_v = case parseVersion v of
                   Just (Just my_v) -> my_v
                   _ -> pkgVersion pkgId
  -- Construct PackageId
  PackageId (mkPackageName c pn) parsed_v
  
mkPackageName :: String -> String -> PackageName
mkPackageName cat package = PackageName (Category cat) (Cabal.mkPackageName 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.mkPackageName . map Char.toLower . Cabal.unPackageName

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)

-- | Parse a String in the form of a Portage version
parseVersion :: FilePath -> Maybe (Maybe Portage.Version)
parseVersion str =
    case [ p | (p,s) <- Parse.readP_to_S parser str
           , all Char.isSpace s ] of
      [] -> Nothing
      (x:_) -> Just x
    where
      parser = do
        mv <- Parse.option Nothing $ do
                 v <- parse
                 return (Just v)
        return mv
    
cabal_pn_to_PN :: Cabal.PackageName -> String
cabal_pn_to_PN = map toLower . display