{-# LANGUAGE OverloadedStrings, MultiWayIf #-}
{-# LANGUAGE DataKinds, TypeApplications, DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving, DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Aura.Types
(
Package(..), pname, pprov, pver
, Dep(..), parseDep
, Buildable(..)
, Prebuilt(..)
, SimplePkg(..), simplepkg, simplepkg'
, Flagable(..)
, VersionDemand(..), _VersionDemand
, InstallType(..)
, DepError(..)
, Failure(..)
, Language(..)
, PkgName(..)
, PkgGroup(..)
, Provides(..)
, PackagePath(..)
, Pkgbuild(..)
, Environment(..)
, User(..)
, list
) where
import BasePrelude hiding (try)
import Control.Error.Util (hush)
import Data.Aeson (ToJSONKey, FromJSONKey)
import Data.Bitraversable
import qualified Data.ByteString.Lazy as BL
import Data.Generics.Product (field, super)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Text.Prettyprint.Doc hiding (space, list)
import Data.Text.Prettyprint.Doc.Render.Terminal
import Data.Versions hiding (Traversal')
import GHC.Generics (Generic)
import Lens.Micro
import System.Path (Path, Absolute, takeFileName, toUnrootedFilePath)
import Text.Megaparsec
import Text.Megaparsec.Char
class Flagable a where
asFlag :: a -> [String]
instance Flagable T.Text where
asFlag t = [T.unpack 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) = pb ^. field @"name"
pname (FromAUR b) = b ^. field @"name"
pprov :: Package -> Provides
pprov (FromRepo pb) = pb ^. field @"provides"
pprov (FromAUR b) = b ^. field @"provides"
pver :: Package -> Versioning
pver (FromRepo pb) = pb ^. field @"version"
pver (FromAUR b) = b ^. field @"version"
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 (a ^. super @SimplePkg) (b ^. super @SimplePkg)
compare (FromRepo a) (FromAUR b) = compare (a ^. super @SimplePkg) (b ^. super @SimplePkg)
data Buildable = Buildable { name :: !PkgName
, version :: !Versioning
, base :: !PkgName
, provides :: !Provides
, deps :: ![Dep]
, pkgbuild :: !Pkgbuild
, isExplicit :: !Bool } deriving (Eq, Ord, Show, Generic)
data Prebuilt = Prebuilt { name :: !PkgName
, version :: !Versioning
, base :: !PkgName
, provides :: !Provides } deriving (Eq, Ord, Show, Generic)
data Dep = Dep { name :: !PkgName
, demand :: !VersionDemand } deriving (Eq, Ord, Show, Generic)
parseDep :: T.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 -> pure Anything
| otherwise -> choice [ char '<' *> fmap LessThan versioning'
, string ">=" *> fmap AtLeast versioning'
, char '>' *> fmap MoreThan versioning'
, char '=' *> fmap MustBe versioning'
, pure 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 { name :: !PkgName, version :: !Versioning } deriving (Eq, Ord, Show, Generic)
simplepkg :: PackagePath -> Maybe SimplePkg
simplepkg (PackagePath t) = uncurry SimplePkg <$> bitraverse hush hush (parse n "name" t', parse v "version" t')
where t' = T.pack . toUnrootedFilePath $ takeFileName t
n :: Parsec Void T.Text PkgName
n = PkgName . T.pack <$> manyTill anyChar (try finished)
finished = char '-' *> lookAhead digitChar
v = manyTill anyChar (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' :: T.Text -> Maybe SimplePkg
simplepkg' = hush . parse parser "name-and-version"
where parser = SimplePkg <$> (PkgName <$> takeWhile1P Nothing (/= ' ')) <*> (space *> versioning')
newtype PackagePath = PackagePath { path :: Path Absolute } deriving (Eq, Generic)
instance Ord PackagePath where
compare a b | nameA /= nameB = compare (path a) (path b)
| otherwise = compare verA verB
where (nameA, verA) = f a
(nameB, verB) = f b
f = ((^? _Just . field @"name") &&& (^? _Just . field @"version")) . simplepkg
newtype Pkgbuild = Pkgbuild { pkgbuild :: BL.ByteString } deriving (Eq, Ord, Show, Generic)
data Language = English
| Japanese
| Polish
| Croatian
| Swedish
| German
| Spanish
| Portuguese
| French
| Russian
| Italian
| Serbian
| Norwegian
| Indonesia
| Chinese
deriving (Eq, Enum, Bounded, Ord, Show)
data DepError = NonExistant PkgName
| VerConflict (Doc AnsiStyle)
| Ignored (Doc AnsiStyle)
| BrokenProvides PkgName Provides PkgName
newtype Failure = Failure { failure :: Language -> Doc AnsiStyle }
type Environment = M.Map T.Text T.Text
newtype User = User { user :: T.Text } deriving (Eq, Show, Generic)
newtype PkgName = PkgName { name :: T.Text }
deriving stock (Eq, Ord, Show, Generic)
deriving newtype (Flagable, ToJSONKey, FromJSONKey, IsString)
newtype PkgGroup = PkgGroup { group :: T.Text }
deriving stock (Eq, Ord, Show, Generic)
deriving newtype (Flagable)
newtype Provides = Provides { provides :: T.Text } deriving (Eq, Ord, Show, Generic)
list :: b -> (NonEmpty a -> b) -> [a] -> b
list def f as = maybe def f $ nonEmpty as