{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

module Utils
  ( Boundary (..),
    Options (..),
    ProductID,
    URL,
    UpdateEnv (..),
    Version,
    VersionMatcher (..),
    branchName,
    branchPrefix,
    getGithubToken,
    getGithubUser,
    logDir,
    nixBuildOptions,
    nixCommonOptions,
    overwriteErrorT,
    parseUpdates,
    prTitle,
    runLog,
    srcOrMain,
    stripQuotes,
    tRead,
    whenBatch,
  )
where

import Data.Bits ((.|.))
import Data.Maybe (fromJust)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Database.SQLite.Simple (ResultError (..), SQLData (..))
import Database.SQLite.Simple.FromField
  ( FieldParser,
    FromField,
    fromField,
    returnError,
  )
import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok (Ok (..))
import Database.SQLite.Simple.ToField (ToField, toField)
import qualified GitHub as GH
import OurPrelude
import Polysemy.Output
import System.Directory (doesDirectoryExist)
import System.Posix.Directory (createDirectory)
import System.Posix.Env (getEnv)
import System.Posix.Files
  ( directoryMode,
    fileExist,
    groupModes,
    otherExecuteMode,
    otherReadMode,
    ownerModes,
  )
import System.Posix.Temp (mkdtemp)
import System.Posix.Types (FileMode)
import Text.Read (readEither)
import Type.Reflection (Typeable)

default (T.Text)

type ProductID = Text

type Version = Text

type URL = Text

-- | The Ord instance is used to sort lists of matchers in order to compare them
-- as a set, it is not useful for comparing bounds since the ordering of bounds
-- depends on whether it is a start or end bound.
data Boundary a
  = Unbounded
  | Including a
  | Excluding a
  deriving (Boundary a -> Boundary a -> Bool
(Boundary a -> Boundary a -> Bool)
-> (Boundary a -> Boundary a -> Bool) -> Eq (Boundary a)
forall a. Eq a => Boundary a -> Boundary a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Boundary a -> Boundary a -> Bool
$c/= :: forall a. Eq a => Boundary a -> Boundary a -> Bool
== :: Boundary a -> Boundary a -> Bool
$c== :: forall a. Eq a => Boundary a -> Boundary a -> Bool
Eq, Eq (Boundary a)
Eq (Boundary a)
-> (Boundary a -> Boundary a -> Ordering)
-> (Boundary a -> Boundary a -> Bool)
-> (Boundary a -> Boundary a -> Bool)
-> (Boundary a -> Boundary a -> Bool)
-> (Boundary a -> Boundary a -> Bool)
-> (Boundary a -> Boundary a -> Boundary a)
-> (Boundary a -> Boundary a -> Boundary a)
-> Ord (Boundary a)
Boundary a -> Boundary a -> Bool
Boundary a -> Boundary a -> Ordering
Boundary a -> Boundary a -> Boundary a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Boundary a)
forall a. Ord a => Boundary a -> Boundary a -> Bool
forall a. Ord a => Boundary a -> Boundary a -> Ordering
forall a. Ord a => Boundary a -> Boundary a -> Boundary a
min :: Boundary a -> Boundary a -> Boundary a
$cmin :: forall a. Ord a => Boundary a -> Boundary a -> Boundary a
max :: Boundary a -> Boundary a -> Boundary a
$cmax :: forall a. Ord a => Boundary a -> Boundary a -> Boundary a
>= :: Boundary a -> Boundary a -> Bool
$c>= :: forall a. Ord a => Boundary a -> Boundary a -> Bool
> :: Boundary a -> Boundary a -> Bool
$c> :: forall a. Ord a => Boundary a -> Boundary a -> Bool
<= :: Boundary a -> Boundary a -> Bool
$c<= :: forall a. Ord a => Boundary a -> Boundary a -> Bool
< :: Boundary a -> Boundary a -> Bool
$c< :: forall a. Ord a => Boundary a -> Boundary a -> Bool
compare :: Boundary a -> Boundary a -> Ordering
$ccompare :: forall a. Ord a => Boundary a -> Boundary a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Boundary a)
Ord, Int -> Boundary a -> ShowS
[Boundary a] -> ShowS
Boundary a -> String
(Int -> Boundary a -> ShowS)
-> (Boundary a -> String)
-> ([Boundary a] -> ShowS)
-> Show (Boundary a)
forall a. Show a => Int -> Boundary a -> ShowS
forall a. Show a => [Boundary a] -> ShowS
forall a. Show a => Boundary a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Boundary a] -> ShowS
$cshowList :: forall a. Show a => [Boundary a] -> ShowS
show :: Boundary a -> String
$cshow :: forall a. Show a => Boundary a -> String
showsPrec :: Int -> Boundary a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Boundary a -> ShowS
Show, ReadPrec [Boundary a]
ReadPrec (Boundary a)
Int -> ReadS (Boundary a)
ReadS [Boundary a]
(Int -> ReadS (Boundary a))
-> ReadS [Boundary a]
-> ReadPrec (Boundary a)
-> ReadPrec [Boundary a]
-> Read (Boundary a)
forall a. Read a => ReadPrec [Boundary a]
forall a. Read a => ReadPrec (Boundary a)
forall a. Read a => Int -> ReadS (Boundary a)
forall a. Read a => ReadS [Boundary a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Boundary a]
$creadListPrec :: forall a. Read a => ReadPrec [Boundary a]
readPrec :: ReadPrec (Boundary a)
$creadPrec :: forall a. Read a => ReadPrec (Boundary a)
readList :: ReadS [Boundary a]
$creadList :: forall a. Read a => ReadS [Boundary a]
readsPrec :: Int -> ReadS (Boundary a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Boundary a)
Read)

-- | The Ord instance is used to sort lists of matchers in order to compare them
-- as a set, it is not useful for comparing versions.
data VersionMatcher
  = SingleMatcher Version
  | RangeMatcher (Boundary Version) (Boundary Version)
  deriving (VersionMatcher -> VersionMatcher -> Bool
(VersionMatcher -> VersionMatcher -> Bool)
-> (VersionMatcher -> VersionMatcher -> Bool) -> Eq VersionMatcher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionMatcher -> VersionMatcher -> Bool
$c/= :: VersionMatcher -> VersionMatcher -> Bool
== :: VersionMatcher -> VersionMatcher -> Bool
$c== :: VersionMatcher -> VersionMatcher -> Bool
Eq, Eq VersionMatcher
Eq VersionMatcher
-> (VersionMatcher -> VersionMatcher -> Ordering)
-> (VersionMatcher -> VersionMatcher -> Bool)
-> (VersionMatcher -> VersionMatcher -> Bool)
-> (VersionMatcher -> VersionMatcher -> Bool)
-> (VersionMatcher -> VersionMatcher -> Bool)
-> (VersionMatcher -> VersionMatcher -> VersionMatcher)
-> (VersionMatcher -> VersionMatcher -> VersionMatcher)
-> Ord VersionMatcher
VersionMatcher -> VersionMatcher -> Bool
VersionMatcher -> VersionMatcher -> Ordering
VersionMatcher -> VersionMatcher -> VersionMatcher
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionMatcher -> VersionMatcher -> VersionMatcher
$cmin :: VersionMatcher -> VersionMatcher -> VersionMatcher
max :: VersionMatcher -> VersionMatcher -> VersionMatcher
$cmax :: VersionMatcher -> VersionMatcher -> VersionMatcher
>= :: VersionMatcher -> VersionMatcher -> Bool
$c>= :: VersionMatcher -> VersionMatcher -> Bool
> :: VersionMatcher -> VersionMatcher -> Bool
$c> :: VersionMatcher -> VersionMatcher -> Bool
<= :: VersionMatcher -> VersionMatcher -> Bool
$c<= :: VersionMatcher -> VersionMatcher -> Bool
< :: VersionMatcher -> VersionMatcher -> Bool
$c< :: VersionMatcher -> VersionMatcher -> Bool
compare :: VersionMatcher -> VersionMatcher -> Ordering
$ccompare :: VersionMatcher -> VersionMatcher -> Ordering
$cp1Ord :: Eq VersionMatcher
Ord, Int -> VersionMatcher -> ShowS
[VersionMatcher] -> ShowS
VersionMatcher -> String
(Int -> VersionMatcher -> ShowS)
-> (VersionMatcher -> String)
-> ([VersionMatcher] -> ShowS)
-> Show VersionMatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionMatcher] -> ShowS
$cshowList :: [VersionMatcher] -> ShowS
show :: VersionMatcher -> String
$cshow :: VersionMatcher -> String
showsPrec :: Int -> VersionMatcher -> ShowS
$cshowsPrec :: Int -> VersionMatcher -> ShowS
Show, ReadPrec [VersionMatcher]
ReadPrec VersionMatcher
Int -> ReadS VersionMatcher
ReadS [VersionMatcher]
(Int -> ReadS VersionMatcher)
-> ReadS [VersionMatcher]
-> ReadPrec VersionMatcher
-> ReadPrec [VersionMatcher]
-> Read VersionMatcher
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VersionMatcher]
$creadListPrec :: ReadPrec [VersionMatcher]
readPrec :: ReadPrec VersionMatcher
$creadPrec :: ReadPrec VersionMatcher
readList :: ReadS [VersionMatcher]
$creadList :: ReadS [VersionMatcher]
readsPrec :: Int -> ReadS VersionMatcher
$creadsPrec :: Int -> ReadS VersionMatcher
Read)

readField :: (Read a, Typeable a) => FieldParser a
readField :: FieldParser a
readField f :: Field
f@(Field (SQLText Text
t) Int
_) =
  case String -> Either String a
forall a. Read a => String -> Either String a
readEither (Text -> String
T.unpack Text
t) of
    Right a
x -> a -> Ok a
forall a. a -> Ok a
Ok a
x
    Left String
e -> (String -> String -> String -> ResultError)
-> Field -> String -> Ok a
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f (String -> Ok a) -> String -> Ok a
forall a b. (a -> b) -> a -> b
$ String
"read error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e
readField Field
f = (String -> String -> String -> ResultError)
-> Field -> String -> Ok a
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f String
"expecting SQLText column type"

showField :: Show a => a -> SQLData
showField :: a -> SQLData
showField = String -> SQLData
forall a. ToField a => a -> SQLData
toField (String -> SQLData) -> (a -> String) -> a -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

instance FromField VersionMatcher where
  fromField :: FieldParser VersionMatcher
fromField = FieldParser VersionMatcher
forall a. (Read a, Typeable a) => FieldParser a
readField

instance ToField VersionMatcher where
  toField :: VersionMatcher -> SQLData
toField = VersionMatcher -> SQLData
forall a. Show a => a -> SQLData
showField

data Options = Options
  { Options -> Bool
doPR :: Bool,
    Options -> Bool
batchUpdate :: Bool,
    Options -> Name Owner
githubUser :: GH.Name GH.Owner,
    Options -> Text
githubToken :: Text,
    Options -> Bool
makeCVEReport :: Bool,
    Options -> Bool
runNixpkgsReview :: Bool,
    Options -> Bool
calculateOutpaths :: Bool
  }
  deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

data UpdateEnv = UpdateEnv
  { UpdateEnv -> Text
packageName :: Text,
    UpdateEnv -> Text
oldVersion :: Version,
    UpdateEnv -> Text
newVersion :: Version,
    UpdateEnv -> Maybe Text
sourceURL :: Maybe URL,
    UpdateEnv -> Options
options :: Options
  }

whenBatch :: Applicative f => UpdateEnv -> f () -> f ()
whenBatch :: UpdateEnv -> f () -> f ()
whenBatch UpdateEnv
updateEnv = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
batchUpdate (Options -> Bool) -> (UpdateEnv -> Options) -> UpdateEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateEnv -> Options
options (UpdateEnv -> Bool) -> UpdateEnv -> Bool
forall a b. (a -> b) -> a -> b
$ UpdateEnv
updateEnv)

prTitle :: UpdateEnv -> Text -> Text
prTitle :: UpdateEnv -> Text -> Text
prTitle UpdateEnv
updateEnv Text
attrPath =
  let oV :: Text
oV = UpdateEnv -> Text
oldVersion UpdateEnv
updateEnv
      nV :: Text
nV = UpdateEnv -> Text
newVersion UpdateEnv
updateEnv
   in Text -> Text
T.strip [interpolate| $attrPath: $oV -> $nV |]

regDirMode :: FileMode
regDirMode :: FileMode
regDirMode =
  FileMode
directoryMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
ownerModes FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
groupModes FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
otherReadMode
    FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
otherExecuteMode

logsDirectory :: MonadIO m => ExceptT Text m FilePath
logsDirectory :: ExceptT Text m String
logsDirectory = do
  String
dir <-
    Text -> MaybeT m String -> ExceptT Text m String
forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT Text
"Could not get environment variable LOGS_DIRECTORY" (MaybeT m String -> ExceptT Text m String)
-> MaybeT m String -> ExceptT Text m String
forall a b. (a -> b) -> a -> b
$
      m (Maybe String) -> MaybeT m String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe String) -> MaybeT m String)
-> m (Maybe String) -> MaybeT m String
forall a b. (a -> b) -> a -> b
$
        IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$
          String -> IO (Maybe String)
getEnv String
"LOGS_DIRECTORY"
  Bool
dirExists <- IO Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT Text m Bool) -> IO Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
dir
  Text -> Bool -> ExceptT Text m ()
forall (m :: * -> *) e. Monad m => e -> Bool -> ExceptT e m ()
tryAssert (Text
"LOGS_DIRECTORY " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist.") Bool
dirExists
  Bool -> ExceptT Text m () -> ExceptT Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    Bool
dirExists
    ( IO () -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text m ()) -> IO () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
putStrLn String
"creating xdgRuntimeDir" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> FileMode -> IO ()
createDirectory String
dir FileMode
regDirMode
    )
  String -> ExceptT Text m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir

xdgRuntimeDir :: MonadIO m => ExceptT Text m FilePath
xdgRuntimeDir :: ExceptT Text m String
xdgRuntimeDir = do
  String
xDir <-
    Text -> MaybeT m String -> ExceptT Text m String
forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT Text
"Could not get environment variable XDG_RUNTIME_DIR" (MaybeT m String -> ExceptT Text m String)
-> MaybeT m String -> ExceptT Text m String
forall a b. (a -> b) -> a -> b
$
      m (Maybe String) -> MaybeT m String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe String) -> MaybeT m String)
-> m (Maybe String) -> MaybeT m String
forall a b. (a -> b) -> a -> b
$
        IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$
          String -> IO (Maybe String)
getEnv String
"XDG_RUNTIME_DIR"
  Bool
xDirExists <- IO Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT Text m Bool) -> IO Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
xDir
  Text -> Bool -> ExceptT Text m ()
forall (m :: * -> *) e. Monad m => e -> Bool -> ExceptT e m ()
tryAssert (Text
"XDG_RUNTIME_DIR " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
xDir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist.") Bool
xDirExists
  let dir :: String
dir = String
xDir String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/nixpkgs-update"
  Bool
dirExists <- IO Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT Text m Bool) -> IO Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
fileExist String
dir
  Bool -> ExceptT Text m () -> ExceptT Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    Bool
dirExists
    ( IO () -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text m ()) -> IO () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
putStrLn String
"creating xdgRuntimeDir" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> FileMode -> IO ()
createDirectory String
dir FileMode
regDirMode
    )
  String -> ExceptT Text m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir

tmpRuntimeDir :: MonadIO m => ExceptT Text m FilePath
tmpRuntimeDir :: ExceptT Text m String
tmpRuntimeDir = do
  String
dir <- IO String -> ExceptT Text m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT Text m String)
-> IO String -> ExceptT Text m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
mkdtemp String
"nixpkgs-update"
  Bool
dirExists <- IO Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT Text m Bool) -> IO Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
dir
  Text -> Bool -> ExceptT Text m ()
forall (m :: * -> *) e. Monad m => e -> Bool -> ExceptT e m ()
tryAssert
    (Text
"Temporary directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist.")
    Bool
dirExists
  String -> ExceptT Text m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir

logDir :: IO FilePath
logDir :: IO String
logDir = do
  Either Text String
r <-
    ExceptT Text IO String -> IO (Either Text String)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
      ( ExceptT Text IO String
forall (m :: * -> *). MonadIO m => ExceptT Text m String
logsDirectory ExceptT Text IO String
-> ExceptT Text IO String -> ExceptT Text IO String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExceptT Text IO String
forall (m :: * -> *). MonadIO m => ExceptT Text m String
xdgRuntimeDir ExceptT Text IO String
-> ExceptT Text IO String -> ExceptT Text IO String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExceptT Text IO String
forall (m :: * -> *). MonadIO m => ExceptT Text m String
tmpRuntimeDir
          ExceptT Text IO String
-> ExceptT Text IO String -> ExceptT Text IO String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ExceptT Text IO String
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
            Text
"Failed to create log directory."
      )
  case Either Text String
r of
    Right String
dir -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
    Left Text
e -> String -> IO String
forall a. HasCallStack => String -> a
error (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
e

overwriteErrorT :: MonadIO m => Text -> ExceptT Text m a -> ExceptT Text m a
overwriteErrorT :: Text -> ExceptT Text m a -> ExceptT Text m a
overwriteErrorT Text
t = (Text -> Text) -> ExceptT Text m a -> ExceptT Text m a
forall (m :: * -> *) a b r.
Functor m =>
(a -> b) -> ExceptT a m r -> ExceptT b m r
fmapLT (Text -> Text -> Text
forall a b. a -> b -> a
const Text
t)

branchPrefix :: Text
branchPrefix :: Text
branchPrefix = Text
"auto-update/"

branchName :: UpdateEnv -> Text
branchName :: UpdateEnv -> Text
branchName UpdateEnv
ue = Text
branchPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UpdateEnv -> Text
packageName UpdateEnv
ue

parseUpdates :: Text -> [Either Text (Text, Version, Version, Maybe URL)]
parseUpdates :: Text -> [Either Text (Text, Text, Text, Maybe Text)]
parseUpdates = (Text -> Either Text (Text, Text, Text, Maybe Text))
-> [Text] -> [Either Text (Text, Text, Text, Maybe Text)]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Either Text (Text, Text, Text, Maybe Text)
toTriple ([Text] -> Either Text (Text, Text, Text, Maybe Text))
-> (Text -> [Text])
-> Text
-> Either Text (Text, Text, Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) ([Text] -> [Either Text (Text, Text, Text, Maybe Text)])
-> (Text -> [Text])
-> Text
-> [Either Text (Text, Text, Text, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
  where
    toTriple :: [Text] -> Either Text (Text, Version, Version, Maybe URL)
    toTriple :: [Text] -> Either Text (Text, Text, Text, Maybe Text)
toTriple [Text
package, Text
oldVer, Text
newVer] = (Text, Text, Text, Maybe Text)
-> Either Text (Text, Text, Text, Maybe Text)
forall a b. b -> Either a b
Right (Text
package, Text
oldVer, Text
newVer, Maybe Text
forall a. Maybe a
Nothing)
    toTriple [Text
package, Text
oldVer, Text
newVer, Text
url] = (Text, Text, Text, Maybe Text)
-> Either Text (Text, Text, Text, Maybe Text)
forall a b. b -> Either a b
Right (Text
package, Text
oldVer, Text
newVer, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
url)
    toTriple [Text]
line = Text -> Either Text (Text, Text, Text, Maybe Text)
forall a b. a -> Either a b
Left (Text -> Either Text (Text, Text, Text, Maybe Text))
-> Text -> Either Text (Text, Text, Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text
"Unable to parse update: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
line

tRead :: Read a => Text -> a
tRead :: Text -> a
tRead = String -> a
forall a. Read a => String -> a
read (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

srcOrMain :: MonadIO m => (Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain :: (Text -> ExceptT Text m a) -> Text -> ExceptT Text m a
srcOrMain Text -> ExceptT Text m a
et Text
attrPath = Text -> ExceptT Text m a
et (Text
attrPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".src") ExceptT Text m a -> ExceptT Text m a -> ExceptT Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ExceptT Text m a
et Text
attrPath

nixCommonOptions :: [String]
nixCommonOptions :: [String]
nixCommonOptions =
  [ String
"--arg",
    String
"config",
    String
"{ allowBroken = true; allowUnfree = true; allowAliases = false; }",
    String
"--arg",
    String
"overlays",
    String
"[ ]"
  ]

nixBuildOptions :: [String]
nixBuildOptions :: [String]
nixBuildOptions =
  [ String
"--option",
    String
"sandbox",
    String
"true",
    String
"--option",
    String
"restrict-eval",
    String
"true"
  ]
    [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
nixCommonOptions

runLog ::
  Member (Embed IO) r =>
  (Text -> IO ()) ->
  Sem ((Output Text) ': r) a ->
  Sem r a
runLog :: (Text -> IO ()) -> Sem (Output Text : r) a -> Sem r a
runLog Text -> IO ()
logger =
  (forall (rInitial :: EffectRow) x.
 Output Text (Sem rInitial) x -> Sem r x)
-> Sem (Output Text : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Output o -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
logger Text
o

envToken :: IO (Maybe Text)
envToken :: IO (Maybe Text)
envToken = (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. Show a => a -> Text
tshow (Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
getEnv String
"GITHUB_TOKEN"

localToken :: IO (Maybe Text)
localToken :: IO (Maybe Text)
localToken = do
  Bool
exists <- String -> IO Bool
fileExist String
"github_token.txt"
  if Bool
exists
    then (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
"github_token.txt")
    else (Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing)

hubFileLocation :: IO (Maybe FilePath)
hubFileLocation :: IO (Maybe String)
hubFileLocation = do
  Maybe String
xloc <- ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/hub") (Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
getEnv String
"XDG_CONFIG_HOME"
  Maybe String
hloc <- ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/.config/hub") (Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
getEnv String
"HOME"
  Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
xloc Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
hloc)

hubConfigField :: Text -> IO (Maybe Text)
hubConfigField :: Text -> IO (Maybe Text)
hubConfigField Text
field = do
  Maybe String
hubFile <- IO (Maybe String)
hubFileLocation
  case Maybe String
hubFile of
    Maybe String
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just String
file -> do
      Bool
exists <- String -> IO Bool
fileExist String
file
      if Bool -> Bool
not Bool
exists
        then Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        else do
          Text
contents <- String -> IO Text
T.readFile String
file
          let splits :: [Text]
splits = Text -> Text -> [Text]
T.splitOn Text
field Text
contents
              token :: Text
token = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 [Text]
splits)
          Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
token

getGithubToken :: IO Text
getGithubToken :: IO Text
getGithubToken = do
  Maybe Text
et <- IO (Maybe Text)
envToken
  Maybe Text
lt <- IO (Maybe Text)
localToken
  Maybe Text
ht <- Text -> IO (Maybe Text)
hubConfigField Text
"oauth_token: "
  Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text
et Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
lt Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
ht)

getGithubUser :: IO (GH.Name GH.Owner)
getGithubUser :: IO (Name Owner)
getGithubUser = do
  Maybe Text
hubUser <- Text -> IO (Maybe Text)
hubConfigField Text
"user: "
  case Maybe Text
hubUser of
    Just Text
usr -> Name Owner -> IO (Name Owner)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name Owner -> IO (Name Owner)) -> Name Owner -> IO (Name Owner)
forall a b. (a -> b) -> a -> b
$ Text -> Name Owner
GH.mkOwnerName Text
usr
    Maybe Text
Nothing -> Name Owner -> IO (Name Owner)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name Owner -> IO (Name Owner)) -> Name Owner -> IO (Name Owner)
forall a b. (a -> b) -> a -> b
$ Text -> Name Owner
GH.mkOwnerName Text
"r-ryantm"

stripQuotes :: Text -> Maybe Text
stripQuotes :: Text -> Maybe Text
stripQuotes = Text -> Text -> Maybe Text
T.stripPrefix Text
"\"" (Text -> Maybe Text) -> (Text -> Maybe Text) -> Text -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Text -> Maybe Text
T.stripSuffix Text
"\""