{-# LANGUAGE TupleSections #-}
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"
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"]
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
(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
(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
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"]
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)