{-# LANGUAGE TupleSections #-}

-- |
-- Module    : Aura.State
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Interface to `makepkg`.

module Aura.MakePkg
  ( makepkg
  , makepkgSource
  ) where

import           Aura.IO (optionalPrompt)
import           Aura.Languages
import           Aura.Settings
import           Aura.Types
import           Aura.Utils (note)
import           RIO
import qualified RIO.ByteString.Lazy as BL
import           RIO.Directory
import           RIO.FilePath
import qualified RIO.NonEmpty as NEL
import qualified RIO.Text as T
import           System.Process.Typed

---

makepkgCmd :: FilePath
makepkgCmd :: FilePath
makepkgCmd = FilePath
"/usr/bin/makepkg"

-- | Given the current user name, build the package of whatever
-- directory we're in.
makepkg :: Settings -> User -> IO (Either Failure (NonEmpty FilePath))
makepkg :: Settings -> User -> IO (Either Failure (NonEmpty FilePath))
makepkg Settings
ss User
usr = Settings
-> User
-> ProcessConfig () () ()
-> IO (ExitCode, ByteString, [FilePath])
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Settings
-> User
-> ProcessConfig stdin stdout stderr
-> m (ExitCode, ByteString, [FilePath])
make Settings
ss User
usr (FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
cmd ([FilePath] -> ProcessConfig () () ())
-> [FilePath] -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ [FilePath]
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
overwrite [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
colour) IO (ExitCode, ByteString, [FilePath])
-> ((ExitCode, ByteString, [FilePath])
    -> IO (Either Failure (NonEmpty FilePath)))
-> IO (Either Failure (NonEmpty FilePath))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ExitCode, ByteString, [FilePath])
-> IO (Either Failure (NonEmpty FilePath))
forall a.
(ExitCode, ByteString, [a]) -> IO (Either Failure (NonEmpty a))
g
  where
    (FilePath
cmd, [FilePath]
opts) =
      User -> [FilePath] -> (FilePath, [FilePath])
runStyle User
usr ([FilePath] -> (FilePath, [FilePath]))
-> (BuildConfig -> [FilePath])
-> BuildConfig
-> (FilePath, [FilePath])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack ([Text] -> [FilePath])
-> (BuildConfig -> [Text]) -> BuildConfig -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Makepkg -> [Text]) -> Set Makepkg -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Makepkg -> [Text]
forall a. Flagable a => a -> [Text]
asFlag (Set Makepkg -> [Text])
-> (BuildConfig -> Set Makepkg) -> BuildConfig -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Set Makepkg
makepkgFlagsOf (BuildConfig -> (FilePath, [FilePath]))
-> BuildConfig -> (FilePath, [FilePath])
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss

    g :: (ExitCode, LByteString, [a]) -> IO (Either Failure (NonEmpty a))
    g :: (ExitCode, ByteString, [a]) -> IO (Either Failure (NonEmpty a))
g (ExitCode
ExitSuccess, ByteString
_, [a]
fs)   = Either Failure (NonEmpty a) -> IO (Either Failure (NonEmpty a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure (NonEmpty a) -> IO (Either Failure (NonEmpty a)))
-> (Maybe (NonEmpty a) -> Either Failure (NonEmpty a))
-> Maybe (NonEmpty a)
-> IO (Either Failure (NonEmpty a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Maybe (NonEmpty a) -> Either Failure (NonEmpty a)
forall a b. a -> Maybe b -> Either a b
note (FailMsg -> Failure
Failure (FailMsg -> Failure) -> FailMsg -> Failure
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
buildFail_9) (Maybe (NonEmpty a) -> IO (Either Failure (NonEmpty a)))
-> Maybe (NonEmpty a) -> IO (Either Failure (NonEmpty a))
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [a]
fs
    g (ExitFailure Int
_, ByteString
se, [a]
_) = do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
DontSuppressMakepkg) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool
showError <- Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss Language -> Doc AnsiStyle
buildFail_11
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
BL.putStrLn ByteString
se
      Either Failure (NonEmpty a) -> IO (Either Failure (NonEmpty a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure (NonEmpty a) -> IO (Either Failure (NonEmpty a)))
-> (FailMsg -> Either Failure (NonEmpty a))
-> FailMsg
-> IO (Either Failure (NonEmpty a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure (NonEmpty a)
forall a b. a -> Either a b
Left (Failure -> Either Failure (NonEmpty a))
-> (FailMsg -> Failure) -> FailMsg -> Either Failure (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> IO (Either Failure (NonEmpty a)))
-> FailMsg -> IO (Either Failure (NonEmpty a))
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
buildFail_8

    overwrite :: [String]
    overwrite :: [FilePath]
overwrite | Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
ForceBuilding = [FilePath
"-f"]
              | Bool
otherwise = []

    colour :: [String]
    colour :: [FilePath]
colour | Settings -> CommonSwitch -> Bool
shared Settings
ss (ColourMode -> CommonSwitch
Colour ColourMode
Never)  = [FilePath
"--nocolor"]
           | Settings -> CommonSwitch -> Bool
shared Settings
ss (ColourMode -> CommonSwitch
Colour ColourMode
Always) = []
           | Settings -> Bool
isTerminal Settings
ss = []
           | Bool
otherwise = [FilePath
"--nocolor"]

-- | Actually build the package, guarding on exceptions.
-- Yields the filepaths of the built package tarballs.
make :: MonadIO m
  => Settings
  -> User
  -> ProcessConfig stdin stdout stderr
  -> m (ExitCode, BL.ByteString, [FilePath])
make :: Settings
-> User
-> ProcessConfig stdin stdout stderr
-> m (ExitCode, ByteString, [FilePath])
make Settings
ss (User Text
usr) ProcessConfig stdin stdout stderr
pc = do
  -- Perform the actual building.
  (ExitCode
ec, ByteString
se) <- Settings
-> ProcessConfig stdin stdout stderr -> m (ExitCode, ByteString)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Settings
-> ProcessConfig stdin stdout stderr -> m (ExitCode, ByteString)
runIt Settings
ss ProcessConfig stdin stdout stderr
pc
  -- Fetch the filenames of the built tarballs.
  (ExitCode
_, ByteString
out, ByteString
_) <- ProcessConfig () () () -> m (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (ProcessConfig () () () -> m (ExitCode, ByteString, ByteString))
-> ProcessConfig () () () -> m (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"sudo" [FilePath
"-u", Text -> FilePath
T.unpack Text
usr, FilePath
makepkgCmd, FilePath
"--packagelist"]
  let fs :: [FilePath]
fs = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack ([Text] -> [FilePath])
-> (ByteString -> [Text]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
out
  (ExitCode, ByteString, [FilePath])
-> m (ExitCode, ByteString, [FilePath])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode
ec, ByteString
se, [FilePath]
fs)

runIt :: MonadIO m
  => Settings
  -> ProcessConfig stdin stdout stderr
  -> m (ExitCode, BL.ByteString)
runIt :: Settings
-> ProcessConfig stdin stdout stderr -> m (ExitCode, ByteString)
runIt Settings
ss ProcessConfig stdin stdout stderr
pc | Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
DontSuppressMakepkg = (,ByteString
forall a. Monoid a => a
mempty) (ExitCode -> (ExitCode, ByteString))
-> m ExitCode -> m (ExitCode, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfig stdin stdout stderr -> m ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess ProcessConfig stdin stdout stderr
pc
            | Bool
otherwise = (\(ExitCode
ec, ByteString
_, ByteString
se) -> (ExitCode
ec, ByteString
se)) ((ExitCode, ByteString, ByteString) -> (ExitCode, ByteString))
-> m (ExitCode, ByteString, ByteString) -> m (ExitCode, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfig stdin stdout stderr
-> m (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess ProcessConfig stdin stdout stderr
pc

-- | Make a source package. See `man makepkg` and grep for `--allsource`.
makepkgSource :: User -> IO [FilePath]
makepkgSource :: User -> IO [FilePath]
makepkgSource User
usr = do
  IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (ProcessConfig () () () -> IO ExitCode)
-> ProcessConfig () () ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> IO ())
-> ProcessConfig () () () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
cmd [FilePath]
opts
  FilePath
pwd <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
  (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isSuffixOf Text
".src.tar.gz" (Text -> Bool) -> (FilePath -> Text) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
pwd FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listDirectory FilePath
pwd
    where (FilePath
cmd, [FilePath]
opts) = User -> [FilePath] -> (FilePath, [FilePath])
runStyle User
usr [FilePath
"--allsource"]

-- | As of makepkg v4.2, building with `--asroot` is no longer allowed.
runStyle :: User -> [String] -> (FilePath, [String])
runStyle :: User -> [FilePath] -> (FilePath, [FilePath])
runStyle (User Text
usr) [FilePath]
opts = (FilePath
"sudo", [FilePath
"-u", Text -> FilePath
T.unpack Text
usr, FilePath
makepkgCmd] [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
opts)