PackageId.hs

{-# LANGUAGE CPP #-}
{-|
Module      : Portage.PackageId
License     : GPL-3+
Maintainer  : haskell@gentoo.org

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 qualified Distribution.Compat.CharParsing as P
import qualified Distribution.Package as Cabal
import           Distribution.Parsec (CabalParsing(..), Parsec(..), explicitEitherParsec)
import           Distribution.Pretty (Pretty(..), prettyShow)

import qualified Portage.Version as Portage

import           Control.DeepSeq (NFData(..))
import qualified Data.Char as Char
import qualified Text.PrettyPrint as Disp
import           Text.PrettyPrint ((<>))
import           System.FilePath ((</>))

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

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

-- | Portage-style 'PackageName', containing a 'Category' and a 'Cabal.PackageName'.
data PackageName = PackageName { category :: Category, cabalPkgName :: Cabal.PackageName }
  deriving (Eq, Ord, Show, Read)

-- | Portage-style 'PackageId', containing a 'PackageName' and a 'Portage.Version'.
data PackageId = PackageId { packageId :: PackageName, pkgVersion :: Portage.Version }
  deriving (Eq, Ord, Show, Read)

instance NFData Category where
  rnf (Category c) = rnf c

instance Pretty Category where
  pretty (Category c) = Disp.text c

instance Parsec Category where
  parsec = Category <$> P.munch1 categoryChar
    where
      categoryChar c = Char.isAlphaNum c || c == '-'

instance NFData PackageName where
  rnf (PackageName c pn) = rnf c `seq` rnf pn

instance Pretty PackageName where
  pretty (PackageName cat name) =
    pretty cat <> Disp.char '/' <> pretty name

instance Parsec PackageName where
  parsec = do
    cat <- parsec
    _ <- P.char '/'
    name <- parseCabalPackageName
    return $ PackageName cat name

instance NFData PackageId where
  rnf (PackageId pId pv) = rnf pId `seq` rnf pv

instance Pretty PackageId where
  pretty (PackageId name version) =
    pretty name <> Disp.char '-' <> pretty version

instance Parsec PackageId where
  parsec = do
    name <- parsec
    _ <- P.char '-'
    version <- parsec
    return $ PackageId name version

-- | Transform a 'PackageId' into a 'FilePath'.
-- 
-- >>> packageIdToFilePath (PackageId (PackageName (Category "dev-haskell") (Cabal.mkPackageName "foo-bar2")) (Portage.Version [3,0,0] (Just 'b') [Portage.RC 2] 1 ))
-- "dev-haskell/foo-bar2/foo-bar2-3.0.0b_rc2-r1.ebuild"
packageIdToFilePath :: PackageId -> FilePath
packageIdToFilePath (PackageId (PackageName cat pn) version) =
  prettyShow cat </> prettyShow pn </> prettyShow pn <-> prettyShow version <.> "ebuild"
  where
    a <-> b = a ++ '-':b
    a <.> b = a ++ '.':b

-- | Maybe generate a 'PackageId' from a 'FilePath'. Note that the 'FilePath' must have its
-- file extension stripped before being passed to 'filePathToPackageId'.
-- 
-- >>> filePathToPackageId (Category "dev-haskell") "foo-bar2-3.0.0b_rc2-r1"
-- Just (PackageId {packageId = PackageName {category = Category {unCategory = "dev-haskell"}, cabalPkgName = PackageName "foo-bar2"}, pkgVersion = Version {versionNumber = [3,0,0], versionChar = Just 'b', versionSuffix = [RC 2], versionRevision = 1}})
filePathToPackageId :: Category -> FilePath -> Maybe PackageId
filePathToPackageId cat fp =
  case explicitEitherParsec parser fp of
    Right x -> Just x
    _ -> Nothing
  where
    parser = do
      pn <- parseCabalPackageName
      _ <- P.char '-'
      v <- parsec
      return $ PackageId (PackageName cat pn) v

-- | Create a 'PackageName' from supplied category and package name 'String's.
mkPackageName :: String -> String -> PackageName
mkPackageName cat package = PackageName (Category cat) (Cabal.mkPackageName package)

-- | Create a 'PackageId' from a 'Category' and 'Cabal.PackageIdentifier'.
fromCabalPackageId :: Category -> Cabal.PackageIdentifier -> PackageId
fromCabalPackageId cat (Cabal.PackageIdentifier name version) =
  PackageId (PackageName cat (normalizeCabalPackageName name))
            (Portage.fromCabalVersion version)

-- | Convert a 'Cabal.PackageName' into lowercase. Internally uses
-- 'cabal_pn_to_PN'.
--
-- >>> normalizeCabalPackageName (Cabal.mkPackageName "FooBar1")
-- PackageName "foobar1"
normalizeCabalPackageName :: Cabal.PackageName -> Cabal.PackageName
normalizeCabalPackageName =
  Cabal.mkPackageName . cabal_pn_to_PN

-- | Apply 'normalizeCabalPackageName' to the 'Cabal.PackageName' of
-- a supplied 'Cabal.PackageIdentifier'.
normalizeCabalPackageId :: Cabal.PackageIdentifier -> Cabal.PackageIdentifier
normalizeCabalPackageId (Cabal.PackageIdentifier name version) =
  Cabal.PackageIdentifier (normalizeCabalPackageName name) version

-- | Convert a 'PackageId' into a 'Maybe' 'Cabal.PackageIdentifier'.
toCabalPackageId :: PackageId -> Maybe Cabal.PackageIdentifier
toCabalPackageId (PackageId (PackageName _cat name) version) =
  fmap (Cabal.PackageIdentifier name)
           (Portage.toCabalVersion version)

-- | Parse a 'String' as a package in the form of @[category\/]name[-version]@:
--
-- Note that we /cannot/ use the 'parsec' function to parse the 'Cabal.PackageName',
-- since it fails the entire parse if it tries to parse a 'Version'.
-- See 'parseCabalPackageName' below.
--
-- If parsing a valid package string:
-- 
-- >>> parseFriendlyPackage "category-name/package-name1-0.0.0.1a_beta2-r4"
-- Right (Just (Category {unCategory = "category-name"}),PackageName "package-name1",Just (Version {versionNumber = [0,0,0,1], versionChar = Just 'a', versionSuffix = [Beta 2], versionRevision = 4}))
--
-- If malformed, return an error string:
--
-- >>> parseFriendlyPackage "category-name/package-name-1-0.0.0.1a_beta2-r4"
-- Left ...
parseFriendlyPackage :: String -> Either String (Maybe Category, Cabal.PackageName, Maybe Portage.Version)
parseFriendlyPackage str = explicitEitherParsec parser str
  where
  parser = do
    mc <- P.optional . P.try $ do
      c <- parsec
      _ <- P.char '/'
      return c
    p <- parseCabalPackageName
    mv <- P.optional $ do
      _ <- P.char '-'
      v <- parsec
      return v
    return (mc, p, mv)

-- | Parse a 'Cabal.PackageName'.
--
-- This parser is a replacement for 'parsecUnqualComponentName' which fails when
-- trying to parse a 'Version'.
parseCabalPackageName :: CabalParsing m => m Cabal.PackageName
parseCabalPackageName = do
  pn <- P.some . P.try $
    P.choice
    [ P.alphaNum
    , P.char '+'
    , P.char '-' <* P.notFollowedBy (P.some P.digit <* P.notFollowedBy P.letter)
    ]
  return $ Cabal.mkPackageName pn

-- | Pretty-print a lowercase 'Cabal.PackageName'.
--
-- Note the difference between this function and 'normalizeCabalPackageName':
-- this function returns a 'String', the other a 'Cabal.PackageName'.
--
-- >>> cabal_pn_to_PN (Cabal.mkPackageName "FooBar1")
-- "foobar1"
cabal_pn_to_PN :: Cabal.PackageName -> String
cabal_pn_to_PN = map Char.toLower . prettyShow