{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module    : Aura.Types
-- Copyright : (c) Colin Woodbury, 2012 - 2021
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Core Aura types.

module Aura.Types
  ( -- * Package Types
    Package(..), pname, pprov, pver, dividePkgs
  , Dep(..), parseDep, renderedDep
  , Buildable(..)
  , Prebuilt(..)
  , SimplePkg(..), simplepkg, simplepkg', bToSP, pToSP
    -- * Typeclasses
  , Flagable(..)
    -- * Package Building
  , VersionDemand(..), _VersionDemand
  , InstallType(..)
    -- * Errors
  , DepError(..)
  , Failure(..)
  , FailMsg(..)
    -- * Language
  , Language(..)
    -- * Other Wrappers
  , PkgName(..)
  , PkgGroup(..)
  , Provides(..)
  , PackagePath, packagePath, ppPath
  , Pkgbuild(..)
  , Environment
  , User(..)
  ) where

import           Aura.Utils
import           Data.Aeson (FromJSONKey, ToJSONKey)
import           Data.Versions hiding (Traversal')
import           Prettyprinter hiding (list, space)
import           Prettyprinter.Render.Terminal
import           RIO hiding (try)
import           RIO.FilePath
import qualified RIO.Text as T
import           Text.Megaparsec
import           Text.Megaparsec.Char

---

-- | Types whose members can be converted to CLI flags.
class Flagable a where
  asFlag :: a -> [Text]

instance Flagable Text where
  asFlag :: Text -> [Text]
asFlag Text
t = [Text
t]

instance (Foldable f, Flagable a) => Flagable (f a) where
  asFlag :: f a -> [Text]
asFlag = (a -> [Text]) -> f a -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> [Text]
forall a. Flagable a => a -> [Text]
asFlag

-- | A package to be installed.
data Package = FromRepo !Prebuilt | FromAUR !Buildable deriving (Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq)

-- | The name of a `Package`.
pname :: Package -> PkgName
pname :: Package -> PkgName
pname (FromRepo Prebuilt
pb) = Prebuilt -> PkgName
pName Prebuilt
pb
pname (FromAUR Buildable
b)   = Buildable -> PkgName
bName Buildable
b

-- | Other names which allow this `Package` to be satisfied as a dependency.
pprov :: Package -> Provides
pprov :: Package -> Provides
pprov (FromRepo Prebuilt
pb) = Prebuilt -> Provides
pProvides Prebuilt
pb
pprov (FromAUR Buildable
b)   = Buildable -> Provides
bProvides Buildable
b

-- | The version of a `Package`.
pver :: Package -> Versioning
pver :: Package -> Versioning
pver (FromRepo Prebuilt
pb) = Prebuilt -> Versioning
pVersion Prebuilt
pb
pver (FromAUR Buildable
b)   = Buildable -> Versioning
bVersion Buildable
b

dividePkgs :: NonEmpty Package -> These (NonEmpty Prebuilt) (NonEmpty Buildable)
dividePkgs :: NonEmpty Package -> These (NonEmpty Prebuilt) (NonEmpty Buildable)
dividePkgs = (Package -> These Prebuilt Buildable)
-> NonEmpty Package
-> These (NonEmpty Prebuilt) (NonEmpty Buildable)
forall a b c.
(a -> These b c) -> NonEmpty a -> These (NonEmpty b) (NonEmpty c)
partNonEmpty Package -> These Prebuilt Buildable
f
  where
    f :: Package -> These Prebuilt Buildable
    f :: Package -> These Prebuilt Buildable
f (FromRepo Prebuilt
p) = Prebuilt -> These Prebuilt Buildable
forall a b. a -> These a b
This Prebuilt
p
    f (FromAUR Buildable
b)  = Buildable -> These Prebuilt Buildable
forall a b. b -> These a b
That Buildable
b

-- TODO Figure out how to do this more generically.
instance Ord Package where
  compare :: Package -> Package -> Ordering
compare (FromAUR Buildable
a) (FromAUR Buildable
b)   = Buildable -> Buildable -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Buildable
a Buildable
b
  compare (FromRepo Prebuilt
a) (FromRepo Prebuilt
b) = Prebuilt -> Prebuilt -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Prebuilt
a Prebuilt
b
  compare (FromAUR Buildable
a) (FromRepo Prebuilt
b)  = SimplePkg -> SimplePkg -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Buildable -> SimplePkg
bToSP Buildable
a) (Prebuilt -> SimplePkg
pToSP Prebuilt
b)
  compare (FromRepo Prebuilt
a) (FromAUR Buildable
b)  = SimplePkg -> SimplePkg -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Prebuilt -> SimplePkg
pToSP Prebuilt
a) (Buildable -> SimplePkg
bToSP Buildable
b)

-- | A `Package` from the AUR that's buildable in some way on the user's machine.
data Buildable = Buildable
  { Buildable -> PkgName
bName       :: !PkgName
  , Buildable -> Versioning
bVersion    :: !Versioning
  , Buildable -> PkgName
bBase       :: !PkgName
  , Buildable -> Provides
bProvides   :: !Provides
  , Buildable -> [Dep]
bDeps       :: ![Dep]
  , Buildable -> Pkgbuild
bPkgbuild   :: !Pkgbuild
  , Buildable -> Bool
bIsExplicit :: !Bool }
  deriving (Buildable -> Buildable -> Bool
(Buildable -> Buildable -> Bool)
-> (Buildable -> Buildable -> Bool) -> Eq Buildable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Buildable -> Buildable -> Bool
$c/= :: Buildable -> Buildable -> Bool
== :: Buildable -> Buildable -> Bool
$c== :: Buildable -> Buildable -> Bool
Eq, Eq Buildable
Eq Buildable
-> (Buildable -> Buildable -> Ordering)
-> (Buildable -> Buildable -> Bool)
-> (Buildable -> Buildable -> Bool)
-> (Buildable -> Buildable -> Bool)
-> (Buildable -> Buildable -> Bool)
-> (Buildable -> Buildable -> Buildable)
-> (Buildable -> Buildable -> Buildable)
-> Ord Buildable
Buildable -> Buildable -> Bool
Buildable -> Buildable -> Ordering
Buildable -> Buildable -> Buildable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Buildable -> Buildable -> Buildable
$cmin :: Buildable -> Buildable -> Buildable
max :: Buildable -> Buildable -> Buildable
$cmax :: Buildable -> Buildable -> Buildable
>= :: Buildable -> Buildable -> Bool
$c>= :: Buildable -> Buildable -> Bool
> :: Buildable -> Buildable -> Bool
$c> :: Buildable -> Buildable -> Bool
<= :: Buildable -> Buildable -> Bool
$c<= :: Buildable -> Buildable -> Bool
< :: Buildable -> Buildable -> Bool
$c< :: Buildable -> Buildable -> Bool
compare :: Buildable -> Buildable -> Ordering
$ccompare :: Buildable -> Buildable -> Ordering
$cp1Ord :: Eq Buildable
Ord, Int -> Buildable -> ShowS
[Buildable] -> ShowS
Buildable -> String
(Int -> Buildable -> ShowS)
-> (Buildable -> String)
-> ([Buildable] -> ShowS)
-> Show Buildable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Buildable] -> ShowS
$cshowList :: [Buildable] -> ShowS
show :: Buildable -> String
$cshow :: Buildable -> String
showsPrec :: Int -> Buildable -> ShowS
$cshowsPrec :: Int -> Buildable -> ShowS
Show, (forall x. Buildable -> Rep Buildable x)
-> (forall x. Rep Buildable x -> Buildable) -> Generic Buildable
forall x. Rep Buildable x -> Buildable
forall x. Buildable -> Rep Buildable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Buildable x -> Buildable
$cfrom :: forall x. Buildable -> Rep Buildable x
Generic)

-- | A prebuilt `Package` from the official Arch repositories.
data Prebuilt = Prebuilt
  { Prebuilt -> PkgName
pName     :: !PkgName
  , Prebuilt -> Versioning
pVersion  :: !Versioning
  , Prebuilt -> PkgName
pBase     :: !PkgName
  , Prebuilt -> Provides
pProvides :: !Provides }
  deriving (Prebuilt -> Prebuilt -> Bool
(Prebuilt -> Prebuilt -> Bool)
-> (Prebuilt -> Prebuilt -> Bool) -> Eq Prebuilt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prebuilt -> Prebuilt -> Bool
$c/= :: Prebuilt -> Prebuilt -> Bool
== :: Prebuilt -> Prebuilt -> Bool
$c== :: Prebuilt -> Prebuilt -> Bool
Eq, Eq Prebuilt
Eq Prebuilt
-> (Prebuilt -> Prebuilt -> Ordering)
-> (Prebuilt -> Prebuilt -> Bool)
-> (Prebuilt -> Prebuilt -> Bool)
-> (Prebuilt -> Prebuilt -> Bool)
-> (Prebuilt -> Prebuilt -> Bool)
-> (Prebuilt -> Prebuilt -> Prebuilt)
-> (Prebuilt -> Prebuilt -> Prebuilt)
-> Ord Prebuilt
Prebuilt -> Prebuilt -> Bool
Prebuilt -> Prebuilt -> Ordering
Prebuilt -> Prebuilt -> Prebuilt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Prebuilt -> Prebuilt -> Prebuilt
$cmin :: Prebuilt -> Prebuilt -> Prebuilt
max :: Prebuilt -> Prebuilt -> Prebuilt
$cmax :: Prebuilt -> Prebuilt -> Prebuilt
>= :: Prebuilt -> Prebuilt -> Bool
$c>= :: Prebuilt -> Prebuilt -> Bool
> :: Prebuilt -> Prebuilt -> Bool
$c> :: Prebuilt -> Prebuilt -> Bool
<= :: Prebuilt -> Prebuilt -> Bool
$c<= :: Prebuilt -> Prebuilt -> Bool
< :: Prebuilt -> Prebuilt -> Bool
$c< :: Prebuilt -> Prebuilt -> Bool
compare :: Prebuilt -> Prebuilt -> Ordering
$ccompare :: Prebuilt -> Prebuilt -> Ordering
$cp1Ord :: Eq Prebuilt
Ord, Int -> Prebuilt -> ShowS
[Prebuilt] -> ShowS
Prebuilt -> String
(Int -> Prebuilt -> ShowS)
-> (Prebuilt -> String) -> ([Prebuilt] -> ShowS) -> Show Prebuilt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prebuilt] -> ShowS
$cshowList :: [Prebuilt] -> ShowS
show :: Prebuilt -> String
$cshow :: Prebuilt -> String
showsPrec :: Int -> Prebuilt -> ShowS
$cshowsPrec :: Int -> Prebuilt -> ShowS
Show, (forall x. Prebuilt -> Rep Prebuilt x)
-> (forall x. Rep Prebuilt x -> Prebuilt) -> Generic Prebuilt
forall x. Rep Prebuilt x -> Prebuilt
forall x. Prebuilt -> Rep Prebuilt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prebuilt x -> Prebuilt
$cfrom :: forall x. Prebuilt -> Rep Prebuilt x
Generic)

-- | A dependency on another package.
data Dep = Dep
  { Dep -> PkgName
dName   :: !PkgName
  , Dep -> VersionDemand
dDemand :: !VersionDemand }
  deriving (Dep -> Dep -> Bool
(Dep -> Dep -> Bool) -> (Dep -> Dep -> Bool) -> Eq Dep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dep -> Dep -> Bool
$c/= :: Dep -> Dep -> Bool
== :: Dep -> Dep -> Bool
$c== :: Dep -> Dep -> Bool
Eq, Eq Dep
Eq Dep
-> (Dep -> Dep -> Ordering)
-> (Dep -> Dep -> Bool)
-> (Dep -> Dep -> Bool)
-> (Dep -> Dep -> Bool)
-> (Dep -> Dep -> Bool)
-> (Dep -> Dep -> Dep)
-> (Dep -> Dep -> Dep)
-> Ord Dep
Dep -> Dep -> Bool
Dep -> Dep -> Ordering
Dep -> Dep -> Dep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dep -> Dep -> Dep
$cmin :: Dep -> Dep -> Dep
max :: Dep -> Dep -> Dep
$cmax :: Dep -> Dep -> Dep
>= :: Dep -> Dep -> Bool
$c>= :: Dep -> Dep -> Bool
> :: Dep -> Dep -> Bool
$c> :: Dep -> Dep -> Bool
<= :: Dep -> Dep -> Bool
$c<= :: Dep -> Dep -> Bool
< :: Dep -> Dep -> Bool
$c< :: Dep -> Dep -> Bool
compare :: Dep -> Dep -> Ordering
$ccompare :: Dep -> Dep -> Ordering
$cp1Ord :: Eq Dep
Ord, Int -> Dep -> ShowS
[Dep] -> ShowS
Dep -> String
(Int -> Dep -> ShowS)
-> (Dep -> String) -> ([Dep] -> ShowS) -> Show Dep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dep] -> ShowS
$cshowList :: [Dep] -> ShowS
show :: Dep -> String
$cshow :: Dep -> String
showsPrec :: Int -> Dep -> ShowS
$cshowsPrec :: Int -> Dep -> ShowS
Show, (forall x. Dep -> Rep Dep x)
-> (forall x. Rep Dep x -> Dep) -> Generic Dep
forall x. Rep Dep x -> Dep
forall x. Dep -> Rep Dep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dep x -> Dep
$cfrom :: forall x. Dep -> Rep Dep x
Generic)

-- | Parse a dependency entry as it would appear in a PKGBUILD:
--
-- @
-- >>> parseDep "pacman>1.2.3"
-- Just (Dep {name = PkgName {name = "pacman"}, demand = >1.2.3})
-- @
parseDep :: Text -> Maybe Dep
parseDep :: Text -> Maybe Dep
parseDep = Either (ParseErrorBundle Text Void) Dep -> Maybe Dep
forall a b. Either a b -> Maybe b
hush (Either (ParseErrorBundle Text Void) Dep -> Maybe Dep)
-> (Text -> Either (ParseErrorBundle Text Void) Dep)
-> Text
-> Maybe Dep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Dep
-> String -> Text -> Either (ParseErrorBundle Text Void) Dep
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text Dep
dep String
"dep"
  where dep :: Parsec Void Text Dep
dep = PkgName -> VersionDemand -> Dep
Dep (PkgName -> VersionDemand -> Dep)
-> ParsecT Void Text Identity PkgName
-> ParsecT Void Text Identity (VersionDemand -> Dep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity PkgName
n ParsecT Void Text Identity (VersionDemand -> Dep)
-> ParsecT Void Text Identity VersionDemand -> Parsec Void Text Dep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity VersionDemand
v
        n :: ParsecT Void Text Identity PkgName
n   = Text -> PkgName
PkgName (Text -> PkgName)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity PkgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')
        v :: ParsecT Void Text Identity VersionDemand
v   = do
          Bool
end <- ParsecT Void Text Identity Bool
forall e s (m :: * -> *). MonadParsec e s m => m Bool
atEnd
          if Bool
end
            then VersionDemand -> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionDemand
Anything
            else [ParsecT Void Text Identity VersionDemand]
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<'    ParsecT Void Text Identity Char
-> ParsecT Void Text Identity VersionDemand
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Versioning -> VersionDemand)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioning -> VersionDemand
LessThan ParsecT Void Text Identity Versioning
versioning'
                        , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
">=" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity VersionDemand
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Versioning -> VersionDemand)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioning -> VersionDemand
AtLeast  ParsecT Void Text Identity Versioning
versioning'
                        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>'    ParsecT Void Text Identity Char
-> ParsecT Void Text Identity VersionDemand
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Versioning -> VersionDemand)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioning -> VersionDemand
MoreThan ParsecT Void Text Identity Versioning
versioning'
                        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='    ParsecT Void Text Identity Char
-> ParsecT Void Text Identity VersionDemand
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Versioning -> VersionDemand)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioning -> VersionDemand
MustBe   ParsecT Void Text Identity Versioning
versioning'
                        , VersionDemand -> ParsecT Void Text Identity VersionDemand
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionDemand
Anything ]

-- | Renders the `Dep` into a form that @pacman -T@ understands. The dual of
-- `parseDep`.
renderedDep :: Dep -> Text
renderedDep :: Dep -> Text
renderedDep (Dep PkgName
n VersionDemand
ver) = PkgName -> Text
pnName PkgName
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VersionDemand -> Text
asT VersionDemand
ver
  where
    asT :: VersionDemand -> Text
    asT :: VersionDemand -> Text
asT (LessThan Versioning
v) = Text
"<"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
v
    asT (AtLeast  Versioning
v) = Text
">=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
v
    asT (MoreThan Versioning
v) = Text
">"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
v
    asT (MustBe   Versioning
v) = Text
"="  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
v
    asT VersionDemand
Anything     = Text
""

-- | The versioning requirement of some package's dependency.
data VersionDemand = LessThan !Versioning
                   | AtLeast  !Versioning
                   | MoreThan !Versioning
                   | MustBe   !Versioning
                   | Anything
                   deriving (VersionDemand -> VersionDemand -> Bool
(VersionDemand -> VersionDemand -> Bool)
-> (VersionDemand -> VersionDemand -> Bool) -> Eq VersionDemand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionDemand -> VersionDemand -> Bool
$c/= :: VersionDemand -> VersionDemand -> Bool
== :: VersionDemand -> VersionDemand -> Bool
$c== :: VersionDemand -> VersionDemand -> Bool
Eq, Eq VersionDemand
Eq VersionDemand
-> (VersionDemand -> VersionDemand -> Ordering)
-> (VersionDemand -> VersionDemand -> Bool)
-> (VersionDemand -> VersionDemand -> Bool)
-> (VersionDemand -> VersionDemand -> Bool)
-> (VersionDemand -> VersionDemand -> Bool)
-> (VersionDemand -> VersionDemand -> VersionDemand)
-> (VersionDemand -> VersionDemand -> VersionDemand)
-> Ord VersionDemand
VersionDemand -> VersionDemand -> Bool
VersionDemand -> VersionDemand -> Ordering
VersionDemand -> VersionDemand -> VersionDemand
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionDemand -> VersionDemand -> VersionDemand
$cmin :: VersionDemand -> VersionDemand -> VersionDemand
max :: VersionDemand -> VersionDemand -> VersionDemand
$cmax :: VersionDemand -> VersionDemand -> VersionDemand
>= :: VersionDemand -> VersionDemand -> Bool
$c>= :: VersionDemand -> VersionDemand -> Bool
> :: VersionDemand -> VersionDemand -> Bool
$c> :: VersionDemand -> VersionDemand -> Bool
<= :: VersionDemand -> VersionDemand -> Bool
$c<= :: VersionDemand -> VersionDemand -> Bool
< :: VersionDemand -> VersionDemand -> Bool
$c< :: VersionDemand -> VersionDemand -> Bool
compare :: VersionDemand -> VersionDemand -> Ordering
$ccompare :: VersionDemand -> VersionDemand -> Ordering
$cp1Ord :: Eq VersionDemand
Ord)

instance Show VersionDemand where
  show :: VersionDemand -> String
show (LessThan Versioning
v) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"<"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
v
  show (AtLeast  Versioning
v) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
">=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
v
  show (MoreThan Versioning
v) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
">"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
v
  show (MustBe   Versioning
v) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"="  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Versioning -> Text
prettyV Versioning
v
  show VersionDemand
Anything     = String
"Anything"

-- | Attempt to zoom into the `Versioning` hiding within a `VersionDemand`.
_VersionDemand :: Traversal' VersionDemand Versioning
_VersionDemand :: (Versioning -> f Versioning) -> VersionDemand -> f VersionDemand
_VersionDemand Versioning -> f Versioning
f (LessThan Versioning
v) = Versioning -> VersionDemand
LessThan (Versioning -> VersionDemand) -> f Versioning -> f VersionDemand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioning -> f Versioning
f Versioning
v
_VersionDemand Versioning -> f Versioning
f (AtLeast Versioning
v)  = Versioning -> VersionDemand
AtLeast  (Versioning -> VersionDemand) -> f Versioning -> f VersionDemand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioning -> f Versioning
f Versioning
v
_VersionDemand Versioning -> f Versioning
f (MoreThan Versioning
v) = Versioning -> VersionDemand
MoreThan (Versioning -> VersionDemand) -> f Versioning -> f VersionDemand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioning -> f Versioning
f Versioning
v
_VersionDemand Versioning -> f Versioning
f (MustBe Versioning
v)   = Versioning -> VersionDemand
MustBe   (Versioning -> VersionDemand) -> f Versioning -> f VersionDemand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioning -> f Versioning
f Versioning
v
_VersionDemand Versioning -> f Versioning
_ VersionDemand
p            = VersionDemand -> f VersionDemand
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionDemand
p

-- | The installation method.
data InstallType = Pacman !PkgName | Build !Buildable deriving (InstallType -> InstallType -> Bool
(InstallType -> InstallType -> Bool)
-> (InstallType -> InstallType -> Bool) -> Eq InstallType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallType -> InstallType -> Bool
$c/= :: InstallType -> InstallType -> Bool
== :: InstallType -> InstallType -> Bool
$c== :: InstallType -> InstallType -> Bool
Eq)

-- | A package name with its version number.
data SimplePkg = SimplePkg
  { SimplePkg -> PkgName
spName    :: !PkgName
  , SimplePkg -> Versioning
spVersion :: !Versioning }
  deriving (SimplePkg -> SimplePkg -> Bool
(SimplePkg -> SimplePkg -> Bool)
-> (SimplePkg -> SimplePkg -> Bool) -> Eq SimplePkg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimplePkg -> SimplePkg -> Bool
$c/= :: SimplePkg -> SimplePkg -> Bool
== :: SimplePkg -> SimplePkg -> Bool
$c== :: SimplePkg -> SimplePkg -> Bool
Eq, Eq SimplePkg
Eq SimplePkg
-> (SimplePkg -> SimplePkg -> Ordering)
-> (SimplePkg -> SimplePkg -> Bool)
-> (SimplePkg -> SimplePkg -> Bool)
-> (SimplePkg -> SimplePkg -> Bool)
-> (SimplePkg -> SimplePkg -> Bool)
-> (SimplePkg -> SimplePkg -> SimplePkg)
-> (SimplePkg -> SimplePkg -> SimplePkg)
-> Ord SimplePkg
SimplePkg -> SimplePkg -> Bool
SimplePkg -> SimplePkg -> Ordering
SimplePkg -> SimplePkg -> SimplePkg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SimplePkg -> SimplePkg -> SimplePkg
$cmin :: SimplePkg -> SimplePkg -> SimplePkg
max :: SimplePkg -> SimplePkg -> SimplePkg
$cmax :: SimplePkg -> SimplePkg -> SimplePkg
>= :: SimplePkg -> SimplePkg -> Bool
$c>= :: SimplePkg -> SimplePkg -> Bool
> :: SimplePkg -> SimplePkg -> Bool
$c> :: SimplePkg -> SimplePkg -> Bool
<= :: SimplePkg -> SimplePkg -> Bool
$c<= :: SimplePkg -> SimplePkg -> Bool
< :: SimplePkg -> SimplePkg -> Bool
$c< :: SimplePkg -> SimplePkg -> Bool
compare :: SimplePkg -> SimplePkg -> Ordering
$ccompare :: SimplePkg -> SimplePkg -> Ordering
$cp1Ord :: Eq SimplePkg
Ord, Int -> SimplePkg -> ShowS
[SimplePkg] -> ShowS
SimplePkg -> String
(Int -> SimplePkg -> ShowS)
-> (SimplePkg -> String)
-> ([SimplePkg] -> ShowS)
-> Show SimplePkg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimplePkg] -> ShowS
$cshowList :: [SimplePkg] -> ShowS
show :: SimplePkg -> String
$cshow :: SimplePkg -> String
showsPrec :: Int -> SimplePkg -> ShowS
$cshowsPrec :: Int -> SimplePkg -> ShowS
Show, (forall x. SimplePkg -> Rep SimplePkg x)
-> (forall x. Rep SimplePkg x -> SimplePkg) -> Generic SimplePkg
forall x. Rep SimplePkg x -> SimplePkg
forall x. SimplePkg -> Rep SimplePkg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimplePkg x -> SimplePkg
$cfrom :: forall x. SimplePkg -> Rep SimplePkg x
Generic)

bToSP :: Buildable -> SimplePkg
bToSP :: Buildable -> SimplePkg
bToSP Buildable
b = PkgName -> Versioning -> SimplePkg
SimplePkg (Buildable -> PkgName
bName Buildable
b) (Buildable -> Versioning
bVersion Buildable
b)

pToSP :: Prebuilt -> SimplePkg
pToSP :: Prebuilt -> SimplePkg
pToSP Prebuilt
p = PkgName -> Versioning -> SimplePkg
SimplePkg (Prebuilt -> PkgName
pName Prebuilt
p) (Prebuilt -> Versioning
pVersion Prebuilt
p)

-- | Attempt to create a `SimplePkg` from filepaths like
--   @\/var\/cache\/pacman\/pkg\/linux-3.2.14-1-x86_64.pkg.tar.zst@
simplepkg :: PackagePath -> Maybe SimplePkg
simplepkg :: PackagePath -> Maybe SimplePkg
simplepkg (PackagePath String
t) = do
  Text
nav <- Either (ParseErrorBundle Text Void) Text -> Maybe Text
forall a b. Either a b -> Maybe b
hush (Either (ParseErrorBundle Text Void) Text -> Maybe Text)
-> (String -> Either (ParseErrorBundle Text Void) Text)
-> String
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text
-> String -> Text -> Either (ParseErrorBundle Text Void) Text
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse ParsecT Void Text Identity Text
nameAndVer String
"Name and Version" (Text -> Either (ParseErrorBundle Text Void) Text)
-> (String -> Text)
-> String
-> Either (ParseErrorBundle Text Void) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
t
  (PkgName -> Versioning -> SimplePkg)
-> (PkgName, Versioning) -> SimplePkg
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PkgName -> Versioning -> SimplePkg
SimplePkg ((PkgName, Versioning) -> SimplePkg)
-> Maybe (PkgName, Versioning) -> Maybe SimplePkg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either (ParseErrorBundle Text Void) PkgName -> Maybe PkgName)
-> (Either (ParseErrorBundle Text Void) Versioning
    -> Maybe Versioning)
-> (Either (ParseErrorBundle Text Void) PkgName,
    Either (ParseErrorBundle Text Void) Versioning)
-> Maybe (PkgName, Versioning)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Either (ParseErrorBundle Text Void) PkgName -> Maybe PkgName
forall a b. Either a b -> Maybe b
hush Either (ParseErrorBundle Text Void) Versioning -> Maybe Versioning
forall a b. Either a b -> Maybe b
hush (ParsecT Void Text Identity PkgName
-> String -> Text -> Either (ParseErrorBundle Text Void) PkgName
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse ParsecT Void Text Identity PkgName
n String
"name" Text
nav, ParsecT Void Text Identity Versioning
-> String -> Text -> Either (ParseErrorBundle Text Void) Versioning
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse ParsecT Void Text Identity Versioning
ver String
"version" Text
nav)
  where
    nameAndVer :: Parsec Void Text Text
    nameAndVer :: ParsecT Void Text Identity Text
nameAndVer = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"-x86_64" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"-any")

    n :: Parsec Void Text PkgName
    n :: ParsecT Void Text Identity PkgName
n = Text -> PkgName
PkgName (Text -> PkgName) -> (String -> Text) -> String -> PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> PkgName)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity PkgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Char
finished)

    -- | Assumes that a version number will never start with a letter,
    -- and that a package name section (i.e. abc-def-ghi) will never start
    -- with a number.
    finished :: Parsec Void Text Char
    finished :: ParsecT Void Text Identity Char
finished = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

    ver :: Parsec Void Text Versioning
    ver :: ParsecT Void Text Identity Versioning
ver = do
      ParsecT Void Text Identity String -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity String
 -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Char
finished)
      [ParsecT Void Text Identity Versioning]
-> ParsecT Void Text Identity Versioning
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Versioning
 -> ParsecT Void Text Identity Versioning)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
forall a b. (a -> b) -> a -> b
$ (SemVer -> Versioning)
-> ParsecT Void Text Identity SemVer
-> ParsecT Void Text Identity Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SemVer -> Versioning
Ideal ParsecT Void Text Identity SemVer
semver'
             , ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Versioning
 -> ParsecT Void Text Identity Versioning)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
forall a b. (a -> b) -> a -> b
$ (Version -> Versioning)
-> ParsecT Void Text Identity Version
-> ParsecT Void Text Identity Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Versioning
General ParsecT Void Text Identity Version
version'
             , (Mess -> Versioning)
-> ParsecT Void Text Identity Mess
-> ParsecT Void Text Identity Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mess -> Versioning
Complex ParsecT Void Text Identity Mess
mess' ]

-- | Attempt to create a `SimplePkg` from text like:
--     xchat 2.8.8-19
simplepkg' :: Text -> Maybe SimplePkg
simplepkg' :: Text -> Maybe SimplePkg
simplepkg' = Either (ParseErrorBundle Text Void) SimplePkg -> Maybe SimplePkg
forall a b. Either a b -> Maybe b
hush (Either (ParseErrorBundle Text Void) SimplePkg -> Maybe SimplePkg)
-> (Text -> Either (ParseErrorBundle Text Void) SimplePkg)
-> Text
-> Maybe SimplePkg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text SimplePkg
-> String -> Text -> Either (ParseErrorBundle Text Void) SimplePkg
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text SimplePkg
parser String
"name-and-version"
  where parser :: Parsec Void Text SimplePkg
parser = PkgName -> Versioning -> SimplePkg
SimplePkg (PkgName -> Versioning -> SimplePkg)
-> ParsecT Void Text Identity PkgName
-> ParsecT Void Text Identity (Versioning -> SimplePkg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> PkgName
PkgName (Text -> PkgName)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity PkgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')) ParsecT Void Text Identity (Versioning -> SimplePkg)
-> ParsecT Void Text Identity Versioning
-> Parsec Void Text SimplePkg
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity Versioning
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Versioning
versioning')

-- | Filepaths like:
--
--   * \/var\/cache\/pacman\/pkg\/linux-3.2.14-1-x86_64.pkg.tar.xz
--   * \/var\/cache\/pacman\/pkg\/wine-1.4rc6-1-x86_64.pkg.tar.xz
--   * \/var\/cache\/pacman\/pkg\/ruby-1.9.3_p125-4-x86_64.pkg.tar.xz
newtype PackagePath = PackagePath { PackagePath -> String
ppPath :: FilePath }
  deriving (PackagePath -> PackagePath -> Bool
(PackagePath -> PackagePath -> Bool)
-> (PackagePath -> PackagePath -> Bool) -> Eq PackagePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackagePath -> PackagePath -> Bool
$c/= :: PackagePath -> PackagePath -> Bool
== :: PackagePath -> PackagePath -> Bool
$c== :: PackagePath -> PackagePath -> Bool
Eq, (forall x. PackagePath -> Rep PackagePath x)
-> (forall x. Rep PackagePath x -> PackagePath)
-> Generic PackagePath
forall x. Rep PackagePath x -> PackagePath
forall x. PackagePath -> Rep PackagePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackagePath x -> PackagePath
$cfrom :: forall x. PackagePath -> Rep PackagePath x
Generic)

-- | If they have the same package names, compare by their versions.
-- Otherwise, do raw comparison of the path string.
instance Ord PackagePath where
  compare :: PackagePath -> PackagePath -> Ordering
compare PackagePath
a PackagePath
b | Maybe PkgName
nameA Maybe PkgName -> Maybe PkgName -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe PkgName
nameB = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PackagePath -> String
ppPath PackagePath
a) (PackagePath -> String
ppPath PackagePath
b)
              | Bool
otherwise      = Maybe Versioning -> Maybe Versioning -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe Versioning
verA Maybe Versioning
verB
    where
      (Maybe PkgName
nameA, Maybe Versioning
verA) = PackagePath -> (Maybe PkgName, Maybe Versioning)
f PackagePath
a
      (Maybe PkgName
nameB, Maybe Versioning
verB) = PackagePath -> (Maybe PkgName, Maybe Versioning)
f PackagePath
b

      f :: PackagePath -> (Maybe PkgName, Maybe Versioning)
      f :: PackagePath -> (Maybe PkgName, Maybe Versioning)
f = ((SimplePkg -> PkgName) -> Maybe SimplePkg -> Maybe PkgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimplePkg -> PkgName
spName (Maybe SimplePkg -> Maybe PkgName)
-> (Maybe SimplePkg -> Maybe Versioning)
-> Maybe SimplePkg
-> (Maybe PkgName, Maybe Versioning)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (SimplePkg -> Versioning) -> Maybe SimplePkg -> Maybe Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimplePkg -> Versioning
spVersion) (Maybe SimplePkg -> (Maybe PkgName, Maybe Versioning))
-> (PackagePath -> Maybe SimplePkg)
-> PackagePath
-> (Maybe PkgName, Maybe Versioning)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagePath -> Maybe SimplePkg
simplepkg

-- | Smart constructor for `PackagePath`.
packagePath :: FilePath -> Maybe PackagePath
packagePath :: String -> Maybe PackagePath
packagePath String
fp = Maybe PackagePath -> Maybe PackagePath -> Bool -> Maybe PackagePath
forall a. a -> a -> Bool -> a
bool Maybe PackagePath
forall a. Maybe a
Nothing (PackagePath -> Maybe PackagePath
forall a. a -> Maybe a
Just (PackagePath -> Maybe PackagePath)
-> PackagePath -> Maybe PackagePath
forall a b. (a -> b) -> a -> b
$ String -> PackagePath
PackagePath String
fp) (Bool -> Maybe PackagePath) -> Bool -> Maybe PackagePath
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (String -> String -> Bool
isExtensionOf String
"sig" String
fp) Bool -> Bool -> Bool
&& String -> Bool
isAbsolute String
fp

-- | The contents of a PKGBUILD file.
newtype Pkgbuild = Pkgbuild { Pkgbuild -> ByteString
pkgbuild :: ByteString }
  deriving (Pkgbuild -> Pkgbuild -> Bool
(Pkgbuild -> Pkgbuild -> Bool)
-> (Pkgbuild -> Pkgbuild -> Bool) -> Eq Pkgbuild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pkgbuild -> Pkgbuild -> Bool
$c/= :: Pkgbuild -> Pkgbuild -> Bool
== :: Pkgbuild -> Pkgbuild -> Bool
$c== :: Pkgbuild -> Pkgbuild -> Bool
Eq, Eq Pkgbuild
Eq Pkgbuild
-> (Pkgbuild -> Pkgbuild -> Ordering)
-> (Pkgbuild -> Pkgbuild -> Bool)
-> (Pkgbuild -> Pkgbuild -> Bool)
-> (Pkgbuild -> Pkgbuild -> Bool)
-> (Pkgbuild -> Pkgbuild -> Bool)
-> (Pkgbuild -> Pkgbuild -> Pkgbuild)
-> (Pkgbuild -> Pkgbuild -> Pkgbuild)
-> Ord Pkgbuild
Pkgbuild -> Pkgbuild -> Bool
Pkgbuild -> Pkgbuild -> Ordering
Pkgbuild -> Pkgbuild -> Pkgbuild
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pkgbuild -> Pkgbuild -> Pkgbuild
$cmin :: Pkgbuild -> Pkgbuild -> Pkgbuild
max :: Pkgbuild -> Pkgbuild -> Pkgbuild
$cmax :: Pkgbuild -> Pkgbuild -> Pkgbuild
>= :: Pkgbuild -> Pkgbuild -> Bool
$c>= :: Pkgbuild -> Pkgbuild -> Bool
> :: Pkgbuild -> Pkgbuild -> Bool
$c> :: Pkgbuild -> Pkgbuild -> Bool
<= :: Pkgbuild -> Pkgbuild -> Bool
$c<= :: Pkgbuild -> Pkgbuild -> Bool
< :: Pkgbuild -> Pkgbuild -> Bool
$c< :: Pkgbuild -> Pkgbuild -> Bool
compare :: Pkgbuild -> Pkgbuild -> Ordering
$ccompare :: Pkgbuild -> Pkgbuild -> Ordering
$cp1Ord :: Eq Pkgbuild
Ord, Int -> Pkgbuild -> ShowS
[Pkgbuild] -> ShowS
Pkgbuild -> String
(Int -> Pkgbuild -> ShowS)
-> (Pkgbuild -> String) -> ([Pkgbuild] -> ShowS) -> Show Pkgbuild
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pkgbuild] -> ShowS
$cshowList :: [Pkgbuild] -> ShowS
show :: Pkgbuild -> String
$cshow :: Pkgbuild -> String
showsPrec :: Int -> Pkgbuild -> ShowS
$cshowsPrec :: Int -> Pkgbuild -> ShowS
Show, (forall x. Pkgbuild -> Rep Pkgbuild x)
-> (forall x. Rep Pkgbuild x -> Pkgbuild) -> Generic Pkgbuild
forall x. Rep Pkgbuild x -> Pkgbuild
forall x. Pkgbuild -> Rep Pkgbuild x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pkgbuild x -> Pkgbuild
$cfrom :: forall x. Pkgbuild -> Rep Pkgbuild x
Generic)

-- | All human languages available for text output.
data Language = English
              | Japanese
              | Polish
              | Croatian
              | Swedish
              | German
              | Spanish
              | Portuguese
              | French
              | Russian
              | Italian
              | Serbian
              | Norwegian
              | Indonesia
              | Chinese
              | Esperanto
              | Dutch
              | Turkish
              | Arabic
              | Ukrainian
              | Romanian
              | Vietnamese
              | Czech
              | Korean
              deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, Int -> Language
Language -> Int
Language -> [Language]
Language -> Language
Language -> Language -> [Language]
Language -> Language -> Language -> [Language]
(Language -> Language)
-> (Language -> Language)
-> (Int -> Language)
-> (Language -> Int)
-> (Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> Language -> [Language])
-> Enum Language
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Language -> Language -> Language -> [Language]
$cenumFromThenTo :: Language -> Language -> Language -> [Language]
enumFromTo :: Language -> Language -> [Language]
$cenumFromTo :: Language -> Language -> [Language]
enumFromThen :: Language -> Language -> [Language]
$cenumFromThen :: Language -> Language -> [Language]
enumFrom :: Language -> [Language]
$cenumFrom :: Language -> [Language]
fromEnum :: Language -> Int
$cfromEnum :: Language -> Int
toEnum :: Int -> Language
$ctoEnum :: Int -> Language
pred :: Language -> Language
$cpred :: Language -> Language
succ :: Language -> Language
$csucc :: Language -> Language
Enum, Language
Language -> Language -> Bounded Language
forall a. a -> a -> Bounded a
maxBound :: Language
$cmaxBound :: Language
minBound :: Language
$cminBound :: Language
Bounded, Eq Language
Eq Language
-> (Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
$cp1Ord :: Eq Language
Ord, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show)

-- | The various ways that dependency resolution can fail.
data DepError = NonExistant !PkgName !PkgName
              | VerConflict !(Doc AnsiStyle)
              | Ignored !(Doc AnsiStyle)
              | BrokenProvides !PkgName !Provides !PkgName

-- | Failures that can occur during Aura processing. Could be a message, or a
-- silent failure that should print nothing to the console.
data Failure = Silent | Failure FailMsg
  deriving stock (Int -> Failure -> ShowS
[Failure] -> ShowS
Failure -> String
(Int -> Failure -> ShowS)
-> (Failure -> String) -> ([Failure] -> ShowS) -> Show Failure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Failure] -> ShowS
$cshowList :: [Failure] -> ShowS
show :: Failure -> String
$cshow :: Failure -> String
showsPrec :: Int -> Failure -> ShowS
$cshowsPrec :: Int -> Failure -> ShowS
Show)

instance Exception Failure

-- | Some failure message that when given the current runtime `Language`
-- will produce a human-friendly error.
newtype FailMsg = FailMsg { FailMsg -> Language -> Doc AnsiStyle
failure :: Language -> Doc AnsiStyle }

instance Exception FailMsg

instance Show FailMsg where
  show :: FailMsg -> String
show FailMsg
_ = String
"There was some failure."

-- | Shell environment variables.
type Environment = Map Text Text

-- | The name of a user account on a Linux system.
newtype User = User { User -> Text
user :: Text }
  deriving (User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show, (forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep User x -> User
$cfrom :: forall x. User -> Rep User x
Generic)

-- | The name of an Arch Linux package.
newtype PkgName = PkgName { PkgName -> Text
pnName :: Text }
  deriving stock (PkgName -> PkgName -> Bool
(PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool) -> Eq PkgName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgName -> PkgName -> Bool
$c/= :: PkgName -> PkgName -> Bool
== :: PkgName -> PkgName -> Bool
$c== :: PkgName -> PkgName -> Bool
Eq, Eq PkgName
Eq PkgName
-> (PkgName -> PkgName -> Ordering)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> PkgName)
-> (PkgName -> PkgName -> PkgName)
-> Ord PkgName
PkgName -> PkgName -> Bool
PkgName -> PkgName -> Ordering
PkgName -> PkgName -> PkgName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PkgName -> PkgName -> PkgName
$cmin :: PkgName -> PkgName -> PkgName
max :: PkgName -> PkgName -> PkgName
$cmax :: PkgName -> PkgName -> PkgName
>= :: PkgName -> PkgName -> Bool
$c>= :: PkgName -> PkgName -> Bool
> :: PkgName -> PkgName -> Bool
$c> :: PkgName -> PkgName -> Bool
<= :: PkgName -> PkgName -> Bool
$c<= :: PkgName -> PkgName -> Bool
< :: PkgName -> PkgName -> Bool
$c< :: PkgName -> PkgName -> Bool
compare :: PkgName -> PkgName -> Ordering
$ccompare :: PkgName -> PkgName -> Ordering
$cp1Ord :: Eq PkgName
Ord, Int -> PkgName -> ShowS
[PkgName] -> ShowS
PkgName -> String
(Int -> PkgName -> ShowS)
-> (PkgName -> String) -> ([PkgName] -> ShowS) -> Show PkgName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgName] -> ShowS
$cshowList :: [PkgName] -> ShowS
show :: PkgName -> String
$cshow :: PkgName -> String
showsPrec :: Int -> PkgName -> ShowS
$cshowsPrec :: Int -> PkgName -> ShowS
Show, (forall x. PkgName -> Rep PkgName x)
-> (forall x. Rep PkgName x -> PkgName) -> Generic PkgName
forall x. Rep PkgName x -> PkgName
forall x. PkgName -> Rep PkgName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PkgName x -> PkgName
$cfrom :: forall x. PkgName -> Rep PkgName x
Generic)
  deriving newtype (PkgName -> [Text]
(PkgName -> [Text]) -> Flagable PkgName
forall a. (a -> [Text]) -> Flagable a
asFlag :: PkgName -> [Text]
$casFlag :: PkgName -> [Text]
Flagable, ToJSONKeyFunction [PkgName]
ToJSONKeyFunction PkgName
ToJSONKeyFunction PkgName
-> ToJSONKeyFunction [PkgName] -> ToJSONKey PkgName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PkgName]
$ctoJSONKeyList :: ToJSONKeyFunction [PkgName]
toJSONKey :: ToJSONKeyFunction PkgName
$ctoJSONKey :: ToJSONKeyFunction PkgName
ToJSONKey, FromJSONKeyFunction [PkgName]
FromJSONKeyFunction PkgName
FromJSONKeyFunction PkgName
-> FromJSONKeyFunction [PkgName] -> FromJSONKey PkgName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PkgName]
$cfromJSONKeyList :: FromJSONKeyFunction [PkgName]
fromJSONKey :: FromJSONKeyFunction PkgName
$cfromJSONKey :: FromJSONKeyFunction PkgName
FromJSONKey, String -> PkgName
(String -> PkgName) -> IsString PkgName
forall a. (String -> a) -> IsString a
fromString :: String -> PkgName
$cfromString :: String -> PkgName
IsString)

-- | A group that a `Package` could belong too, like @base@, @base-devel@, etc.
newtype PkgGroup = PkgGroup { PkgGroup -> Text
pgGroup :: Text }
  deriving stock (PkgGroup -> PkgGroup -> Bool
(PkgGroup -> PkgGroup -> Bool)
-> (PkgGroup -> PkgGroup -> Bool) -> Eq PkgGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgGroup -> PkgGroup -> Bool
$c/= :: PkgGroup -> PkgGroup -> Bool
== :: PkgGroup -> PkgGroup -> Bool
$c== :: PkgGroup -> PkgGroup -> Bool
Eq, Eq PkgGroup
Eq PkgGroup
-> (PkgGroup -> PkgGroup -> Ordering)
-> (PkgGroup -> PkgGroup -> Bool)
-> (PkgGroup -> PkgGroup -> Bool)
-> (PkgGroup -> PkgGroup -> Bool)
-> (PkgGroup -> PkgGroup -> Bool)
-> (PkgGroup -> PkgGroup -> PkgGroup)
-> (PkgGroup -> PkgGroup -> PkgGroup)
-> Ord PkgGroup
PkgGroup -> PkgGroup -> Bool
PkgGroup -> PkgGroup -> Ordering
PkgGroup -> PkgGroup -> PkgGroup
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PkgGroup -> PkgGroup -> PkgGroup
$cmin :: PkgGroup -> PkgGroup -> PkgGroup
max :: PkgGroup -> PkgGroup -> PkgGroup
$cmax :: PkgGroup -> PkgGroup -> PkgGroup
>= :: PkgGroup -> PkgGroup -> Bool
$c>= :: PkgGroup -> PkgGroup -> Bool
> :: PkgGroup -> PkgGroup -> Bool
$c> :: PkgGroup -> PkgGroup -> Bool
<= :: PkgGroup -> PkgGroup -> Bool
$c<= :: PkgGroup -> PkgGroup -> Bool
< :: PkgGroup -> PkgGroup -> Bool
$c< :: PkgGroup -> PkgGroup -> Bool
compare :: PkgGroup -> PkgGroup -> Ordering
$ccompare :: PkgGroup -> PkgGroup -> Ordering
$cp1Ord :: Eq PkgGroup
Ord, Int -> PkgGroup -> ShowS
[PkgGroup] -> ShowS
PkgGroup -> String
(Int -> PkgGroup -> ShowS)
-> (PkgGroup -> String) -> ([PkgGroup] -> ShowS) -> Show PkgGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgGroup] -> ShowS
$cshowList :: [PkgGroup] -> ShowS
show :: PkgGroup -> String
$cshow :: PkgGroup -> String
showsPrec :: Int -> PkgGroup -> ShowS
$cshowsPrec :: Int -> PkgGroup -> ShowS
Show, (forall x. PkgGroup -> Rep PkgGroup x)
-> (forall x. Rep PkgGroup x -> PkgGroup) -> Generic PkgGroup
forall x. Rep PkgGroup x -> PkgGroup
forall x. PkgGroup -> Rep PkgGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PkgGroup x -> PkgGroup
$cfrom :: forall x. PkgGroup -> Rep PkgGroup x
Generic)
  deriving newtype (PkgGroup -> [Text]
(PkgGroup -> [Text]) -> Flagable PkgGroup
forall a. (a -> [Text]) -> Flagable a
asFlag :: PkgGroup -> [Text]
$casFlag :: PkgGroup -> [Text]
Flagable)

-- | The dependency which some package provides. May not be the same name
-- as the package itself (e.g. cronie provides cron).
newtype Provides = Provides { Provides -> PkgName
provides :: PkgName }
  deriving (Provides -> Provides -> Bool
(Provides -> Provides -> Bool)
-> (Provides -> Provides -> Bool) -> Eq Provides
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Provides -> Provides -> Bool
$c/= :: Provides -> Provides -> Bool
== :: Provides -> Provides -> Bool
$c== :: Provides -> Provides -> Bool
Eq, Eq Provides
Eq Provides
-> (Provides -> Provides -> Ordering)
-> (Provides -> Provides -> Bool)
-> (Provides -> Provides -> Bool)
-> (Provides -> Provides -> Bool)
-> (Provides -> Provides -> Bool)
-> (Provides -> Provides -> Provides)
-> (Provides -> Provides -> Provides)
-> Ord Provides
Provides -> Provides -> Bool
Provides -> Provides -> Ordering
Provides -> Provides -> Provides
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Provides -> Provides -> Provides
$cmin :: Provides -> Provides -> Provides
max :: Provides -> Provides -> Provides
$cmax :: Provides -> Provides -> Provides
>= :: Provides -> Provides -> Bool
$c>= :: Provides -> Provides -> Bool
> :: Provides -> Provides -> Bool
$c> :: Provides -> Provides -> Bool
<= :: Provides -> Provides -> Bool
$c<= :: Provides -> Provides -> Bool
< :: Provides -> Provides -> Bool
$c< :: Provides -> Provides -> Bool
compare :: Provides -> Provides -> Ordering
$ccompare :: Provides -> Provides -> Ordering
$cp1Ord :: Eq Provides
Ord, Int -> Provides -> ShowS
[Provides] -> ShowS
Provides -> String
(Int -> Provides -> ShowS)
-> (Provides -> String) -> ([Provides] -> ShowS) -> Show Provides
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Provides] -> ShowS
$cshowList :: [Provides] -> ShowS
show :: Provides -> String
$cshow :: Provides -> String
showsPrec :: Int -> Provides -> ShowS
$cshowsPrec :: Int -> Provides -> ShowS
Show, (forall x. Provides -> Rep Provides x)
-> (forall x. Rep Provides x -> Provides) -> Generic Provides
forall x. Rep Provides x -> Provides
forall x. Provides -> Rep Provides x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Provides x -> Provides
$cfrom :: forall x. Provides -> Rep Provides x
Generic)