{-# LANGUAGE ApplicativeDo #-}

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

Command line options for @life@.
-}

module Life.Cli
    ( LifeCommand (..)
    , PathOptions (..)
    , PullOptions (..)

    , parseCommand
    ) where

import Options.Applicative (Parser, ParserInfo, command, execParser, fullDesc, help, helper, info,
                            long, metavar, progDesc, short, strOption, subparser)

import Life.Core (LifePath (..), Owner (..))


-- | Commands to execute
data LifeCommand
    = Init   (Maybe Owner)
    | Add    PathOptions
    | Remove PathOptions
    | Push
    | Pull   PullOptions
    deriving stock (Int -> LifeCommand -> ShowS
[LifeCommand] -> ShowS
LifeCommand -> String
(Int -> LifeCommand -> ShowS)
-> (LifeCommand -> String)
-> ([LifeCommand] -> ShowS)
-> Show LifeCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LifeCommand] -> ShowS
$cshowList :: [LifeCommand] -> ShowS
show :: LifeCommand -> String
$cshow :: LifeCommand -> String
showsPrec :: Int -> LifeCommand -> ShowS
$cshowsPrec :: Int -> LifeCommand -> ShowS
Show)

---------------------------------------------------------------------------
-- Boilerplate
----------------------------------------------------------------------------

commandParser :: Parser LifeCommand
commandParser :: Parser LifeCommand
commandParser = Mod CommandFields LifeCommand -> Parser LifeCommand
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields LifeCommand -> Parser LifeCommand)
-> Mod CommandFields LifeCommand -> Parser LifeCommand
forall a b. (a -> b) -> a -> b
$
    String -> ParserInfo LifeCommand -> Mod CommandFields LifeCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command "init"
            (Parser LifeCommand -> InfoMod LifeCommand -> ParserInfo LifeCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (LifeCommand -> LifeCommand)
forall a. Parser (a -> a)
helper Parser (LifeCommand -> LifeCommand)
-> Parser LifeCommand -> Parser LifeCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Owner -> LifeCommand)
-> Parser (Maybe Owner) -> Parser LifeCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Owner -> LifeCommand
Init (Parser Owner -> Parser (Maybe Owner)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Owner
ownerParser))
                  (InfoMod LifeCommand
forall a. InfoMod a
fullDesc InfoMod LifeCommand -> InfoMod LifeCommand -> InfoMod LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LifeCommand
forall a. String -> InfoMod a
progDesc "Initialize GitHub repository named 'dotfiles' if you don't have one."))
 Mod CommandFields LifeCommand
-> Mod CommandFields LifeCommand -> Mod CommandFields LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo LifeCommand -> Mod CommandFields LifeCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command "add"
            (Parser LifeCommand -> InfoMod LifeCommand -> ParserInfo LifeCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (LifeCommand -> LifeCommand)
forall a. Parser (a -> a)
helper Parser (LifeCommand -> LifeCommand)
-> Parser LifeCommand -> Parser LifeCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PathOptions -> LifeCommand)
-> Parser PathOptions -> Parser LifeCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathOptions -> LifeCommand
Add Parser PathOptions
pathOptionsParser)
                  (InfoMod LifeCommand
forall a. InfoMod a
fullDesc InfoMod LifeCommand -> InfoMod LifeCommand -> InfoMod LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LifeCommand
forall a. String -> InfoMod a
progDesc "Add file or directory to the life configuration."))
 Mod CommandFields LifeCommand
-> Mod CommandFields LifeCommand -> Mod CommandFields LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo LifeCommand -> Mod CommandFields LifeCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command "remove"
            (Parser LifeCommand -> InfoMod LifeCommand -> ParserInfo LifeCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (LifeCommand -> LifeCommand)
forall a. Parser (a -> a)
helper Parser (LifeCommand -> LifeCommand)
-> Parser LifeCommand -> Parser LifeCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PathOptions -> LifeCommand)
-> Parser PathOptions -> Parser LifeCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathOptions -> LifeCommand
Remove Parser PathOptions
pathOptionsParser)
                  (InfoMod LifeCommand
forall a. InfoMod a
fullDesc InfoMod LifeCommand -> InfoMod LifeCommand -> InfoMod LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LifeCommand
forall a. String -> InfoMod a
progDesc "Remove file or directory from the life configuration."))
 Mod CommandFields LifeCommand
-> Mod CommandFields LifeCommand -> Mod CommandFields LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo LifeCommand -> Mod CommandFields LifeCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command "push"
            (Parser LifeCommand -> InfoMod LifeCommand -> ParserInfo LifeCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (LifeCommand -> LifeCommand)
forall a. Parser (a -> a)
helper Parser (LifeCommand -> LifeCommand)
-> Parser LifeCommand -> Parser LifeCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LifeCommand -> Parser LifeCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure LifeCommand
Push)
                  (InfoMod LifeCommand
forall a. InfoMod a
fullDesc InfoMod LifeCommand -> InfoMod LifeCommand -> InfoMod LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LifeCommand
forall a. String -> InfoMod a
progDesc "Updates GitHub repository from local state and push the latest version."))
 Mod CommandFields LifeCommand
-> Mod CommandFields LifeCommand -> Mod CommandFields LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo LifeCommand -> Mod CommandFields LifeCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command "pull"
            (Parser LifeCommand -> InfoMod LifeCommand -> ParserInfo LifeCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (LifeCommand -> LifeCommand)
forall a. Parser (a -> a)
helper Parser (LifeCommand -> LifeCommand)
-> Parser LifeCommand -> Parser LifeCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PullOptions -> LifeCommand)
-> Parser PullOptions -> Parser LifeCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PullOptions -> LifeCommand
Pull Parser PullOptions
pullOptionsParser)
                  (InfoMod LifeCommand
forall a. InfoMod a
fullDesc InfoMod LifeCommand -> InfoMod LifeCommand -> InfoMod LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LifeCommand
forall a. String -> InfoMod a
progDesc "Updates local state of '.life' and 'dotfiles' from GitHub repository."))


optionsInfo :: ParserInfo LifeCommand
optionsInfo :: ParserInfo LifeCommand
optionsInfo = Parser LifeCommand -> InfoMod LifeCommand -> ParserInfo LifeCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser (LifeCommand -> LifeCommand)
forall a. Parser (a -> a)
helper  Parser (LifeCommand -> LifeCommand)
-> Parser LifeCommand -> Parser LifeCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LifeCommand
commandParser)
    (InfoMod LifeCommand
forall a. InfoMod a
fullDesc InfoMod LifeCommand -> InfoMod LifeCommand -> InfoMod LifeCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LifeCommand
forall a. String -> InfoMod a
progDesc "life-sync synchronize your personal configs")

parseCommand :: IO LifeCommand
parseCommand :: IO LifeCommand
parseCommand = ParserInfo LifeCommand -> IO LifeCommand
forall a. ParserInfo a -> IO a
execParser ParserInfo LifeCommand
optionsInfo

ownerParser :: Parser Owner
ownerParser :: Parser Owner
ownerParser = (Text -> Owner) -> Parser Text -> Parser Owner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Owner
Owner
     (Parser Text -> Parser Owner) -> Parser Text -> Parser Owner
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
     (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "OWNER"
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help "Your github user name"

----------------------------------------------------------------------------
-- life pull
----------------------------------------------------------------------------

data PullOptions = PullOptions
    { PullOptions -> Maybe Owner
pullOptionsOwner   :: Maybe Owner
    , PullOptions -> [String]
pullOptionsNoFiles :: [FilePath]
    , PullOptions -> [String]
pullOptionsNoDirs  :: [FilePath]
    } deriving stock (Int -> PullOptions -> ShowS
[PullOptions] -> ShowS
PullOptions -> String
(Int -> PullOptions -> ShowS)
-> (PullOptions -> String)
-> ([PullOptions] -> ShowS)
-> Show PullOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PullOptions] -> ShowS
$cshowList :: [PullOptions] -> ShowS
show :: PullOptions -> String
$cshow :: PullOptions -> String
showsPrec :: Int -> PullOptions -> ShowS
$cshowsPrec :: Int -> PullOptions -> ShowS
Show)

pullOptionsParser :: Parser PullOptions
pullOptionsParser :: Parser PullOptions
pullOptionsParser = do
    Maybe Owner
pullOptionsOwner   <- Parser Owner -> Parser (Maybe Owner)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Owner
ownerParser

    -- TODO: reuse LifePath parser here?...
    [String]
pullOptionsNoFiles <- Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser String -> Parser [String])
-> Parser String -> Parser [String]
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                        (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "FILE_PATH"
                       Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "no-file"
                       Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'f'
                       Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help "Excluding these specific files from copying"

    [String]
pullOptionsNoDirs <- Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser String -> Parser [String])
-> Parser String -> Parser [String]
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                       (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "FILE_PATH"
                      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "no-dir"
                      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'd'
                      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help "Excluding these specific directories from copying"

    pure PullOptions :: Maybe Owner -> [String] -> [String] -> PullOptions
PullOptions{..}

----------------------------------------------------------------------------
-- life add and remove
----------------------------------------------------------------------------

newtype PathOptions = PathOptions
     { PathOptions -> LifePath
pathOptionsPath :: LifePath
     } deriving stock (Int -> PathOptions -> ShowS
[PathOptions] -> ShowS
PathOptions -> String
(Int -> PathOptions -> ShowS)
-> (PathOptions -> String)
-> ([PathOptions] -> ShowS)
-> Show PathOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathOptions] -> ShowS
$cshowList :: [PathOptions] -> ShowS
show :: PathOptions -> String
$cshow :: PathOptions -> String
showsPrec :: Int -> PathOptions -> ShowS
$cshowsPrec :: Int -> PathOptions -> ShowS
Show)

pathOptionsParser :: Parser PathOptions
pathOptionsParser :: Parser PathOptions
pathOptionsParser = do
    LifePath
pathOptionsPath <- Parser LifePath
fileParser Parser LifePath -> Parser LifePath -> Parser LifePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser LifePath
dirParser
    pure PathOptions :: LifePath -> PathOptions
PathOptions{..}
  where
    fileParser :: Parser LifePath
    fileParser :: Parser LifePath
fileParser = String -> LifePath
File (String -> LifePath) -> Parser String -> Parser LifePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                        ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "FILE_PATH"
                       Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "file"
                       Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'f'
                        )

    dirParser :: Parser LifePath
    dirParser :: Parser LifePath
dirParser = String -> LifePath
Dir (String -> LifePath) -> Parser String -> Parser LifePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                        ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "DIRECTORY_PATH"
                       Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "dir"
                       Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'd'
                        )