{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Aura.Build
( installPkgFiles
, buildPackages
, srcPkgStore
, vcsStore
) where
import Aura.Core
import Aura.IO
import Aura.Languages
import Aura.MakePkg
import Aura.Packages.AUR (clone)
import Aura.Pacman (pacman)
import Aura.Settings
import Aura.Shell (chown)
import Aura.Types
import Aura.Utils (edit)
import Control.Monad.Trans.Except
import Data.Hashable (hash)
import RIO
import RIO.Directory
import RIO.FilePath
import qualified RIO.List as L
import qualified RIO.NonEmpty as NEL
import RIO.Partial (fromJust)
import qualified RIO.Set as S
import qualified RIO.Text as T
import RIO.Time
import System.Process.Typed
import System.Posix.User
data BuildResult = AllSourced | Built !(NonEmpty PackagePath)
builtPPs :: BuildResult -> Maybe (NonEmpty PackagePath)
builtPPs :: BuildResult -> Maybe (NonEmpty PackagePath)
builtPPs (Built NonEmpty PackagePath
pps) = NonEmpty PackagePath -> Maybe (NonEmpty PackagePath)
forall a. a -> Maybe a
Just NonEmpty PackagePath
pps
builtPPs BuildResult
_ = Maybe (NonEmpty PackagePath)
forall a. Maybe a
Nothing
srcPkgStore :: FilePath
srcPkgStore :: FilePath
srcPkgStore = FilePath
"/var/cache/aura/src"
vcsStore :: FilePath
vcsStore :: FilePath
vcsStore = FilePath
"/var/cache/aura/vcs"
installPkgFiles :: NonEmpty PackagePath -> RIO Env ()
installPkgFiles :: NonEmpty PackagePath -> RIO Env ()
installPkgFiles NonEmpty PackagePath
files = do
Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ()) -> IO () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
checkDBLock Settings
ss
IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ()) -> ([Text] -> IO ()) -> [Text] -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [Text] -> IO ()
pacman (Settings -> Environment
envOf Settings
ss) ([Text] -> RIO Env ()) -> [Text] -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ [Text
"-U"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (PackagePath -> Text) -> [PackagePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text)
-> (PackagePath -> FilePath) -> PackagePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagePath -> FilePath
ppPath) (NonEmpty PackagePath -> [PackagePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PackagePath
files) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> CommonConfig -> [Text]
forall a. Flagable a => a -> [Text]
asFlag (Settings -> CommonConfig
commonConfigOf Settings
ss)
buildPackages :: NonEmpty Buildable -> RIO Env [PackagePath]
buildPackages :: NonEmpty Buildable -> RIO Env [PackagePath]
buildPackages NonEmpty Buildable
bs = (Buildable -> RIO Env (Maybe BuildResult))
-> [Buildable] -> RIO Env [BuildResult]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeA Buildable -> RIO Env (Maybe BuildResult)
build (NonEmpty Buildable -> [Buildable]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Buildable
bs) RIO Env [BuildResult]
-> ([BuildResult] -> RIO Env [PackagePath])
-> RIO Env [PackagePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> Failure -> RIO Env [PackagePath]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Failure -> RIO Env [PackagePath])
-> (FailMsg -> Failure) -> FailMsg -> RIO Env [PackagePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env [PackagePath])
-> FailMsg -> RIO Env [PackagePath]
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
buildFail_10
[BuildResult]
built -> [PackagePath] -> RIO Env [PackagePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackagePath] -> RIO Env [PackagePath])
-> ([NonEmpty PackagePath] -> [PackagePath])
-> [NonEmpty PackagePath]
-> RIO Env [PackagePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty PackagePath -> [PackagePath])
-> [NonEmpty PackagePath] -> [PackagePath]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NonEmpty PackagePath -> [PackagePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([NonEmpty PackagePath] -> RIO Env [PackagePath])
-> [NonEmpty PackagePath] -> RIO Env [PackagePath]
forall a b. (a -> b) -> a -> b
$ (BuildResult -> Maybe (NonEmpty PackagePath))
-> [BuildResult] -> [NonEmpty PackagePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BuildResult -> Maybe (NonEmpty PackagePath)
builtPPs [BuildResult]
built
build :: Buildable -> RIO Env (Maybe BuildResult)
build :: Buildable -> RIO Env (Maybe BuildResult)
build Buildable
p = do
Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Env ()) -> Utf8Builder -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Building: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (PkgName -> Text
pnName (PkgName -> Text) -> PkgName -> Text
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
p)
Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
notify Settings
ss (PkgName -> Language -> Doc AnsiStyle
buildPackages_1 (PkgName -> Language -> Doc AnsiStyle)
-> PkgName -> Language -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
p) RIO Env () -> RIO Env () -> RIO Env ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> RIO Env ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
Either Failure BuildResult
result <- Buildable -> RIO Env (Either Failure BuildResult)
build' Buildable
p
(Failure -> RIO Env (Maybe BuildResult))
-> (BuildResult -> RIO Env (Maybe BuildResult))
-> Either Failure BuildResult
-> RIO Env (Maybe BuildResult)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Failure -> RIO Env (Maybe BuildResult)
forall a. Failure -> RIO Env (Maybe a)
buildFail (Maybe BuildResult -> RIO Env (Maybe BuildResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe BuildResult -> RIO Env (Maybe BuildResult))
-> (BuildResult -> Maybe BuildResult)
-> BuildResult
-> RIO Env (Maybe BuildResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildResult -> Maybe BuildResult
forall a. a -> Maybe a
Just) Either Failure BuildResult
result
build' :: Buildable -> RIO Env (Either Failure BuildResult)
build' :: Buildable -> RIO Env (Either Failure BuildResult)
build' Buildable
b = do
Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
let !isDevel :: Bool
isDevel = PkgName -> Bool
isDevelPkg (PkgName -> Bool) -> PkgName -> Bool
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b
!pth :: FilePath
pth | Bool
isDevel = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
vcsStore (Maybe FilePath -> FilePath)
-> (BuildConfig -> Maybe FilePath) -> BuildConfig -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Maybe FilePath
vcsPathOf (BuildConfig -> FilePath) -> BuildConfig -> FilePath
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
| Bool
otherwise = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultBuildDir (Maybe FilePath -> FilePath)
-> (BuildConfig -> Maybe FilePath) -> BuildConfig -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Maybe FilePath
buildPathOf (BuildConfig -> FilePath) -> BuildConfig -> FilePath
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
!usr :: User
usr = User -> Maybe User -> User
forall a. a -> Maybe a -> a
fromMaybe (Text -> User
User Text
"UNKNOWN") (Maybe User -> User)
-> (BuildConfig -> Maybe User) -> BuildConfig -> User
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Maybe User
buildUserOf (BuildConfig -> User) -> BuildConfig -> User
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
FilePath -> RIO Env ()
createWritableIfMissing FilePath
pth
FilePath -> RIO Env ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
setCurrentDirectory FilePath
pth
FilePath
buildDir <- IO FilePath -> RIO Env FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> RIO Env FilePath)
-> IO FilePath -> RIO Env FilePath
forall a b. (a -> b) -> a -> b
$ Buildable -> IO FilePath
getBuildDir Buildable
b
FilePath -> RIO Env ()
createWritableIfMissing FilePath
buildDir
FilePath -> RIO Env ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
setCurrentDirectory FilePath
buildDir
Either Failure BuildResult
r <- ExceptT Failure (RIO Env) BuildResult
-> RIO Env (Either Failure BuildResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Failure (RIO Env) BuildResult
-> RIO Env (Either Failure BuildResult))
-> ExceptT Failure (RIO Env) BuildResult
-> RIO Env (Either Failure BuildResult)
forall a b. (a -> b) -> a -> b
$ do
FilePath
bs <- RIO Env (Either Failure FilePath)
-> ExceptT Failure (RIO Env) FilePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (RIO Env (Either Failure FilePath)
-> ExceptT Failure (RIO Env) FilePath)
-> RIO Env (Either Failure FilePath)
-> ExceptT Failure (RIO Env) FilePath
forall a b. (a -> b) -> a -> b
$ do
let !dir :: FilePath
dir = FilePath
buildDir FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack (PkgName -> Text
pnName (PkgName -> Text) -> PkgName -> Text
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b)
Bool
pulled <- FilePath -> RIO Env Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
dir
RIO Env (Either Failure FilePath)
-> RIO Env (Either Failure FilePath)
-> Bool
-> RIO Env (Either Failure FilePath)
forall a. a -> a -> Bool -> a
bool (Buildable -> User -> RIO Env (Either Failure FilePath)
cloneRepo Buildable
b User
usr) (Either Failure FilePath -> RIO Env (Either Failure FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure FilePath -> RIO Env (Either Failure FilePath))
-> Either Failure FilePath -> RIO Env (Either Failure FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Failure FilePath
forall a b. b -> Either a b
Right FilePath
dir) Bool
pulled
FilePath -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
setCurrentDirectory FilePath
bs
Bool
-> ExceptT Failure (RIO Env) () -> ExceptT Failure (RIO Env) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isDevel (ExceptT Failure (RIO Env) () -> ExceptT Failure (RIO Env) ())
-> (RIO Env (Either Failure ()) -> ExceptT Failure (RIO Env) ())
-> RIO Env (Either Failure ())
-> ExceptT Failure (RIO Env) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RIO Env (Either Failure ()) -> ExceptT Failure (RIO Env) ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (RIO Env (Either Failure ()) -> ExceptT Failure (RIO Env) ())
-> RIO Env (Either Failure ()) -> ExceptT Failure (RIO Env) ()
forall a b. (a -> b) -> a -> b
$ User -> RIO Env (Either Failure ())
pullRepo User
usr
Utf8Builder -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Potential hotediting..."
IO () -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Failure (RIO Env) ())
-> IO () -> ExceptT Failure (RIO Env) ()
forall a b. (a -> b) -> a -> b
$ Settings -> Buildable -> IO ()
overwritePkgbuild Settings
ss Buildable
b
IO () -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Failure (RIO Env) ())
-> IO () -> ExceptT Failure (RIO Env) ()
forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
overwriteInstall Settings
ss
IO () -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Failure (RIO Env) ())
-> IO () -> ExceptT Failure (RIO Env) ()
forall a b. (a -> b) -> a -> b
$ Settings -> IO ()
overwritePatches Settings
ss
if Makepkg -> Set Makepkg -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Makepkg
AllSource (Set Makepkg -> Bool)
-> (BuildConfig -> Set Makepkg) -> BuildConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Set Makepkg
makepkgFlagsOf (BuildConfig -> Bool) -> BuildConfig -> Bool
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
then do
let !allsourcePath :: FilePath
allsourcePath = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
srcPkgStore (Maybe FilePath -> FilePath)
-> (BuildConfig -> Maybe FilePath) -> BuildConfig -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> Maybe FilePath
allsourcePathOf (BuildConfig -> FilePath) -> BuildConfig -> FilePath
forall a b. (a -> b) -> a -> b
$ Settings -> BuildConfig
buildConfigOf Settings
ss
IO () -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (User -> IO [FilePath]
makepkgSource User
usr IO [FilePath] -> ([FilePath] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO FilePath) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FilePath -> FilePath -> IO FilePath
moveToSourcePath FilePath
allsourcePath)) ExceptT Failure (RIO Env) ()
-> BuildResult -> ExceptT Failure (RIO Env) BuildResult
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BuildResult
AllSourced
else do
Utf8Builder -> ExceptT Failure (RIO Env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Building package."
NonEmpty FilePath
pNames <- RIO Env (Either Failure (NonEmpty FilePath))
-> ExceptT Failure (RIO Env) (NonEmpty FilePath)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (RIO Env (Either Failure (NonEmpty FilePath))
-> ExceptT Failure (RIO Env) (NonEmpty FilePath))
-> (IO (Either Failure (NonEmpty FilePath))
-> RIO Env (Either Failure (NonEmpty FilePath)))
-> IO (Either Failure (NonEmpty FilePath))
-> ExceptT Failure (RIO Env) (NonEmpty FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either Failure (NonEmpty FilePath))
-> RIO Env (Either Failure (NonEmpty FilePath))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Failure (NonEmpty FilePath))
-> ExceptT Failure (RIO Env) (NonEmpty FilePath))
-> IO (Either Failure (NonEmpty FilePath))
-> ExceptT Failure (RIO Env) (NonEmpty FilePath)
forall a b. (a -> b) -> a -> b
$ Settings -> User -> IO (Either Failure (NonEmpty FilePath))
makepkg Settings
ss User
usr
IO BuildResult -> ExceptT Failure (RIO Env) BuildResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BuildResult -> ExceptT Failure (RIO Env) BuildResult)
-> (IO (NonEmpty PackagePath) -> IO BuildResult)
-> IO (NonEmpty PackagePath)
-> ExceptT Failure (RIO Env) BuildResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty PackagePath -> BuildResult)
-> IO (NonEmpty PackagePath) -> IO BuildResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty PackagePath -> BuildResult
Built (IO (NonEmpty PackagePath)
-> ExceptT Failure (RIO Env) BuildResult)
-> IO (NonEmpty PackagePath)
-> ExceptT Failure (RIO Env) BuildResult
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO PackagePath)
-> NonEmpty FilePath -> IO (NonEmpty PackagePath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Settings -> FilePath -> IO PackagePath
moveToCachePath Settings
ss) NonEmpty FilePath
pNames
Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
DeleteBuildDir) (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ do
Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Env ())
-> (FilePath -> Utf8Builder) -> FilePath -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString (FilePath -> RIO Env ()) -> FilePath -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Deleting build directory: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
buildDir
FilePath -> RIO Env ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
removeDirectoryRecursive FilePath
buildDir
Either Failure BuildResult -> RIO Env (Either Failure BuildResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Failure BuildResult
r
createWritableIfMissing :: FilePath -> RIO Env ()
createWritableIfMissing :: FilePath -> RIO Env ()
createWritableIfMissing FilePath
pth = do
Bool
exists <- FilePath -> RIO Env Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
pth
if Bool
exists
then case FilePath
pth of
FilePath
"/var/cache/aura/vcs" -> FilePath -> RIO Env ()
setMode FilePath
"755"
FilePath
"/tmp" -> FilePath -> RIO Env ()
setMode FilePath
"1777"
FilePath
_ -> () -> RIO Env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else RIO Env ExitCode -> RIO Env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO Env ExitCode -> RIO Env ())
-> (ProcessConfig () () () -> RIO Env ExitCode)
-> ProcessConfig () () ()
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> RIO Env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO Env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO Env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> RIO Env ())
-> ProcessConfig () () () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"mkdir" [FilePath
"-p", FilePath
"-m755", FilePath
pth]
where
setMode :: String -> RIO Env ()
setMode :: FilePath -> RIO Env ()
setMode FilePath
mode = RIO Env ExitCode -> RIO Env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO Env ExitCode -> RIO Env ())
-> (ProcessConfig () () () -> RIO Env ExitCode)
-> ProcessConfig () () ()
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> RIO Env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO Env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO Env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> RIO Env ())
-> ProcessConfig () () () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"chmod" [FilePath
mode, FilePath
pth]
getBuildDir :: Buildable -> IO FilePath
getBuildDir :: Buildable -> IO FilePath
getBuildDir Buildable
b
| PkgName -> Bool
isDevelPkg (PkgName -> Bool) -> PkgName -> Bool
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b = PkgName -> IO FilePath
vcsBuildDir (PkgName -> IO FilePath) -> PkgName -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b
| Bool
otherwise = Buildable -> IO FilePath
randomDirName Buildable
b
vcsBuildDir :: PkgName -> IO FilePath
vcsBuildDir :: PkgName -> IO FilePath
vcsBuildDir (PkgName Text
pn) = do
FilePath
pwd <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
pwd FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack Text
pn
randomDirName :: Buildable -> IO FilePath
randomDirName :: Buildable -> IO FilePath
randomDirName Buildable
b = do
FilePath
pwd <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
UTCTime Day
_ DiffTime
dt <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTime
let nh :: Int
nh = Text -> Int
forall a. Hashable a => a -> Int
hash (Text -> Int) -> (PkgName -> Text) -> PkgName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> Text
pnName (PkgName -> Int) -> PkgName -> Int
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b
vh :: Int
vh = Versioning -> Int
forall a. Hashable a => a -> Int
hash (Versioning -> Int) -> Versioning -> Int
forall a b. (a -> b) -> a -> b
$ Buildable -> Versioning
bVersion Buildable
b
v :: Int
v = Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
nh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor DiffTime
dt
dir :: FilePath
dir = Text -> FilePath
T.unpack (PkgName -> Text
pnName (PkgName -> Text) -> PkgName -> Text
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
v
FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
pwd FilePath -> FilePath -> FilePath
</> FilePath
dir
cloneRepo :: Buildable -> User -> RIO Env (Either Failure FilePath)
cloneRepo :: Buildable -> User -> RIO Env (Either Failure FilePath)
cloneRepo Buildable
pkg User
usr = do
FilePath
currDir <- IO FilePath -> RIO Env FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Env ()) -> Utf8Builder -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Currently in: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
currDir
Maybe FilePath
scriptsDir <- IO (Maybe FilePath) -> RIO Env (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> RIO Env (Maybe FilePath))
-> IO (Maybe FilePath) -> RIO Env (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ User -> FilePath -> [FilePath] -> IO ()
forall (m :: * -> *).
MonadIO m =>
User -> FilePath -> [FilePath] -> m ()
chown User
usr FilePath
currDir [] IO () -> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Buildable -> IO (Maybe FilePath)
clone Buildable
pkg
Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"git: Initial cloning complete."
case Maybe FilePath
scriptsDir of
Maybe FilePath
Nothing -> Either Failure FilePath -> RIO Env (Either Failure FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure FilePath -> RIO Env (Either Failure FilePath))
-> (PkgName -> Either Failure FilePath)
-> PkgName
-> RIO Env (Either Failure FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure FilePath
forall a b. a -> Either a b
Left (Failure -> Either Failure FilePath)
-> (PkgName -> Failure) -> PkgName -> Either Failure FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> Failure) -> (PkgName -> FailMsg) -> PkgName -> Failure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Language -> Doc AnsiStyle) -> FailMsg
FailMsg((Language -> Doc AnsiStyle) -> FailMsg)
-> (PkgName -> Language -> Doc AnsiStyle) -> PkgName -> FailMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> Language -> Doc AnsiStyle
buildFail_7 (PkgName -> RIO Env (Either Failure FilePath))
-> PkgName -> RIO Env (Either Failure FilePath)
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
pkg
Just FilePath
sd -> User -> FilePath -> [FilePath] -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
User -> FilePath -> [FilePath] -> m ()
chown User
usr FilePath
sd [FilePath
"-R"] RIO Env ()
-> Either Failure FilePath -> RIO Env (Either Failure FilePath)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FilePath -> Either Failure FilePath
forall a b. b -> Either a b
Right FilePath
sd
pullRepo :: User -> RIO Env (Either Failure ())
pullRepo :: User -> RIO Env (Either Failure ())
pullRepo User
usr = do
Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"git: Clearing worktree. "
RIO Env ExitCode -> RIO Env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO Env ExitCode -> RIO Env ())
-> (ProcessConfig () () () -> RIO Env ExitCode)
-> ProcessConfig () () ()
-> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> RIO Env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO Env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO Env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> RIO Env ())
-> ProcessConfig () () () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"git" [FilePath
"reset", FilePath
"--hard", FilePath
"HEAD"]
Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO Env ()) -> Utf8Builder -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"git: Pulling repo as " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (User -> Text
user User
usr)
UserEntry
ue <- IO UserEntry -> RIO Env UserEntry
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserEntry -> RIO Env UserEntry)
-> (User -> IO UserEntry) -> User -> RIO Env UserEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO UserEntry
getUserEntryForName (FilePath -> IO UserEntry)
-> (User -> FilePath) -> User -> IO UserEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (User -> Text) -> User -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Text
user (User -> RIO Env UserEntry) -> User -> RIO Env UserEntry
forall a b. (a -> b) -> a -> b
$ User
usr
let uid :: UserID
uid = UserEntry -> UserID
userID UserEntry
ue
let gid :: GroupID
gid = UserEntry -> GroupID
userGroupID UserEntry
ue
ExitCode
ec <- ProcessConfig () () () -> RIO Env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO Env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO Env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserID -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
UserID
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildUser UserID
uid (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupID -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
GroupID
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setChildGroup GroupID
gid (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> RIO Env ExitCode)
-> ProcessConfig () () () -> RIO Env ExitCode
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"git" [FilePath
"pull"]
case ExitCode
ec of
ExitFailure Int
_ -> Either Failure () -> RIO Env (Either Failure ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Failure () -> RIO Env (Either Failure ()))
-> (FailMsg -> Either Failure ())
-> FailMsg
-> RIO Env (Either Failure ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Either Failure ()
forall a b. a -> Either a b
Left (Failure -> Either Failure ())
-> (FailMsg -> Failure) -> FailMsg -> Either Failure ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env (Either Failure ()))
-> FailMsg -> RIO Env (Either Failure ())
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
buildFail_12
ExitCode
ExitSuccess -> IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (User -> FilePath -> [FilePath] -> IO ()
forall (m :: * -> *).
MonadIO m =>
User -> FilePath -> [FilePath] -> m ()
chown User
usr FilePath
"." [FilePath
"-R"]) RIO Env () -> Either Failure () -> RIO Env (Either Failure ())
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> () -> Either Failure ()
forall a b. b -> Either a b
Right ()
overwritePkgbuild :: Settings -> Buildable -> IO ()
overwritePkgbuild :: Settings -> Buildable -> IO ()
overwritePkgbuild Settings
ss Buildable
b = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
HotEdit) (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
ans <- Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss (PkgName -> Language -> Doc AnsiStyle
hotEdit_1 (PkgName -> Language -> Doc AnsiStyle)
-> PkgName -> Language -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ans (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
edit (Settings -> FilePath
editorOf Settings
ss) FilePath
"PKGBUILD"
overwriteInstall :: Settings -> IO ()
overwriteInstall :: Settings -> IO ()
overwriteInstall Settings
ss = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
HotEdit) (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[FilePath]
files <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory IO FilePath -> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listDirectory
case (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".install") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName) [FilePath]
files of
Maybe FilePath
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just FilePath
_ -> do
Bool
ans <- Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss Language -> Doc AnsiStyle
hotEdit_2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ans (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
edit (Settings -> FilePath
editorOf Settings
ss) FilePath
".install"
overwritePatches :: Settings -> IO ()
overwritePatches :: Settings -> IO ()
overwritePatches Settings
ss = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> BuildSwitch -> Bool
switch Settings
ss BuildSwitch
HotEdit) (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[FilePath]
files <- IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory IO FilePath -> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
listDirectory
let !patches :: [FilePath]
patches = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".patch") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
files
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> IO ()
f [FilePath]
patches
where
f :: FilePath -> IO ()
f :: FilePath -> IO ()
f FilePath
p = do
Bool
ans <- Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss ((Language -> Doc AnsiStyle) -> IO Bool)
-> (Language -> Doc AnsiStyle) -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Language -> Doc AnsiStyle
hotEdit_3 FilePath
p
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ans (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
edit (Settings -> FilePath
editorOf Settings
ss) FilePath
p
buildFail :: Failure -> RIO Env (Maybe a)
buildFail :: Failure -> RIO Env (Maybe a)
buildFail Failure
err = do
Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
case Failure
err of
Failure
Silent -> () -> RIO Env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Failure (FailMsg Language -> Doc AnsiStyle
fm) -> Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
scold Settings
ss Language -> Doc AnsiStyle
fm
Settings
-> (Language -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle)
-> RIO Env (Maybe a)
-> RIO Env (Maybe a)
forall e a.
Settings
-> (Language -> Doc AnsiStyle)
-> (Language -> Doc AnsiStyle)
-> RIO e a
-> RIO e a
withOkay Settings
ss Language -> Doc AnsiStyle
buildFail_6 Language -> Doc AnsiStyle
buildFail_5 (RIO Env (Maybe a) -> RIO Env (Maybe a))
-> RIO Env (Maybe a) -> RIO Env (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> RIO Env (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
moveToCachePath :: Settings -> FilePath -> IO PackagePath
moveToCachePath :: Settings -> FilePath -> IO PackagePath
moveToCachePath Settings
ss FilePath
p = IO ExitCode
copy IO ExitCode -> PackagePath -> IO PackagePath
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe PackagePath -> PackagePath
forall a. HasCallStack => Maybe a -> a
fromJust (FilePath -> Maybe PackagePath
packagePath FilePath
newName)
where newName :: FilePath
newName = FilePath
pth FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
p
pth :: FilePath
pth = (FilePath -> FilePath)
-> (FilePath -> FilePath) -> Either FilePath FilePath -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath
forall a. a -> a
id FilePath -> FilePath
forall a. a -> a
id (Either FilePath FilePath -> FilePath)
-> (CommonConfig -> Either FilePath FilePath)
-> CommonConfig
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonConfig -> Either FilePath FilePath
cachePathOf (CommonConfig -> FilePath) -> CommonConfig -> FilePath
forall a b. (a -> b) -> a -> b
$ Settings -> CommonConfig
commonConfigOf Settings
ss
copy :: IO ExitCode
copy = ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> IO ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed
(ProcessConfig () () () -> IO ExitCode)
-> ProcessConfig () () () -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"cp" [FilePath
"--reflink=auto", FilePath
p, FilePath
newName]
moveToSourcePath :: FilePath -> FilePath -> IO FilePath
moveToSourcePath :: FilePath -> FilePath -> IO FilePath
moveToSourcePath FilePath
allsourcePath FilePath
p = do
Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
True FilePath
allsourcePath
IO ExitCode
copy IO ExitCode -> FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FilePath
newName
where
newName :: FilePath
newName = FilePath
allsourcePath FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
p
copy :: IO ExitCode
copy = ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> IO ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed
(ProcessConfig () () () -> IO ExitCode)
-> ProcessConfig () () () -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"cp" [FilePath
"--reflink=auto", FilePath
p, FilePath
newName]