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

Command to update the local state from the remote state.
-}

module Life.Main.Pull
    ( lifePull
    ) where

import Colourista (warningMessage)
import Path (Dir, File, Path, Rel)

import Life.Configuration (LifeConfiguration (..), defaultLifeConfig)
import Life.Core (Owner)
import Life.Github (cloneRepo, pullUpdateFromRepo, updateFromRepo)
import Life.Main.Init (lifeInitQuestion)
import Life.Message (abortCmd, choose)
import Life.Path (LifeExistence (..), whatIsLife)


lifePull :: Maybe Owner -> Set (Path Rel File) -> Set (Path Rel Dir) -> IO ()
lifePull :: Maybe Owner -> Set (Path Rel File) -> Set (Path Rel Dir) -> IO ()
lifePull owner :: Maybe Owner
owner withoutFiles :: Set (Path Rel File)
withoutFiles withoutDirs :: Set (Path Rel Dir)
withoutDirs = IO LifeExistence
whatIsLife IO LifeExistence -> (LifeExistence -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    OnlyRepo _ -> Text -> IO ()
warningMessage ".life file not found" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
pullUpdate
    OnlyLife _ -> Text -> IO ()
warningMessage "dotfiles not found" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
clone IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
update
    NoLife     -> IO ()
initOrPull
    Both _ _   -> IO ()
pullUpdate
  where
    initOrPull :: IO ()
    initOrPull :: IO ()
initOrPull = do
        Text -> IO ()
warningMessage ".life file and dotfiles repo not found"
        Text
action <- Text -> NonEmpty Text -> IO Text
choose
            "Do you want to (F)etch existing repo, (I)nit from scratch or (A)bort operation?"
            ("f" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:|  ["i", "a"])
        case Text
action of
            "f" -> IO ()
clone IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
update
            "i" -> Text -> IO () -> IO ()
lifeInitQuestion "pull" IO ()
forall (f :: * -> *). Applicative f => f ()
pass
            "a" -> Text -> Text -> IO ()
abortCmd "pull" "Cannot find .life and dotfiles"
            _   -> Text -> IO ()
forall a t. (HasCallStack, IsText t) => t -> a
error "Impossible choice"

    life :: LifeConfiguration
    life :: LifeConfiguration
life = LifeConfiguration
defaultLifeConfig
        { lifeConfigurationDirectories :: Set (Path Rel Dir)
lifeConfigurationDirectories = Set (Path Rel Dir)
withoutDirs
        , lifeConfigurationFiles :: Set (Path Rel File)
lifeConfigurationFiles = Set (Path Rel File)
withoutFiles
        }

    clone, update, pullUpdate :: IO ()
    clone :: IO ()
clone = Maybe Owner -> IO ()
cloneRepo Maybe Owner
owner
    update :: IO ()
update = LifeConfiguration -> IO ()
updateFromRepo LifeConfiguration
life
    pullUpdate :: IO ()
pullUpdate = LifeConfiguration -> IO ()
pullUpdateFromRepo LifeConfiguration
life