{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module Aura.Build
( installPkgFiles
, buildPackages
) where
import Aura.Core
import Aura.Languages
import Aura.MakePkg
import Aura.Packages.AUR (clone)
import Aura.Pacman (pacman)
import Aura.Settings
import Aura.Types
import Aura.Utils
import Control.Monad.Trans.Except
import Data.Generics.Product (field)
import Data.Semigroup.Foldable (fold1)
import Data.Set.NonEmpty (NESet)
import qualified Data.Set.NonEmpty as NES
import Data.Witherable.Class (wither)
import RIO
import RIO.Directory (setCurrentDirectory)
import qualified RIO.NonEmpty as NEL
import qualified RIO.Set as S
import qualified RIO.Text as T
import System.Path
import System.Path.IO
import System.Process.Typed
import System.Random.MWC (GenIO, createSystemRandom, uniform)
srcPkgStore :: Path Absolute
srcPkgStore = fromAbsoluteFilePath "/var/cache/aura/src"
installPkgFiles :: NESet PackagePath -> RIO Env ()
installPkgFiles files = do
ss <- asks settings
liftIO $ checkDBLock ss
liftIO . pacman $ ["-U"] <> map (T.pack . toFilePath . path) (toList files) <> asFlag (commonConfigOf ss)
buildPackages :: NESet Buildable -> RIO Env (NESet PackagePath)
buildPackages bs = do
g <- liftIO createSystemRandom
wither (build g) (toList bs) >>= maybe bad (pure . fold1) . NEL.nonEmpty
where bad = throwM $ Failure buildFail_10
build :: GenIO -> Buildable -> RIO Env (Maybe (NESet PackagePath))
build g p = do
ss <- asks settings
liftIO $ notify ss (buildPackages_1 (p ^. field @"name") (langOf ss)) *> hFlush stdout
result <- liftIO $ build' ss g p
either buildFail (pure . Just) result
build' :: Settings -> GenIO -> Buildable -> IO (Either Failure (NESet PackagePath))
build' ss g b = do
let pth = buildPathOf $ buildConfigOf ss
createDirectoryIfMissing True pth
setCurrentDirectory $ toFilePath pth
buildDir <- randomDirName g b
createDirectoryIfMissing True buildDir
setCurrentDirectory $ toFilePath buildDir
runExceptT $ do
bs <- ExceptT $ cloneRepo b usr
lift . setCurrentDirectory $ toFilePath bs
lift $ overwritePkgbuild ss b
pNames <- ExceptT $ makepkg ss usr
paths <- lift . fmap NES.fromList . traverse (moveToCachePath ss) $ NES.toList pNames
lift . when (S.member AllSource . makepkgFlagsOf $ buildConfigOf ss) $
makepkgSource usr >>= traverse_ moveToSourcePath
pure paths
where usr = fromMaybe (User "桜木花道") . buildUserOf $ buildConfigOf ss
randomDirName :: GenIO -> Buildable -> IO (Path Absolute)
randomDirName g b = do
pwd <- getCurrentDirectory
v <- uniform g :: IO Word
let dir = T.unpack (b ^. field @"name" . field @"name") <> "-" <> show v
pure $ pwd </> fromUnrootedFilePath dir
cloneRepo :: Buildable -> User -> IO (Either Failure (Path Absolute))
cloneRepo pkg usr = do
currDir <- getCurrentDirectory
scriptsDir <- chown usr currDir [] *> clone pkg
case scriptsDir of
Nothing -> pure . Left . Failure . buildFail_7 $ pkg ^. field @"name"
Just sd -> chown usr sd ["-R"] $> Right sd
overwritePkgbuild :: Settings -> Buildable -> IO ()
overwritePkgbuild ss p = when (switch ss HotEdit || switch ss UseCustomizepkg) $
writeFileBinary "PKGBUILD" $ p ^. field @"pkgbuild" . field @"pkgbuild"
buildFail :: Failure -> RIO Env (Maybe a)
buildFail (Failure err) = do
ss <- asks settings
liftIO . scold ss . err $ langOf ss
response <- liftIO $ optionalPrompt ss buildFail_6
bool (throwM $ Failure buildFail_5) (pure Nothing) response
moveToCachePath :: Settings -> Path Absolute -> IO PackagePath
moveToCachePath ss p = copy $> PackagePath newName
where newName = pth </> takeFileName p
pth = either id id . cachePathOf $ commonConfigOf ss
copy = runProcess . setStderr closed . setStdout closed
$ proc "cp" ["--reflink=auto", toFilePath p, toFilePath newName ]
moveToSourcePath :: Path Absolute -> IO (Path Absolute)
moveToSourcePath p = renameFile p newName $> newName
where newName = srcPkgStore </> takeFileName p