Merge branch 'mtl'

package.yaml

@@ -36,6 +36,7 @@ dependencies:
   - parsers
   - transformers
   - lifted-base
+  - xdg-basedir
 
 executables:
   nixpkgs-update:

src/Clean.hs

@@ -20,7 +20,7 @@ import Prelude hiding (FilePath)
 import Shelly
 import qualified Text.Regex.Applicative as RE
 import Text.Regex.Applicative (RE, (=~))
-import Utils (UpdateEnv(..), Version, canFail, setupNixpkgs, succeded)
+import Utils (UpdateEnv(..), Version, canFail, succeded)
 
 default (T.Text)
 
@@ -33,7 +33,6 @@ archiveRegex version =
 
 fixSrcUrl :: UpdateEnv -> FilePath -> Text -> Text -> Sh Text
 fixSrcUrl updateEnv derivationFile attrPath oldSrcUrl = do
-  setupNixpkgs
   oldDerivationName <-
     T.strip <$>
     cmd "nix" "eval" "-f" "." "--raw" ("pkgs." <> attrPath <> ".name")

src/DeleteMerged.hs

@@ -3,8 +3,7 @@
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 
 module DeleteMerged
-  ( deleteMerged
-  , deleteDone
+  ( deleteDone
   ) where
 
 import Control.Monad (forM_)
@@ -17,36 +16,17 @@ import qualified Data.Vector as V
 import qualified GH
 import qualified Git
 import Shelly
-import Utils (Options, ourShell, setupNixpkgs)
+import Utils (Options, ourShell)
+import qualified Data.Vector as V
 
 default (T.Text)
 
--- | Delete the already merged branches both from local and remote repository
-deleteMerged :: Options -> IO ()
-deleteMerged o =
-  ourShell o $ do
-    setupNixpkgs
-    Git.fetch
-    Git.cleanAndResetToMaster
-    mergedRemoteBranches <- T.lines <$> cmd "git" "branch" "-ra" "--merged"
-    let mergedRemoteAutoUpdateBranches =
-          mergedRemoteBranches & filter ("origin/auto-update/" `T.isInfixOf`) &
-          mapMaybe (T.stripPrefix "remotes/origin/" . T.strip)
-    forM_ mergedRemoteAutoUpdateBranches $ \branch ->
-      cmd "git" "push" "origin" (":" <> branch)
-    mergedBranches <- T.lines <$> cmd "git" "branch" "-a" "--merged"
-    let mergedAutoUpdateBranches =
-          mergedBranches & filter ("auto-update/" `T.isInfixOf`) & map T.strip
-    forM_ mergedAutoUpdateBranches $ \branch -> cmd "git" "branch" "-d" branch
-
 deleteDone :: Options -> IO ()
-deleteDone o =
-  ourShell o $ do
-    setupNixpkgs
-    Git.fetch
-    Git.cleanAndResetToMaster
-    result <- liftIO $ GH.closedAutoUpdateRefs o
-    case result of
-      Left error -> liftIO $ T.putStrLn error
-      Right refs ->
-        V.sequence_ (fmap (\r -> Git.deleteBranch ("auto-update/" <> r)) refs)
+deleteDone o = do
+  Git.fetch
+  Git.cleanAndResetToMaster
+  result <- GH.closedAutoUpdateRefs o
+  case result of
+    Left error -> T.putStrLn error
+    Right refs ->
+      V.sequence_ (fmap (\r -> Git.deleteBranch ("auto-update/" <> r)) refs)

src/Git.hs

@@ -19,85 +19,86 @@ module Git
 
 import Control.Error
 import Control.Monad.Trans.Class
+import Control.Monad.IO.Class
 import Data.Semigroup ((<>))
 import qualified Data.Text as T
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
 import Shelly
 import System.Directory (getHomeDirectory, getModificationTime)
-import Utils (Options(..), UpdateEnv(..), branchName, canFail)
+import Utils (Options(..), UpdateEnv(..), branchName, canFail, shellyET)
 
 default (T.Text)
 
-clean :: Sh ()
-clean = cmd "git" "clean" "-fdx"
+clean :: MonadIO m => m ()
+clean = shelly $ cmd "git" "clean" "-fdx"
 
-cleanAndResetTo :: Text -> Text -> Sh ()
+cleanAndResetTo :: MonadIO m => Text -> Text -> m ()
 cleanAndResetTo branch target = do
-  cmd "git" "reset" "--hard"
+  shelly $ cmd "git" "reset" "--hard"
   clean
-  cmd "git" "checkout" "-B" branch target
-  cmd "git" "reset" "--hard" target
+  shelly $ cmd "git" "checkout" "-B" branch target
+  shelly $ cmd "git" "reset" "--hard" target
   clean
 
-cleanAndResetToMaster :: Sh ()
+cleanAndResetToMaster :: MonadIO m => m ()
 cleanAndResetToMaster = cleanAndResetTo "master" "upstream/master"
 
-cleanAndResetToStaging :: Sh ()
+cleanAndResetToStaging :: MonadIO m => m ()
 cleanAndResetToStaging = cleanAndResetTo "staging" "upstream/staging"
 
-cleanup :: Text -> Sh ()
+cleanup :: MonadIO m => Text -> m ()
 cleanup branchName = do
   cleanAndResetToMaster
-  canFail $ cmd "git" "branch" "-D" branchName
+  shelly $ canFail $ cmd "git" "branch" "-D" branchName
 
-showRef :: Text -> Sh Text
-showRef ref = cmd "git" "show-ref" ref
+showRef :: MonadIO m => Text -> m Text
+showRef ref = shelly $ cmd "git" "show-ref" ref
 
-staleFetchHead :: IO Bool
-staleFetchHead = do
+staleFetchHead :: MonadIO m => m Bool
+staleFetchHead = liftIO $ do
   home <- getHomeDirectory
   let fetchHead = home <> "/.cache/nixpkgs/.git/FETCH_HEAD"
   oneHourAgo <- addUTCTime (fromInteger $ -60 * 60) <$> getCurrentTime
   fetchedLast <- getModificationTime fetchHead
   return (fetchedLast < oneHourAgo)
 
-fetchIfStale :: Sh ()
-fetchIfStale = whenM (liftIO staleFetchHead) fetch
+fetchIfStale :: MonadIO m => m ()
+fetchIfStale = whenM staleFetchHead fetch
 
-fetch :: Sh ()
+fetch :: MonadIO m => m ()
 fetch =
-  canFail $ cmd "git" "fetch" "-q" "--prune" "--multiple" "upstream" "origin"
+  shelly $ canFail $ cmd "git" "fetch" "-q" "--prune" "--multiple" "upstream" "origin"
 
-push :: UpdateEnv -> Sh ()
+push :: MonadIO m => UpdateEnv -> ExceptT Text m ()
 push updateEnv =
-  run_
+  shellyET $ run_
     "git"
     (["push", "--force", "--set-upstream", "origin", branchName updateEnv] ++
      ["--dry-run" | dryRun (options updateEnv)])
 
-checkoutAtMergeBase :: Text -> Sh ()
+checkoutAtMergeBase :: MonadIO m => Text -> m ()
 checkoutAtMergeBase branchName = do
   base <-
-    T.strip <$> cmd "git" "merge-base" "upstream/master" "upstream/staging"
-  cmd "git" "checkout" "-B" branchName base
+    T.strip <$> (shelly $ cmd "git" "merge-base" "upstream/master" "upstream/staging")
+  shelly $ cmd "git" "checkout" "-B" branchName base
 
-checkAutoUpdateBranchDoesn'tExist :: Text -> ExceptT Text Sh ()
+checkAutoUpdateBranchDoesn'tExist :: MonadIO m => Text -> ExceptT Text m ()
 checkAutoUpdateBranchDoesn'tExist packageName = do
   remoteBranches <-
-    lift $ map T.strip . T.lines <$> (silently $ cmd "git" "branch" "--remote")
+    lift $ map T.strip . T.lines <$> (shelly $ silently $ cmd "git" "branch" "--remote")
   when
     (("origin/auto-update/" <> packageName) `elem` remoteBranches)
     (throwE "Update branch already on origin.")
 
-commit :: Text -> Sh ()
-commit = cmd "git" "commit" "-am"
+commit :: MonadIO m => Text -> m ()
+commit ref = shelly $ cmd "git" "commit" "-am" ref
 
-headHash :: Sh Text
-headHash = cmd "git" "rev-parse" "HEAD"
+headHash :: MonadIO m => m Text
+headHash = shelly $ cmd "git" "rev-parse" "HEAD"
 
-deleteBranch :: Text -> Sh ()
-deleteBranch branchName = do
+deleteBranch :: MonadIO m => Text -> m ()
+deleteBranch branchName = shelly $ do
   canFail $ do
     cmd "git" "branch" "-D" branchName
     cmd "git" "push" "origin" (":" <> branchName)

src/Main.hs

@@ -14,7 +14,7 @@ import qualified Options.Applicative as Opt
 import System.Directory (getHomeDirectory)
 import System.Posix.Env (getEnv)
 import Update (updateAll)
-import Utils (Options(..))
+import Utils (Options(..), setupNixpkgs)
 
 default (T.Text)
 
@@ -50,6 +50,7 @@ main :: IO ()
 main = do
   mode <- Opt.execParser programInfo
   options <- makeOptions
+  setupNixpkgs
   case mode of
     DeleteDone -> deleteDone options
     Update -> updateAll options

src/Nix.hs

@@ -4,7 +4,7 @@
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 
 module Nix
-  ( nixEvalE
+  ( nixEvalET
   , compareVersions
   , lookupAttrPath
   , getDerivationFile
@@ -27,14 +27,15 @@ import Control.Applicative ((<|>))
 import Control.Category ((>>>))
 import Control.Error
 import Control.Monad (void)
+import Control.Monad.IO.Class
 import Data.Bifunctor (second)
 import Data.Function ((&))
 import Data.Semigroup ((<>))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Prelude hiding (FilePath)
-import Shelly (FilePath, Sh, cmd, fromText, run, setStdin, toTextIgnore)
-import Utils (UpdateEnv(..), rewriteError, shE, shRE)
+import Shelly (FilePath, Sh, cmd, fromText, run, setStdin, shelly, toTextIgnore)
+import Utils (UpdateEnv(..), rewriteError, overwriteErrorT, shE, shRE, shellyET)
 
 data Raw
   = Raw
@@ -44,32 +45,30 @@ rawOpt :: Raw -> [Text]
 rawOpt Raw = ["--raw"]
 rawOpt NoRaw = []
 
-nixEvalE :: Raw -> Text -> Sh (Either Text Text)
-nixEvalE raw expr =
-  run "nix" (["eval", "-f", "."] <> rawOpt raw <> [expr]) &
-  (fmap T.strip >>> shE >>> rewriteError ("nix eval failed for " <> expr))
+nixEvalET :: MonadIO m => Raw -> Text -> ExceptT Text m Text
+nixEvalET raw expr =
+  run "nix" (["eval", "-f", "."] <> rawOpt raw <> [expr]) & fmap T.strip &
+  shellyET &
+  overwriteErrorT ("nix eval failed for " <> expr)
 
 -- Error if the "new version" is actually newer according to nix
-compareVersions :: UpdateEnv -> Sh (Either Text ())
+compareVersions :: MonadIO m => UpdateEnv -> ExceptT Text m ()
 compareVersions updateEnv = do
   versionComparison <-
-    nixEvalE
+    nixEvalET
       NoRaw
       ("(builtins.compareVersions \"" <> newVersion updateEnv <> "\" \"" <>
        oldVersion updateEnv <>
        "\")")
-  return $
-    case versionComparison of
-      Right "1" -> Right ()
-      Right a ->
-        Left $
-        newVersion updateEnv <> " is not newer than " <> oldVersion updateEnv <>
-        " according to Nix; versionComparison: " <>
-        a
-      Left a -> Left a
- -- This is extremely slow but gives us the best results we know of
+  case versionComparison of
+    "1" -> return ()
+    a -> throwE (
+      newVersion updateEnv <> " is not newer than " <> oldVersion updateEnv <>
+      " according to Nix; versionComparison: " <>
+      a)
 
-lookupAttrPath :: UpdateEnv -> Sh (Either Text Text)
+-- This is extremely slow but gives us the best results we know of
+lookupAttrPath :: MonadIO m => UpdateEnv -> m (Either Text Text)
 lookupAttrPath updateEnv =
   cmd
     "nix-env"
@@ -81,91 +80,88 @@ lookupAttrPath updateEnv =
     "--arg"
     "config"
     "{ allowBroken = true; allowUnfree = true; allowAliases = false; }" &
-  (fmap (head . T.words . head . T.lines) >>>
-   shE >>>
-   rewriteError "nix-env -q failed to find package name with old version")
+  (fmap (T.lines >>> head >>> T.words >>> head)) &
+  shE &
+  rewriteError "nix-env -q failed to find package name with old version" &
+  shelly
 
-getDerivationFile :: UpdateEnv -> Text -> Sh (Either Text FilePath)
+getDerivationFile :: MonadIO m => UpdateEnv -> Text -> m (Either Text FilePath)
 getDerivationFile updateEnv attrPath =
-  cmd "env" "EDITOR=echo" "nix" "edit" attrPath "-f" "." &
-  (fmap T.strip >>>
-   fmap fromText >>> shE >>> rewriteError "Couldn't find derivation file.")
+  cmd "env" "EDITOR=echo" "nix" "edit" attrPath "-f" "." & fmap T.strip &
+  fmap fromText &
+  shE &
+  rewriteError "Couldn't find derivation file." &
+  shelly
 
-getHash :: Text -> Sh (Either Text Text)
-getHash attrPath = do
-  e1 <- nixEvalE Raw ("pkgs." <> attrPath <> ".src.drvAttrs.outputHash")
-  case e1 of
-    Right _ -> return e1
-    Left _ -> nixEvalE Raw ("pkgs." <> attrPath <> ".drvAttrs.outputHash")
+getHash :: MonadIO m => Text -> ExceptT Text m Text
+getHash attrPath =
+  (nixEvalET Raw ("pkgs." <> attrPath <> ".src.drvAttrs.outputHash")) <|>
+    nixEvalET Raw ("pkgs." <> attrPath <> ".drvAttrs.outputHash")
 
-getOldHash :: Text -> Sh (Either Text Text)
+getOldHash :: MonadIO m => Text -> ExceptT Text m Text
 getOldHash attrPath =
   getHash attrPath &
-  rewriteError
+  overwriteErrorT
     ("Could not find old output hash at " <> attrPath <>
      ".src.drvAttrs.outputHash or .drvAttrs.outputHash.")
 
-getMaintainers :: Text -> Sh (Either Text Text)
+getMaintainers :: MonadIO m => Text -> ExceptT Text m Text
 getMaintainers attrPath =
-  nixEvalE
+  nixEvalET
     Raw
     ("(let pkgs = import ./. {}; gh = m : m.github or \"\"; nonempty = s: s != \"\"; addAt = s: \"@\"+s; in builtins.concatStringsSep \" \" (map addAt (builtins.filter nonempty (map gh pkgs." <>
      attrPath <>
      ".meta.maintainers or []))))") &
-  rewriteError ("Could not fetch maintainers for" <> attrPath)
+  overwriteErrorT ("Could not fetch maintainers for" <> attrPath)
 
-readNixBool :: Either Text Text -> Either Text Bool
-readNixBool (Right "true") = Right True
-readNixBool (Right "false") = Right False
-readNixBool (Right a) = Left ("Failed to convert expected nix boolean " <> a)
-readNixBool (Left e) = Left e
+readNixBool :: MonadIO m => ExceptT Text m Text -> ExceptT Text m Bool
+readNixBool t = do
+  text <- t
+  case text of
+    "true" -> return True
+    "false" -> return False
+    a -> throwE ("Failed to read expected nix boolean " <> a)
 
-getIsBroken :: Text -> Sh (Either Text Bool)
+getIsBroken :: MonadIO m => Text -> ExceptT Text m Bool
 getIsBroken attrPath =
-  nixEvalE
+  nixEvalET
     NoRaw
     ("(let pkgs = import ./. {}; in pkgs." <> attrPath <>
      ".meta.broken or false)") &
-  fmap readNixBool &
-  rewriteError ("Could not get meta.broken for attrpath " <> attrPath)
+  readNixBool &
+  overwriteErrorT ("Could not get meta.broken for attrpath " <> attrPath)
 
-getDescription :: Text -> Sh (Either Text Text)
+getDescription :: MonadIO m => Text -> ExceptT Text m Text
 getDescription attrPath =
-  nixEvalE
+  nixEvalET
     NoRaw
     ("(let pkgs = import ./. {}; in pkgs." <> attrPath <>
      ".meta.description or \"\")") &
-  rewriteError ("Could not get meta.description for attrpath " <> attrPath)
+  overwriteErrorT ("Could not get meta.description for attrpath " <> attrPath)
 
-getSrcUrl :: Text -> Sh (Either Text Text)
-getSrcUrl attrPath = do
-  e1 <-
-    nixEvalE
+getSrcUrl :: MonadIO m => Text -> ExceptT Text m Text
+getSrcUrl attrPath =
+  nixEvalET
+    Raw
+    ("(let pkgs = import ./. {}; in builtins.elemAt pkgs." <> attrPath <>
+     ".src.drvAttrs.urls 0)") <|>
+    nixEvalET
       Raw
       ("(let pkgs = import ./. {}; in builtins.elemAt pkgs." <> attrPath <>
-       ".src.drvAttrs.urls 0)")
-  case e1 of
-    Right _ -> return e1
-    Left _ ->
-      nixEvalE
-        Raw
-        ("(let pkgs = import ./. {}; in builtins.elemAt pkgs." <> attrPath <>
-         ".drvAttrs.urls 0)")
+       ".drvAttrs.urls 0)")
 
-getSrcAttr :: Text -> Text -> Sh (Either Text Text)
+getSrcAttr :: MonadIO m => Text -> Text -> ExceptT Text m Text
 getSrcAttr attr attrPath = do
-  e1 <- nixEvalE NoRaw ("pkgs." <> attrPath <> ".src." <> attr)
-  case e1 of
-    Right _ -> return e1
-    Left _ -> nixEvalE NoRaw ("pkgs." <> attrPath <> "." <> attr)
+  nixEvalET NoRaw ("pkgs." <> attrPath <> ".src." <> attr) <|>
+    nixEvalET NoRaw ("pkgs." <> attrPath <> "." <> attr)
 
-getSrcUrls :: Text -> Sh (Either Text Text)
+getSrcUrls :: MonadIO m => Text -> ExceptT Text m Text
 getSrcUrls = getSrcAttr "urls"
 
-buildCmd :: Text -> Sh Text
+buildCmd :: Text -> Sh ()
 buildCmd attrPath =
   cmd
-      "nix-build"
+    "nix-build"
       "--option"
       "sandbox"
       "true"
@@ -182,17 +178,16 @@ build attrPath = do
     Right _ -> return $ Right ()
     Left _ -> do
       buildLogE <-
-        cmd "nix" "log" "-f" "." attrPath &
-        (shE >>>
-         (fmap . fmap)
-           (T.lines >>> reverse >>> take 30 >>> reverse >>> T.unlines))
+        cmd "nix" "log" "-f" "." attrPath & shE &
+        (fmap . fmap)
+          (T.lines >>> reverse >>> take 30 >>> reverse >>> T.unlines)
       return $
         case buildLogE of
           Left t -> Left "nix log failed trying to get build logs"
           Right buildLog -> Left ("nix build failed.\n" <> buildLog)
 
-cachix :: FilePath -> Sh ()
-cachix resultPath = do
+cachix :: MonadIO m => FilePath -> m ()
+cachix resultPath = shelly $ do
   setStdin (toTextIgnore resultPath)
   void $ shE $ cmd "cachix" "push" "r-ryantm"
 
@@ -202,18 +197,18 @@ numberOfFetchers derivationContents =
   where
     count x = T.count x derivationContents
 
-oldVersionOn :: UpdateEnv -> Text -> Text -> Sh (Either Text ())
+oldVersionOn :: MonadIO m => UpdateEnv -> Text -> Text -> m (Either Text ())
 oldVersionOn updateEnv branchName contents =
   pure
     (assertErr
        ("Old version not present in " <> branchName <> " derivation file.")
        (oldVersion updateEnv `T.isInfixOf` contents))
 
-resultLink :: ExceptT Text Sh FilePath
+resultLink :: MonadIO m => ExceptT Text m FilePath
 resultLink =
   (T.strip >>> fromText) <$> do
-    (ExceptT $ shE $ cmd "readlink" "./result") <|>
-      (ExceptT $ shE $ cmd "readlink" "./result-bin") <|>
+    (shellyET $ cmd "readlink" "./result") <|>
+      (shellyET $ cmd "readlink" "./result-bin") <|>
       throwE "Could not find result link."
 
 sha256Zero :: Text

src/Outpaths.hs

@@ -85,7 +85,6 @@ in
 outPath :: Sh Text
 outPath =
   sub $ do
-    Utils.setupNixpkgs
     cmd
       "curl"
       "-o"

src/Update.hs

@@ -3,6 +3,8 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 
 module Update
@@ -13,11 +15,11 @@ import qualified Blacklist
 import qualified Check
 import Clean (fixSrcUrl)
 import Control.Applicative ((<|>))
-import Control.Category ((>>>))
 import Control.Error
 import Control.Exception (SomeException, throw, toException)
 import Control.Exception.Lifted
 import Control.Monad (forM_, mplus)
+import Control.Monad.Except
 import Control.Monad.Trans.Class
 import Data.Function ((&))
 import Data.IORef
@@ -38,7 +40,7 @@ import NeatInterpolation (text)
 import qualified Nix
 import Outpaths
 import Prelude hiding (FilePath)
-import Shelly
+import Shelly.Lifted
 import Utils
   ( Options(..)
   , UpdateEnv(..)
@@ -51,9 +53,8 @@ import Utils
   , ourShell
   , parseUpdates
   , rewriteError
-  , setupNixpkgs
-  , shE
   , tRead
+  , shE
   )
 
 default (T.Text)
@@ -103,7 +104,7 @@ updateLoop options log (Right (package, oldVersion, newVersion):moreUpdates) mer
   updated <- updatePackage log updateEnv mergeBaseOutpathsContext
   case updated of
     Left failure -> do
-      Git.cleanup (branchName updateEnv)
+      liftIO $ Git.cleanup (branchName updateEnv)
       log $ "FAIL " <> failure
       if ".0" `T.isSuffixOf` newVersion
         then let Just newNewVersion = ".0" `T.stripSuffix` newVersion
@@ -125,27 +126,26 @@ updatePackage ::
 updatePackage log updateEnv mergeBaseOutpathsContext =
   runExceptT $ do
     Blacklist.packageName (packageName updateEnv)
-    lift setupNixpkgs
     -- Check whether requested version is newer than the current one
-    ExceptT $ Nix.compareVersions updateEnv
-    lift Git.fetchIfStale
+    Nix.compareVersions updateEnv
+    liftIO $ Git.fetchIfStale
     Git.checkAutoUpdateBranchDoesn'tExist (packageName updateEnv)
-    lift Git.cleanAndResetToMaster
+    liftIO Git.cleanAndResetToMaster
     attrPath <- ExceptT $ Nix.lookupAttrPath updateEnv
     ensureVersionCompatibleWithPathPin updateEnv attrPath
-    srcUrls <- ExceptT $ Nix.getSrcUrls attrPath
+    srcUrls <- Nix.getSrcUrls attrPath
     Blacklist.srcUrl srcUrls
     Blacklist.attrPath attrPath
+    masterShowRef <- lift $ Git.showRef "master"
+    lift $ log masterShowRef
     derivationFile <- ExceptT $ Nix.getDerivationFile updateEnv attrPath
     flip catches [Handler (\(ex :: SomeException) -> throwE (T.pack (show ex)))] $
       -- Make sure it hasn't been updated on master
      do
       masterDerivationContents <- lift $ readfile derivationFile
-      masterShowRef <- lift $ Git.showRef "master"
-      lift $ log masterShowRef
       ExceptT $ Nix.oldVersionOn updateEnv "master" masterDerivationContents
       -- Make sure it hasn't been updated on staging
-      lift Git.cleanAndResetToStaging
+      liftIO Git.cleanAndResetToStaging
       masterShowRef <- lift $ Git.showRef "staging"
       lift $ log masterShowRef
       stagingDerivationContents <- lift $ readfile derivationFile
@@ -170,14 +170,14 @@ updatePackage log updateEnv mergeBaseOutpathsContext =
         (Nix.numberOfFetchers derivationContents > 1)
         (throwE $ "More than one fetcher in " <> toTextIgnore derivationFile)
       Blacklist.content derivationContents
-      oldHash <- ExceptT $ Nix.getOldHash attrPath
-      oldSrcUrl <- ExceptT $ Nix.getSrcUrl attrPath
+      oldHash <- Nix.getOldHash attrPath
+      oldSrcUrl <- Nix.getSrcUrl attrPath
       lift $
         File.replace
           (oldVersion updateEnv)
           (newVersion updateEnv)
           derivationFile
-      newSrcUrl <- ExceptT $ Nix.getSrcUrl attrPath
+      newSrcUrl <- Nix.getSrcUrl attrPath
       when (oldSrcUrl == newSrcUrl) $ throwE "Source url did not change."
       lift $ File.replace oldHash Nix.sha256Zero derivationFile
       newHash <- Nix.getHashFromBuild (attrPath <> ".src") <|>
@@ -216,7 +216,7 @@ publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opDiff = do
     case Blacklist.checkResult (packageName updateEnv) of
       Right () -> lift $ sub (Check.result updateEnv result)
       Left msg -> pure msg
-  d <- ExceptT $ (Nix.getDescription attrPath)
+  d <- Nix.getDescription attrPath
   let metaDescription =
         "\n\nmeta.description for " <> attrPath <> " is: '" <> d <> "'."
   releaseUrlResult <- liftIO $ GH.releaseUrl newSrcUrl
@@ -233,7 +233,7 @@ publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opDiff = do
         lift $ log e
         return "\n"
       Right msg -> return ("\n[Compare changes on GitHub](" <> msg <> ")\n\n")
-  maintainers <- ExceptT $ (Nix.getMaintainers attrPath)
+  maintainers <- Nix.getMaintainers attrPath
   let maintainersCc =
         if not (T.null maintainers)
           then "\n\ncc " <> maintainers <> " for testing."
@@ -242,36 +242,33 @@ publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opDiff = do
   ExceptT $ shE $ Git.commit commitMsg
   commitHash <- lift $ Git.headHash
   -- Try to push it three times
-  ExceptT $ shE
-    (Git.push updateEnv `orElse` Git.push updateEnv `orElse` Git.push updateEnv)
-  isBroken <- ExceptT $ (Nix.getIsBroken attrPath)
+  Git.push updateEnv <|>  Git.push updateEnv <|> Git.push updateEnv
+  isBroken <- Nix.getIsBroken attrPath
   lift $ untilOfBorgFree
   let base =
         if numPackageRebuilds opDiff < 100
           then "master"
           else "staging"
-  ExceptT $ shE $
-    GH.pr
-      base
-      (prMessage
-         updateEnv
-         isBroken
-         metaDescription
-         releaseUrlMessage
-         compareUrlMessage
-         resultCheckReport
-         commitHash
-         attrPath
-         maintainersCc
-         result
-         (outpathReport opDiff))
-  lift $ Git.cleanAndResetToMaster
+  lift $ GH.pr
+    base
+    (prMessage
+       updateEnv
+       isBroken
+       metaDescription
+       releaseUrlMessage
+       compareUrlMessage
+       resultCheckReport
+       commitHash
+       attrPath
+       maintainersCc
+       result
+       (outpathReport opDiff))
+  liftIO $ Git.cleanAndResetToMaster
 
 repologyUrl :: UpdateEnv -> Text
 repologyUrl updateEnv = [text|https://repology.org/metapackage/$pname/versions|]
   where
-    pname = (packageName >>> T.toLower) updateEnv
-
+    pname = updateEnv & packageName & T.toLower
 commitMessage :: UpdateEnv -> Text -> Text
 commitMessage updateEnv attrPath =
   let oV = oldVersion updateEnv

src/Utils.hs

@@ -15,6 +15,8 @@ module Utils
   , succeded
   , shE
   , shRE
+  , shellyET
+  , overwriteErrorT
   , rewriteError
   , eitherToError
   , branchName
@@ -22,14 +24,19 @@ module Utils
   , ourSilentShell
   ) where
 
+import Control.Category ((>>>))
 import Control.Error
 import Control.Exception (Exception)
+import Control.Monad.IO.Class
 import Data.Bifunctor (first)
 import Data.Semigroup ((<>))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Prelude hiding (FilePath)
-import Shelly
+import Shelly.Lifted
+import System.Directory
+import System.Environment
+import System.Environment.XDG.BaseDir
 
 default (T.Text)
 
@@ -48,17 +55,18 @@ data UpdateEnv = UpdateEnv
   , options :: Options
   }
 
-setupNixpkgs :: Sh ()
+setupNixpkgs :: IO ()
 setupNixpkgs = do
-  home <- get_env_text "HOME"
-  let nixpkgsPath = home </> ".cache" </> "nixpkgs"
-  unlessM (test_e nixpkgsPath) $ do
-    cmd "hub" "clone" "nixpkgs" nixpkgsPath -- requires that user has forked nixpkgs
-    cd nixpkgsPath
-    cmd "git" "remote" "add" "upstream" "https://github.com/NixOS/nixpkgs"
-    cmd "git" "fetch" "upstream"
-  cd nixpkgsPath
-  setenv "NIX_PATH" ("nixpkgs=" <> toTextIgnore nixpkgsPath)
+  fp <- getUserCacheDir "nixpkgs"
+  exists <- doesDirectoryExist fp
+  unless exists $ do
+    shelly $ run "hub" ["clone", "nixpkgs", T.pack fp] -- requires that user has forked nixpkgs
+    setCurrentDirectory fp
+    shelly $
+      cmd "git" "remote" "add" "upstream" "https://github.com/NixOS/nixpkgs"
+    shelly $ cmd "git" "fetch" "upstream"
+  setCurrentDirectory fp
+  setEnv "NIX_PATH" ("nixpkgs=" <> fp)
 
 -- | Set environment variables needed by various programs
 setUpEnvironment :: Options -> Sh ()
@@ -99,6 +107,12 @@ shRE s = do
     0 -> return $ Left ""
     c -> return $ Right stderr
 
+shellyET :: MonadIO m => Sh a -> ExceptT Text m a
+shellyET = shE >>> shelly >>> ExceptT
+
+overwriteErrorT :: MonadIO m => Text -> ExceptT Text m a -> ExceptT Text m a
+overwriteErrorT t = fmapLT (const t)
+
 rewriteError :: Text -> Sh (Either Text a) -> Sh (Either Text a)
 rewriteError t = fmap (first (const t))