module Life.Github
( Owner (..)
, Repo (..)
, checkRemoteSync
, cloneRepo
, insideRepo
, withSynced
, CopyDirection (..)
, copyLife
, addToRepo
, createRepository
, pullUpdateFromRepo
, removeFromRepo
, updateDotfilesRepo
, updateFromRepo
) where
import Control.Exception (catch, throwIO)
import Path (Abs, Dir, File, Path, Rel, toFilePath, (</>))
import Path.IO (copyDirRecur, copyFile, getHomeDir, withCurrentDir)
import System.IO.Error (IOError, isDoesNotExistError)
import Life.Configuration (LifeConfiguration (..), lifeConfigMinus, parseRepoLife)
import Life.Message (chooseYesNo, errorMessage, infoMessage, warningMessage)
import Life.Shell (lifePath, relativeToHome, repoName, ($|))
newtype Owner = Owner { getOwner :: Text } deriving (Show)
newtype Repo = Repo { getRepo :: Text } deriving (Show)
askToPushka :: Text -> IO ()
askToPushka commitMsg = do
"git" ["add", "."]
infoMessage "The following changes are going to be pushed:"
"git" ["diff", "--name-status", "HEAD"]
continue <- chooseYesNo "Would you like to proceed?"
if continue
then pushka commitMsg
else errorMessage "Abort pushing" >> exitFailure
pushka :: Text -> IO ()
pushka commitMsg = do
"git" ["add", "."]
"git" ["commit", "-m", commitMsg]
"git" ["push", "-u", "origin", "master"]
createRepository :: Owner -> Repo -> IO ()
createRepository (Owner owner) (Repo repo) = do
let description = ":computer: Configuration files"
"git" ["init"]
"hub" ["create", "-d", description, owner <> "/" <> repo]
pushka "Create the project"
insideRepo :: IO a -> IO a
insideRepo action = do
repoPath <- relativeToHome repoName
withCurrentDir repoPath action
pushRepo :: Text -> IO ()
pushRepo = insideRepo . askToPushka
cloneRepo :: Owner -> IO ()
cloneRepo (Owner owner) = do
homeDir <- getHomeDir
withCurrentDir homeDir $ do
infoMessage "Using SSH to clone repo..."
"git" ["clone", "git@github.com:" <> owner <> "/dotfiles.git"]
checkRemoteSync :: IO Bool
checkRemoteSync = do
"git" ["fetch", "origin", "master"]
localHash <- "git" $| ["rev-parse", "master"]
remoteHash <- "git" $| ["rev-parse", "origin/master"]
pure $ localHash == remoteHash
withSynced :: IO a -> IO a
withSynced action = insideRepo $ do
infoMessage "Checking if repo is synchnorized..."
isSynced <- checkRemoteSync
if isSynced then do
infoMessage "Repo is up-to-date"
action
else do
warningMessage "Local version of repository is out of date"
shouldSync <- chooseYesNo "Do you want to sync repo with remote?"
if shouldSync then do
"git" ["rebase", "origin/master"]
action
else do
errorMessage "Aborting current command because repository is not synchronized with remote"
exitFailure
data CopyDirection = FromHomeToRepo | FromRepoToHome
pullUpdateFromRepo :: LifeConfiguration -> IO ()
pullUpdateFromRepo life = do
insideRepo $ "git" ["pull", "-r"]
updateFromRepo life
updateFromRepo :: LifeConfiguration -> IO ()
updateFromRepo excludeLife = insideRepo $ do
infoMessage "Copying files from repo to local machine..."
repoLife <- parseRepoLife
let lifeToLive = lifeConfigMinus repoLife excludeLife
copyLife FromRepoToHome lifeToLive
updateDotfilesRepo :: Text -> LifeConfiguration -> IO ()
updateDotfilesRepo commitMsg life = do
copyLife FromHomeToRepo life
pushRepo commitMsg
copyLife :: CopyDirection -> LifeConfiguration -> IO ()
copyLife direction LifeConfiguration{..} = do
copyFiles direction (toList lifeConfigurationFiles)
copyDirs direction (toList lifeConfigurationDirectories)
copyFiles :: CopyDirection -> [Path Rel File] -> IO ()
copyFiles = copyPathList copyFile
copyDirs :: CopyDirection -> [Path Rel Dir] -> IO ()
copyDirs = copyPathList copyDirRecur
copyPathList :: (Path Abs t -> Path Abs t -> IO ())
-> CopyDirection
-> [Path Rel t]
-> IO ()
copyPathList copyAction direction pathList = do
homeDir <- getHomeDir
let repoDir = homeDir </> repoName
for_ pathList $ \entryPath -> do
let homePath = homeDir </> entryPath
let repoPath = repoDir </> entryPath
case direction of
FromHomeToRepo -> copyAction homePath repoPath
FromRepoToHome -> copyAction repoPath homePath
addToRepo :: (Path Abs t -> Path Abs t -> IO ()) -> Path Rel t -> IO ()
addToRepo copyFun path = do
sourcePath <- relativeToHome path
destinationPath <- relativeToHome (repoName </> path)
copyFun sourcePath destinationPath
lifeFile <- relativeToHome lifePath
repoLifeFile <- relativeToHome (repoName </> lifePath)
copyFile lifeFile repoLifeFile
let commitMsg = "Add: " <> toText (toFilePath path)
pushRepo commitMsg
removeFromRepo :: (Path Abs t -> IO ()) -> Path Rel t -> IO ()
removeFromRepo removeFun path = do
absPath <- relativeToHome (repoName </> path)
catch (removeFun absPath) handleNotExist
lifeFile <- relativeToHome lifePath
repoLifeFile <- relativeToHome (repoName </> lifePath)
copyFile lifeFile repoLifeFile
let commitMsg = "Remove: " <> pathTextName
pushRepo commitMsg
where
pathTextName :: Text
pathTextName = toText $ toFilePath path
handleNotExist :: IOError -> IO ()
handleNotExist e = if isDoesNotExistError e
then errorMessage ("File/directory " <> pathTextName <> " is not found") >> exitFailure
else throwIO e