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

Main entry point for the @life@ executable.
-}

module Life.Main
    ( lifeMain
    ) where

import Path (parseRelDir, parseRelFile)

import Life.Cli (LifeCommand (..), PathOptions (..), PullOptions (..), parseCommand)
import Life.Main.Add (lifeAdd)
import Life.Main.Init (lifeInit)
import Life.Main.Pull (lifePull)
import Life.Main.Push (lifePush)
import Life.Main.Remove (lifeRemove)

import qualified Data.Set as Set


lifeMain :: IO ()
lifeMain :: IO ()
lifeMain = IO LifeCommand
parseCommand IO LifeCommand -> (LifeCommand -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Init   owner :: Maybe Owner
owner           -> Maybe Owner -> IO ()
lifeInit   Maybe Owner
owner
    Add    PathOptions{..} -> LifePath -> IO ()
lifeAdd    LifePath
pathOptionsPath
    Remove PathOptions{..} -> LifePath -> IO ()
lifeRemove LifePath
pathOptionsPath
    Push                   -> IO ()
lifePush
    Pull   PullOptions{..} -> do
        Set (Path Rel File)
withoutFiles <- [Path Rel File] -> Set (Path Rel File)
forall a. Ord a => [a] -> Set a
Set.fromList ([Path Rel File] -> Set (Path Rel File))
-> IO [Path Rel File] -> IO (Set (Path Rel File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Path Rel File))
-> [FilePath] -> IO [Path Rel File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile [FilePath]
pullOptionsNoFiles
        Set (Path Rel Dir)
withoutDirs  <- [Path Rel Dir] -> Set (Path Rel Dir)
forall a. Ord a => [a] -> Set a
Set.fromList ([Path Rel Dir] -> Set (Path Rel Dir))
-> IO [Path Rel Dir] -> IO (Set (Path Rel Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Path Rel Dir)) -> [FilePath] -> IO [Path Rel Dir]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir  [FilePath]
pullOptionsNoDirs
        Maybe Owner -> Set (Path Rel File) -> Set (Path Rel Dir) -> IO ()
lifePull Maybe Owner
pullOptionsOwner Set (Path Rel File)
withoutFiles Set (Path Rel Dir)
withoutDirs