{- |
Copyright:  (c) 2017-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Utilities to work with GitHub repositories using @hub@.
-}

module Life.Github
    (
      -- * Repository utils
      checkRemoteSync
    , cloneRepo
    , createNewBranch
    , doesBranchExist
    , insideRepo
    , withSynced

      -- * Repository manipulation commands
    , copyLife
    , addToRepo
    , createRepository
    , pullUpdateFromRepo
    , removeFromRepo
    , updateDotfilesRepo
    , updateFromRepo
    , getUserLogin
    ) where

import Colourista (errorMessage, infoMessage, warningMessage)
import Control.Exception (catch, throwIO)
import Path (Abs, Dir, File, Path, Rel, toFilePath, (</>))
import Path.IO (copyDirRecur, copyFile, getHomeDir, withCurrentDir)
import Shellmet (($|))
import System.IO.Error (IOError, isDoesNotExistError)

import Life.Configuration (LifeConfiguration (..), lifeConfigMinus, parseRepoLife)
import Life.Core (Branch (..), CommitMsg (..), CopyDirection (..), Owner (..), Repo (..), master)
import Life.Message (chooseYesNo)
import Life.Path (lifePath, relativeToHome, repoName)

import qualified Data.Text as Text


----------------------------------------------------------------------------
-- VSC commands
----------------------------------------------------------------------------

askToPushka :: CommitMsg -> IO ()
askToPushka :: CommitMsg -> IO ()
askToPushka commitMsg :: CommitMsg
commitMsg = do
    "git" ["add", "."]
    Text -> IO ()
infoMessage "The following changes are going to be pushed:"
    "git" ["diff", "--name-status", "HEAD"]
    Bool
continue <- Text -> IO Bool
chooseYesNo "Would you like to proceed?"
    if Bool
continue
    then Branch -> CommitMsg -> IO ()
pushka Branch
master CommitMsg
commitMsg
    else Text -> IO ()
errorMessage "Abort pushing" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

-- | Make a commit and push it.
pushka :: Branch -> CommitMsg -> IO ()
pushka :: Branch -> CommitMsg -> IO ()
pushka (Branch branch :: Text
branch) (CommitMsg commitMsg :: Text
commitMsg) = do
    "git" ["add", "."]
    "git" ["commit", "-m", Text
commitMsg]
    "git" ["push", "-u", "origin", Text
branch]

-- | Creates repository on GitHub inside given folder.
createRepository :: Maybe Owner -> Repo -> IO ()
createRepository :: Maybe Owner -> Repo -> IO ()
createRepository mo :: Maybe Owner
mo (Repo repo :: Text
repo) = do
    Text
owner <- Maybe Owner -> IO Text
getOwnerLogin Maybe Owner
mo
    let description :: Text
description = ":computer: Configuration files"
    "git" ["init"]
    "hub" ["create", "-d", Text
description, Text
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
repo]
    Branch -> CommitMsg -> IO ()
pushka Branch
master (CommitMsg -> IO ()) -> CommitMsg -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CommitMsg
CommitMsg "Create the project"

-- | Get user login from the local global git config.
getUserLogin :: IO Text
getUserLogin :: IO Text
getUserLogin = do
    Text
login <- "git" FilePath -> [Text] -> IO Text
$| ["config", "user.login"]
    if Text
login Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ""
        then Text -> IO ()
errorMessage "user.login is not specified" IO () -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Text
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
        else Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall a. ToText a => a -> Text
toText Text
login

-- | Consider owner from global git config if Owner is not given
getOwnerLogin :: Maybe Owner -> IO Text
getOwnerLogin :: Maybe Owner -> IO Text
getOwnerLogin = IO Text -> (Owner -> IO Text) -> Maybe Owner -> IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Text
getUserLogin (Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (Owner -> Text) -> Owner -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Owner -> Text
unOwner)

----------------------------------------------------------------------------
-- dotfiles workflow
----------------------------------------------------------------------------

-- | Executes action with 'repoName' set as pwd.
insideRepo :: IO a -> IO a
insideRepo :: IO a -> IO a
insideRepo action :: IO a
action = do
    Path Abs Dir
repoPath <- Path Rel Dir -> IO (Path Abs Dir)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel Dir
repoName
    Path Abs Dir -> IO a -> IO a
forall (m :: * -> *) b a.
(MonadIO m, MonadMask m) =>
Path b Dir -> m a -> m a
withCurrentDir Path Abs Dir
repoPath IO a
action

-- | Commits all changes inside 'repoName' and pushes to remote.
pushRepo :: CommitMsg -> IO ()
pushRepo :: CommitMsg -> IO ()
pushRepo = IO () -> IO ()
forall a. IO a -> IO a
insideRepo (IO () -> IO ()) -> (CommitMsg -> IO ()) -> CommitMsg -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommitMsg -> IO ()
askToPushka

-- | Clones @dotfiles@ repository assuming it doesn't exist.
cloneRepo :: Maybe Owner -> IO ()
cloneRepo :: Maybe Owner -> IO ()
cloneRepo mo :: Maybe Owner
mo = do
    Text
owner <- Maybe Owner -> IO Text
getOwnerLogin Maybe Owner
mo
    Path Abs Dir
homeDir <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getHomeDir
    Path Abs Dir -> IO () -> IO ()
forall (m :: * -> *) b a.
(MonadIO m, MonadMask m) =>
Path b Dir -> m a -> m a
withCurrentDir Path Abs Dir
homeDir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
infoMessage "Using SSH to clone repo..."
        "git" ["clone", "git@github.com:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/dotfiles.git"]

-- | Create new branch with given branch name
createNewBranch :: Branch -> IO ()
createNewBranch :: Branch -> IO ()
createNewBranch (Branch branch :: Text
branch) =
    "git" ["checkout", "-b", Text
branch]

-- | Returns true if local @dotfiles@ repository is synchronized with remote repo.
checkRemoteSync :: Branch -> IO Bool
checkRemoteSync :: Branch -> IO Bool
checkRemoteSync (Branch branch :: Text
branch) = do
    "git" ["fetch", "origin", Text
branch]
    Text
localHash  <- "git" FilePath -> [Text] -> IO Text
$| ["rev-parse", Text
branch]
    Text
remoteHash <- "git" FilePath -> [Text] -> IO Text
$| ["rev-parse", "origin/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branch]
    Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text
localHash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
remoteHash

-- | Check if a branch exists in remote repo
doesBranchExist :: Branch -> IO Bool
doesBranchExist :: Branch -> IO Bool
doesBranchExist (Branch branch :: Text
branch) = do
    Text
r <- "git" FilePath -> [Text] -> IO Text
$| ["ls-remote", "--heads", "origin", Text
branch]
    Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Text -> Bool
Text.null Text
r)

withSynced :: Branch -> IO a -> IO a
withSynced :: Branch -> IO a -> IO a
withSynced branch :: Branch
branch@(Branch branchname :: Text
branchname) action :: IO a
action = IO a -> IO a
forall a. IO a -> IO a
insideRepo (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
infoMessage "Checking if repo is synchronized..."
    Bool
isSynced <- Branch -> IO Bool
checkRemoteSync Branch
branch
    if Bool
isSynced then do
        Text -> IO ()
infoMessage "Repo is up-to-date"
        IO a
action
    else do
        Text -> IO ()
warningMessage "Local version of repository is out of date"
        Bool
shouldSync <- Text -> IO Bool
chooseYesNo "Do you want to sync repo with remote?"
        if Bool
shouldSync then do
            "git" ["rebase", "origin/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branchname]
            IO a
action
        else do
            Text -> IO ()
errorMessage "Aborting current command because repository is not synchronized with remote"
            IO a
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

----------------------------------------------------------------------------
-- File manipulation
----------------------------------------------------------------------------

pullUpdateFromRepo :: LifeConfiguration -> IO ()
pullUpdateFromRepo :: LifeConfiguration -> IO ()
pullUpdateFromRepo life :: LifeConfiguration
life = do
    IO () -> IO ()
forall a. IO a -> IO a
insideRepo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ "git" ["pull", "-r"]
    LifeConfiguration -> IO ()
updateFromRepo LifeConfiguration
life

updateFromRepo :: LifeConfiguration -> IO ()
updateFromRepo :: LifeConfiguration -> IO ()
updateFromRepo excludeLife :: LifeConfiguration
excludeLife = IO () -> IO ()
forall a. IO a -> IO a
insideRepo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
infoMessage "Copying files from repo to local machine..."

    LifeConfiguration
repoLife <- IO LifeConfiguration
parseRepoLife
    let lifeToLive :: LifeConfiguration
lifeToLive = LifeConfiguration -> LifeConfiguration -> LifeConfiguration
lifeConfigMinus LifeConfiguration
repoLife LifeConfiguration
excludeLife

    CopyDirection -> LifeConfiguration -> IO ()
copyLife CopyDirection
FromRepoToHome LifeConfiguration
lifeToLive

updateDotfilesRepo :: CommitMsg -> LifeConfiguration -> IO ()
updateDotfilesRepo :: CommitMsg -> LifeConfiguration -> IO ()
updateDotfilesRepo commitMsg :: CommitMsg
commitMsg life :: LifeConfiguration
life = do
    CopyDirection -> LifeConfiguration -> IO ()
copyLife CopyDirection
FromHomeToRepo LifeConfiguration
life
    CommitMsg -> IO ()
pushRepo CommitMsg
commitMsg

copyLife :: CopyDirection -> LifeConfiguration -> IO ()
copyLife :: CopyDirection -> LifeConfiguration -> IO ()
copyLife direction :: CopyDirection
direction LifeConfiguration{..} = do
    CopyDirection -> [Path Rel File] -> IO ()
copyFiles CopyDirection
direction (Set (Path Rel File) -> [Path Rel File]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (Path Rel File)
lifeConfigurationFiles)
    CopyDirection -> [Path Rel Dir] -> IO ()
copyDirs  CopyDirection
direction (Set (Path Rel Dir) -> [Path Rel Dir]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (Path Rel Dir)
lifeConfigurationDirectories)

-- | Copy files to repository and push changes to remote repository.
copyFiles :: CopyDirection -> [Path Rel File] -> IO ()
copyFiles :: CopyDirection -> [Path Rel File] -> IO ()
copyFiles = (Path Abs File -> Path Abs File -> IO ())
-> CopyDirection -> [Path Rel File] -> IO ()
forall t.
(Path Abs t -> Path Abs t -> IO ())
-> CopyDirection -> [Path Rel t] -> IO ()
copyPathList Path Abs File -> Path Abs File -> IO ()
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
copyFile

-- | Copy dirs to repository.
copyDirs :: CopyDirection -> [Path Rel Dir] -> IO ()
copyDirs :: CopyDirection -> [Path Rel Dir] -> IO ()
copyDirs = (Path Abs Dir -> Path Abs Dir -> IO ())
-> CopyDirection -> [Path Rel Dir] -> IO ()
forall t.
(Path Abs t -> Path Abs t -> IO ())
-> CopyDirection -> [Path Rel t] -> IO ()
copyPathList Path Abs Dir -> Path Abs Dir -> IO ()
forall (m :: * -> *) b0 b1.
(MonadIO m, MonadCatch m) =>
Path b0 Dir -> Path b1 Dir -> m ()
copyDirRecur

copyPathList
    :: (Path Abs t -> Path Abs t -> IO ())
    -- ^ Copying action
    -> CopyDirection
    -- ^ Describes in which direction files should be copied
    -> [Path Rel t]
    -- ^ List of paths to copy
    -> IO ()
copyPathList :: (Path Abs t -> Path Abs t -> IO ())
-> CopyDirection -> [Path Rel t] -> IO ()
copyPathList copyAction :: Path Abs t -> Path Abs t -> IO ()
copyAction direction :: CopyDirection
direction pathList :: [Path Rel t]
pathList = do
    Path Abs Dir
homeDir    <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getHomeDir
    let repoDir :: Path Abs Dir
repoDir = Path Abs Dir
homeDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
repoName

    [Path Rel t] -> (Path Rel t -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Path Rel t]
pathList ((Path Rel t -> IO ()) -> IO ()) -> (Path Rel t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \entryPath :: Path Rel t
entryPath -> do
        let homePath :: Path Abs t
homePath = Path Abs Dir
homeDir Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
entryPath
        let repoPath :: Path Abs t
repoPath = Path Abs Dir
repoDir Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
entryPath
        case CopyDirection
direction of
            FromHomeToRepo -> Path Abs t -> Path Abs t -> IO ()
copyAction Path Abs t
homePath Path Abs t
repoPath
            FromRepoToHome -> Path Abs t -> Path Abs t -> IO ()
copyAction Path Abs t
repoPath Path Abs t
homePath

-- | Update .life file
updateLifeFile :: IO ()
updateLifeFile :: IO ()
updateLifeFile = do
    Path Abs File
lifeFile <- Path Rel File -> IO (Path Abs File)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel File
lifePath
    Path Abs File
repoLifeFile <- Path Rel File -> IO (Path Abs File)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome (Path Rel Dir
repoName Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
lifePath)
    Path Abs File -> Path Abs File -> IO ()
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
copyFile Path Abs File
lifeFile Path Abs File
repoLifeFile

-- | Adds file or directory to the repository and commits
addToRepo :: (Path Abs t -> Path Abs t -> IO ()) -> Path Rel t -> IO ()
addToRepo :: (Path Abs t -> Path Abs t -> IO ()) -> Path Rel t -> IO ()
addToRepo copyFun :: Path Abs t -> Path Abs t -> IO ()
copyFun path :: Path Rel t
path = do
    -- copy file
    Path Abs t
sourcePath <- Path Rel t -> IO (Path Abs t)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel t
path
    Path Abs t
destinationPath <- Path Rel t -> IO (Path Abs t)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome (Path Rel Dir
repoName Path Rel Dir -> Path Rel t -> Path Rel t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
path)
    Path Abs t -> Path Abs t -> IO ()
copyFun Path Abs t
sourcePath Path Abs t
destinationPath

    IO ()
updateLifeFile

    let commitMsg :: CommitMsg
commitMsg = Text -> CommitMsg
CommitMsg (Text -> CommitMsg) -> Text -> CommitMsg
forall a b. (a -> b) -> a -> b
$ "Add: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText (Path Rel t -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Rel t
path)
    CommitMsg -> IO ()
pushRepo CommitMsg
commitMsg

-- | Removes file or directory from the repository and commits
removeFromRepo :: (Path Abs t -> IO ()) -> Path Rel t -> IO ()
removeFromRepo :: (Path Abs t -> IO ()) -> Path Rel t -> IO ()
removeFromRepo removeFun :: Path Abs t -> IO ()
removeFun path :: Path Rel t
path = do
    Path Abs t
absPath <- Path Rel t -> IO (Path Abs t)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome (Path Rel Dir
repoName Path Rel Dir -> Path Rel t -> Path Rel t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
path)
    IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Path Abs t -> IO ()
removeFun Path Abs t
absPath) IOError -> IO ()
handleNotExist

    IO ()
updateLifeFile

    let commitMsg :: CommitMsg
commitMsg = Text -> CommitMsg
CommitMsg (Text -> CommitMsg) -> Text -> CommitMsg
forall a b. (a -> b) -> a -> b
$ "Remove: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathTextName
    CommitMsg -> IO ()
pushRepo CommitMsg
commitMsg
  where
    pathTextName :: Text
    pathTextName :: Text
pathTextName = FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel t -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Rel t
path

    handleNotExist :: IOError -> IO ()
    handleNotExist :: IOError -> IO ()
handleNotExist e :: IOError
e = if IOError -> Bool
isDoesNotExistError IOError
e
        then Text -> IO ()
errorMessage ("File/directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathTextName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " is not found") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
        else IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOError
e