{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Utils
( Options(..)
, Version
, UpdateEnv(..)
, canFail
, checkAttrPathVersion
, orElse
, setupNixpkgs
, tRead
, parseUpdates
, succeded
, ExitCode(..)
, shE
, rewriteError
, eitherToError
, branchName
, ourShell
) where
import Control.Exception (Exception)
import Data.Bifunctor (first)
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Prelude hiding (FilePath)
import Shelly
default (T.Text)
type Version = Text
data Options = Options
{ dryRun :: Bool
, workingDir :: Text
, githubToken :: Text
}
data UpdateEnv = UpdateEnv
{ packageName :: Text
, oldVersion :: Version
, newVersion :: Version
, options :: Options
}
setupNixpkgs :: Sh ()
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)
-- | Set environment variables needed by various programs
setUpEnvironment :: Options -> Sh ()
setUpEnvironment options = do
setenv "PAGER" ""
setenv "GITHUB_TOKEN" (githubToken options)
ourShell :: Options -> Sh a -> IO a
ourShell o s = shelly $ verbosely $ do
setUpEnvironment o
s
shE :: Sh a -> Sh (Either Text a)
shE s = do
r <- canFail s
status <- lastExitCode
case status of
0 -> return $ Right r
c -> return $ Left ("Exit code: " <> T.pack (show c))
rewriteError :: Text -> Sh (Either Text a) -> Sh (Either Text a)
rewriteError t = fmap (first (const t))
eitherToError :: (Text -> Sh a) -> Sh (Either Text a) -> Sh a
eitherToError errorExit s = do
e <- s
either errorExit return e
canFail :: Sh a -> Sh a
canFail = errExit False
succeded :: Sh a -> Sh Bool
succeded s = do
canFail s
status <- lastExitCode
return (status == 0)
orElse :: Sh a -> Sh a -> Sh a
orElse a b = do
v <- canFail a
status <- lastExitCode
if status == 0
then return v
else b
infixl 3 `orElse`
branchName :: UpdateEnv -> Text
branchName ue = "auto-update/" <> packageName ue
parseUpdates :: Text -> [Either Text (Text, Version, Version)]
parseUpdates = map (toTriple . T.words) . T.lines
where
toTriple :: [Text] -> Either Text (Text, Version, Version)
toTriple [package, oldVersion, newVersion] =
Right (package, oldVersion, newVersion)
toTriple line = Left $ "Unable to parse update: " <> T.unwords line
tRead :: Read a => Text -> a
tRead = read . T.unpack
notElemOf :: (Eq a, Foldable t) => t a -> a -> Bool
notElemOf options = not . flip elem options
-- | Similar to @breakOn@, but will not keep the pattern at the beginning of the suffix.
--
-- Examples:
--
-- > breakOn "::" "a::b::c"
-- ("a","b::c")
clearBreakOn :: Text -> Text -> (Text, Text)
clearBreakOn boundary string =
let (prefix, suffix) = T.breakOn boundary string
in if T.null suffix
then (prefix, suffix)
else (prefix, T.drop (T.length boundary) suffix)
-- | Check if attribute path is not pinned to a certain version.
-- If a derivation is expected to stay at certain version branch,
-- it will usually have the branch as a part of the attribute path.
--
-- Examples:
--
-- >>> checkAttrPathVersion "libgit2_0_25" "0.25.3"
-- True
--
-- >>> checkAttrPathVersion "owncloud90" "9.0.3"
-- True
--
-- >>> checkAttrPathVersion "owncloud-client" "2.4.1"
-- True
--
-- >>> checkAttrPathVersion "owncloud90" "9.1.3"
-- False
checkAttrPathVersion :: Text -> Version -> Bool
checkAttrPathVersion attrPath newVersion =
if "_" `T.isInfixOf` attrPath
then let attrVersionPart =
let (name, version) = clearBreakOn "_" attrPath
in if T.any (notElemOf ('_' : ['0' .. '9'])) version
then Nothing
else Just version
-- Check assuming version part has underscore separators
attrVersionPeriods = T.replace "_" "." <$> attrVersionPart
-- If we don't find version numbers in the attr path, exit success.
in maybe True (`T.isPrefixOf` newVersion) attrVersionPeriods
-- other path
else let attrVersionPart =
let version = T.dropWhile (notElemOf ['0' .. '9']) attrPath
in if T.any (notElemOf ['0' .. '9']) version
then Nothing
else Just version
-- Check assuming version part is the prefix of the version with dots
-- removed. For example, 91 => "9.1"
noPeriodNewVersion = T.replace "." "" newVersion
-- If we don't find version numbers in the attr path, exit success.
in maybe True (`T.isPrefixOf` noPeriodNewVersion) attrVersionPart
newtype ExitCode =
ExitCode Int
deriving (Show)
instance Exception ExitCode