{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Aura.Types
(
Package(..), pname, pprov, pver, dividePkgs
, Dep(..), parseDep, renderedDep
, Buildable(..)
, Prebuilt(..)
, SimplePkg(..), simplepkg, simplepkg', bToSP, pToSP
, Flagable(..)
, VersionDemand(..), _VersionDemand
, InstallType(..)
, DepError(..)
, Failure(..)
, Language(..)
, PkgName(..)
, PkgGroup(..)
, Provides(..)
, PackagePath, packagePath, ppPath
, Pkgbuild(..)
, Environment
, User(..)
) where
import Aura.Utils
import Data.Aeson (FromJSONKey, ToJSONKey)
import Data.Text.Prettyprint.Doc hiding (list, space)
import Data.Text.Prettyprint.Doc.Render.Terminal
import Data.Versions hiding (Traversal')
import RIO hiding (try)
import RIO.FilePath
import qualified RIO.Text as T
import Text.Megaparsec
import Text.Megaparsec.Char
class Flagable a where
asFlag :: a -> [Text]
instance Flagable Text where
asFlag t = [t]
instance (Foldable f, Flagable a) => Flagable (f a) where
asFlag = foldMap asFlag
data Package = FromRepo !Prebuilt | FromAUR !Buildable deriving (Eq)
pname :: Package -> PkgName
pname (FromRepo pb) = pName pb
pname (FromAUR b) = bName b
pprov :: Package -> Provides
pprov (FromRepo pb) = pProvides pb
pprov (FromAUR b) = bProvides b
pver :: Package -> Versioning
pver (FromRepo pb) = pVersion pb
pver (FromAUR b) = bVersion b
dividePkgs :: NonEmpty Package -> These (NonEmpty Prebuilt) (NonEmpty Buildable)
dividePkgs = partNonEmpty f
where
f :: Package -> These Prebuilt Buildable
f (FromRepo p) = This p
f (FromAUR b) = That b
instance Ord Package where
compare (FromAUR a) (FromAUR b) = compare a b
compare (FromRepo a) (FromRepo b) = compare a b
compare (FromAUR a) (FromRepo b) = compare (bToSP a) (pToSP b)
compare (FromRepo a) (FromAUR b) = compare (pToSP a) (bToSP b)
data Buildable = Buildable
{ bName :: !PkgName
, bVersion :: !Versioning
, bBase :: !PkgName
, bProvides :: !Provides
, bDeps :: ![Dep]
, bPkgbuild :: !Pkgbuild
, bIsExplicit :: !Bool }
deriving (Eq, Ord, Show, Generic)
data Prebuilt = Prebuilt
{ pName :: !PkgName
, pVersion :: !Versioning
, pBase :: !PkgName
, pProvides :: !Provides }
deriving (Eq, Ord, Show, Generic)
data Dep = Dep
{ dName :: !PkgName
, dDemand :: !VersionDemand }
deriving (Eq, Ord, Show, Generic)
parseDep :: Text -> Maybe Dep
parseDep = hush . parse dep "dep"
where dep = Dep <$> n <*> v
n = PkgName <$> takeWhile1P Nothing (\c -> c /= '<' && c /= '>' && c /= '=')
v = do
end <- atEnd
if end
then pure Anything
else choice [ char '<' *> fmap LessThan versioning'
, string ">=" *> fmap AtLeast versioning'
, char '>' *> fmap MoreThan versioning'
, char '=' *> fmap MustBe versioning'
, pure Anything ]
renderedDep :: Dep -> Text
renderedDep (Dep n ver) = pnName n <> asT ver
where
asT :: VersionDemand -> Text
asT (LessThan v) = "<" <> prettyV v
asT (AtLeast v) = ">=" <> prettyV v
asT (MoreThan v) = ">" <> prettyV v
asT (MustBe v) = "=" <> prettyV v
asT Anything = ""
data VersionDemand = LessThan !Versioning
| AtLeast !Versioning
| MoreThan !Versioning
| MustBe !Versioning
| Anything
deriving (Eq, Ord)
instance Show VersionDemand where
show (LessThan v) = T.unpack $ "<" <> prettyV v
show (AtLeast v) = T.unpack $ ">=" <> prettyV v
show (MoreThan v) = T.unpack $ ">" <> prettyV v
show (MustBe v) = T.unpack $ "=" <> prettyV v
show Anything = "Anything"
_VersionDemand :: Traversal' VersionDemand Versioning
_VersionDemand f (LessThan v) = LessThan <$> f v
_VersionDemand f (AtLeast v) = AtLeast <$> f v
_VersionDemand f (MoreThan v) = MoreThan <$> f v
_VersionDemand f (MustBe v) = MustBe <$> f v
_VersionDemand _ p = pure p
data InstallType = Pacman !PkgName | Build !Buildable deriving (Eq)
data SimplePkg = SimplePkg
{ spName :: !PkgName
, spVersion :: !Versioning }
deriving (Eq, Ord, Show, Generic)
bToSP :: Buildable -> SimplePkg
bToSP b = SimplePkg (bName b) (bVersion b)
pToSP :: Prebuilt -> SimplePkg
pToSP p = SimplePkg (pName p) (pVersion p)
simplepkg :: PackagePath -> Maybe SimplePkg
simplepkg (PackagePath t) =
uncurry SimplePkg <$> bitraverse hush hush (parse n "name" t', parse v "version" t')
where
t' :: Text
t' = T.pack $ takeFileName t
n :: Parsec Void Text PkgName
n = PkgName . T.pack <$> manyTill anySingle (try finished)
finished = char '-' *> lookAhead digitChar
v = manyTill anySingle (try finished) *> ver
ver = try (fmap Ideal semver' <* post) <|> try (fmap General version' <* post) <|> fmap Complex mess'
post = char '-' *> (string "x86_64" <|> string "any") *> string ".pkg.tar.xz"
simplepkg' :: Text -> Maybe SimplePkg
simplepkg' = hush . parse parser "name-and-version"
where parser = SimplePkg <$> (PkgName <$> takeWhile1P Nothing (/= ' ')) <*> (space *> versioning')
newtype PackagePath = PackagePath { ppPath :: FilePath }
deriving (Eq, Generic)
instance Ord PackagePath where
compare a b | nameA /= nameB = compare (ppPath a) (ppPath b)
| otherwise = compare verA verB
where
(nameA, verA) = f a
(nameB, verB) = f b
f :: PackagePath -> (Maybe PkgName, Maybe Versioning)
f = (fmap spName &&& fmap spVersion) . simplepkg
packagePath :: FilePath -> Maybe PackagePath
packagePath fp = bool Nothing (Just $ PackagePath fp) $ isAbsolute fp
newtype Pkgbuild = Pkgbuild { pkgbuild :: ByteString }
deriving (Eq, Ord, Show, Generic)
data Language = English
| Japanese
| Polish
| Croatian
| Swedish
| German
| Spanish
| Portuguese
| French
| Russian
| Italian
| Serbian
| Norwegian
| Indonesia
| Chinese
| Esperanto
| Dutch
deriving (Eq, Enum, Bounded, Ord, Show)
data DepError = NonExistant !PkgName !PkgName
| VerConflict !(Doc AnsiStyle)
| Ignored !(Doc AnsiStyle)
| BrokenProvides !PkgName !Provides !PkgName
newtype Failure = Failure { failure :: Language -> Doc AnsiStyle }
instance Exception Failure
instance Show Failure where
show (Failure _) = "There was some failure."
type Environment = Map Text Text
newtype User = User { user :: Text }
deriving (Eq, Show, Generic)
newtype PkgName = PkgName { pnName :: Text }
deriving stock (Eq, Ord, Show, Generic)
deriving newtype (Flagable, ToJSONKey, FromJSONKey, IsString)
newtype PkgGroup = PkgGroup { pgGroup :: Text }
deriving stock (Eq, Ord, Show, Generic)
deriving newtype (Flagable)
newtype Provides = Provides { provides :: PkgName }
deriving (Eq, Ord, Show, Generic)