{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Git.FastForward.Parsing
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Handles parsing of 'String' args into 'Env'.
module Git.FastForward.Parsing
  ( parseArgs,
  )
where

import Common.Parsing.Core
import Control.Applicative ((<|>))
import qualified Data.Text as T
import Git.FastForward.Types.Env
import Git.FastForward.Types.MergeType
import Git.Types.GitTypes

-- | Maps parsed [`String`] args into `Right` `Env`, returning
-- any errors as `Left` `ParseErr`. All arguments are optional
-- (i.e. an empty list is valid), but if any are provided then they must
-- be valid or an error will be returned. Valid arguments are:
--
-- @
--   --path=\<string>\
--       Path to the git directory. Any `String` is fine, defaults
--       to the empty string (current directory).
--
--   -u, --merge=upstream
--       Merges upstream via @{u} into each local branch. This is the default.
--
--   -m, --branch-type=master
--       Merges origin/master into each local branch.
--
--   --branch-type=\<other\>
--       Merges \<other\> into each local branch.
--
--   --push=<\list\>
--       List of branches to push to after we're done updating.
--       Each branch is formatted "remote_name branch_name",
--       and each "remote_name branch_name" is separated by a comma.
--       For instance, --push="origin dev, other temp".
--
--   --no-fetch
--       Skips @git fetch@ step.
--
--   -h, --help
--       Returns instructions as `Left` `String`.
-- @
parseArgs :: [String] -> Either ParseErr Env
parseArgs :: [String] -> Either ParseErr Env
parseArgs args :: [String]
args =
  case [AnyParser Acc] -> [String] -> ParseAnd Acc
forall acc.
Monoid acc =>
[AnyParser acc] -> [String] -> ParseAnd acc
parseAll [AnyParser Acc]
allParsers [String]
args of
    ParseAnd (PFailure (Help _)) -> ParseErr -> Either ParseErr Env
forall a b. a -> Either a b
Left (ParseErr -> Either ParseErr Env)
-> ParseErr -> Either ParseErr Env
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Help String
help
    ParseAnd (PFailure (Err arg :: String
arg)) ->
      ParseErr -> Either ParseErr Env
forall a b. a -> Either a b
Left (ParseErr -> Either ParseErr Env)
-> ParseErr -> Either ParseErr Env
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Err (String -> ParseErr) -> String -> ParseErr
forall a b. (a -> b) -> a -> b
$ "Could not parse `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
arg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "`. Try --help."
    ParseAnd (PSuccess acc :: Acc
acc) -> Env -> Either ParseErr Env
forall a b. b -> Either a b
Right (Env -> Either ParseErr Env) -> Env -> Either ParseErr Env
forall a b. (a -> b) -> a -> b
$ Acc -> Env
accToEnv Acc
acc

newtype AccMergeType = AccMergeType MergeType deriving (Int -> AccMergeType -> String -> String
[AccMergeType] -> String -> String
AccMergeType -> String
(Int -> AccMergeType -> String -> String)
-> (AccMergeType -> String)
-> ([AccMergeType] -> String -> String)
-> Show AccMergeType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AccMergeType] -> String -> String
$cshowList :: [AccMergeType] -> String -> String
show :: AccMergeType -> String
$cshow :: AccMergeType -> String
showsPrec :: Int -> AccMergeType -> String -> String
$cshowsPrec :: Int -> AccMergeType -> String -> String
Show)

instance Semigroup AccMergeType where
  (AccMergeType Upstream) <> :: AccMergeType -> AccMergeType -> AccMergeType
<> r :: AccMergeType
r = AccMergeType
r
  l :: AccMergeType
l <> _ = AccMergeType
l

instance Monoid AccMergeType where
  mempty :: AccMergeType
mempty = MergeType -> AccMergeType
AccMergeType MergeType
Upstream

data Acc
  = Acc
      { Acc -> Maybe String
accPath :: Maybe FilePath,
        Acc -> AccMergeType
accMergeType :: AccMergeType,
        Acc -> [Name]
accPush :: [Name],
        Acc -> Bool
accDoFetch :: Bool
      }
  deriving (Int -> Acc -> String -> String
[Acc] -> String -> String
Acc -> String
(Int -> Acc -> String -> String)
-> (Acc -> String) -> ([Acc] -> String -> String) -> Show Acc
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Acc] -> String -> String
$cshowList :: [Acc] -> String -> String
show :: Acc -> String
$cshow :: Acc -> String
showsPrec :: Int -> Acc -> String -> String
$cshowsPrec :: Int -> Acc -> String -> String
Show)

instance Semigroup Acc where
  Acc {accPath :: Acc -> Maybe String
accPath = Maybe String
a, accMergeType :: Acc -> AccMergeType
accMergeType = AccMergeType
m, accPush :: Acc -> [Name]
accPush = [Name]
n, accDoFetch :: Acc -> Bool
accDoFetch = Bool
f}
    <> :: Acc -> Acc -> Acc
<> Acc {accPath :: Acc -> Maybe String
accPath = Maybe String
a', accMergeType :: Acc -> AccMergeType
accMergeType = AccMergeType
m', accPush :: Acc -> [Name]
accPush = [Name]
n', accDoFetch :: Acc -> Bool
accDoFetch = Bool
f'} =
      Maybe String -> AccMergeType -> [Name] -> Bool -> Acc
Acc (Maybe String
a Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
a') (AccMergeType
m AccMergeType -> AccMergeType -> AccMergeType
forall a. Semigroup a => a -> a -> a
<> AccMergeType
m') ([Name]
n [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> [Name]
n') (Bool
f Bool -> Bool -> Bool
&& Bool
f')

instance Monoid Acc where
  mempty :: Acc
mempty = Maybe String -> AccMergeType -> [Name] -> Bool -> Acc
Acc Maybe String
forall a. Monoid a => a
mempty AccMergeType
forall a. Monoid a => a
mempty [Name]
forall a. Monoid a => a
mempty Bool
True

accToEnv :: Acc -> Env
accToEnv :: Acc -> Env
accToEnv Acc {Maybe String
accPath :: Maybe String
accPath :: Acc -> Maybe String
accPath, accMergeType :: Acc -> AccMergeType
accMergeType = (AccMergeType m :: MergeType
m), [Name]
accPush :: [Name]
accPush :: Acc -> [Name]
accPush, Bool
accDoFetch :: Bool
accDoFetch :: Acc -> Bool
accDoFetch} =
  Env :: Maybe String -> MergeType -> [Name] -> Bool -> Env
Env {path :: Maybe String
path = Maybe String
accPath, mergeType :: MergeType
mergeType = MergeType
m, push :: [Name]
push = [Name]
accPush, doFetch :: Bool
doFetch = Bool
accDoFetch}

allParsers :: [AnyParser Acc]
allParsers :: [AnyParser Acc]
allParsers =
  [ AnyParser Acc
pathParser,
    AnyParser Acc
mergeTypeParser,
    AnyParser Acc
mergeFlagParser,
    AnyParser Acc
pushBranchesParser,
    AnyParser Acc
noFetchFlagParser
  ]

pathParser :: AnyParser Acc
pathParser :: AnyParser Acc
pathParser = Parser (Maybe String) Acc -> AnyParser Acc
forall acc a. Parser a acc -> AnyParser acc
AnyParser (Parser (Maybe String) Acc -> AnyParser Acc)
-> Parser (Maybe String) Acc -> AnyParser Acc
forall a b. (a -> b) -> a -> b
$ (String, String -> Maybe (Maybe String),
 Acc -> Maybe String -> Acc)
-> Parser (Maybe String) Acc
forall a acc.
(String, String -> Maybe a, acc -> a -> acc) -> Parser a acc
PrefixParser ("--path=", String -> Maybe (Maybe String)
forall a. (Eq a, IsString a) => a -> Maybe (Maybe a)
parser, Acc -> Maybe String -> Acc
updater)
  where
    parser :: a -> Maybe (Maybe a)
parser "" = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
    parser s :: a
s = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a)) -> Maybe a -> Maybe (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
s
    updater :: Acc -> Maybe String -> Acc
updater acc :: Acc
acc p :: Maybe String
p = Acc
acc {accPath :: Maybe String
accPath = Maybe String
p}

mergeTypeParser :: AnyParser Acc
mergeTypeParser :: AnyParser Acc
mergeTypeParser = Parser AccMergeType Acc -> AnyParser Acc
forall acc a. Parser a acc -> AnyParser acc
AnyParser (Parser AccMergeType Acc -> AnyParser Acc)
-> Parser AccMergeType Acc -> AnyParser Acc
forall a b. (a -> b) -> a -> b
$ (String, String -> Maybe AccMergeType, Acc -> AccMergeType -> Acc)
-> Parser AccMergeType Acc
forall a acc.
(String, String -> Maybe a, acc -> a -> acc) -> Parser a acc
PrefixParser ("--merge=", String -> Maybe AccMergeType
parser, Acc -> AccMergeType -> Acc
updater)
  where
    parser :: String -> Maybe AccMergeType
parser "" = Maybe AccMergeType
forall a. Maybe a
Nothing
    parser "upstream" = AccMergeType -> Maybe AccMergeType
forall a. a -> Maybe a
Just (AccMergeType -> Maybe AccMergeType)
-> AccMergeType -> Maybe AccMergeType
forall a b. (a -> b) -> a -> b
$ MergeType -> AccMergeType
AccMergeType MergeType
Upstream
    parser o :: String
o = AccMergeType -> Maybe AccMergeType
forall a. a -> Maybe a
Just (AccMergeType -> Maybe AccMergeType)
-> AccMergeType -> Maybe AccMergeType
forall a b. (a -> b) -> a -> b
$ MergeType -> AccMergeType
AccMergeType (MergeType -> AccMergeType) -> MergeType -> AccMergeType
forall a b. (a -> b) -> a -> b
$ Name -> MergeType
Other (Name -> MergeType) -> Name -> MergeType
forall a b. (a -> b) -> a -> b
$ Text -> Name
Name (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
o
    updater :: Acc -> AccMergeType -> Acc
updater acc :: Acc
acc m :: AccMergeType
m = Acc
acc {accMergeType :: AccMergeType
accMergeType = AccMergeType
m}

mergeFlagParser :: AnyParser Acc
mergeFlagParser :: AnyParser Acc
mergeFlagParser = Parser AccMergeType Acc -> AnyParser Acc
forall acc a. Parser a acc -> AnyParser acc
AnyParser (Parser AccMergeType Acc -> AnyParser Acc)
-> Parser AccMergeType Acc -> AnyParser Acc
forall a b. (a -> b) -> a -> b
$ (String -> Maybe AccMergeType, Acc -> AccMergeType -> Acc)
-> Parser AccMergeType Acc
forall a acc. (String -> Maybe a, acc -> a -> acc) -> Parser a acc
ExactParser (String -> Maybe AccMergeType
forall a. (Eq a, IsString a) => a -> Maybe AccMergeType
parser, Acc -> AccMergeType -> Acc
updater)
  where
    parser :: a -> Maybe AccMergeType
parser "-u" = AccMergeType -> Maybe AccMergeType
forall a. a -> Maybe a
Just (AccMergeType -> Maybe AccMergeType)
-> AccMergeType -> Maybe AccMergeType
forall a b. (a -> b) -> a -> b
$ MergeType -> AccMergeType
AccMergeType MergeType
Upstream
    parser "-m" = AccMergeType -> Maybe AccMergeType
forall a. a -> Maybe a
Just (AccMergeType -> Maybe AccMergeType)
-> AccMergeType -> Maybe AccMergeType
forall a b. (a -> b) -> a -> b
$ MergeType -> AccMergeType
AccMergeType MergeType
Master
    parser _ = Maybe AccMergeType
forall a. Maybe a
Nothing
    updater :: Acc -> AccMergeType -> Acc
updater acc :: Acc
acc m :: AccMergeType
m = Acc
acc {accMergeType :: AccMergeType
accMergeType = AccMergeType
m}

pushBranchesParser :: AnyParser Acc
pushBranchesParser :: AnyParser Acc
pushBranchesParser = Parser [Name] Acc -> AnyParser Acc
forall acc a. Parser a acc -> AnyParser acc
AnyParser (Parser [Name] Acc -> AnyParser Acc)
-> Parser [Name] Acc -> AnyParser Acc
forall a b. (a -> b) -> a -> b
$ (String, String -> Maybe [Name], Acc -> [Name] -> Acc)
-> Parser [Name] Acc
forall a acc.
(String, String -> Maybe a, acc -> a -> acc) -> Parser a acc
PrefixParser ("--push=", String -> Maybe [Name]
parser, Acc -> [Name] -> Acc
updater)
  where
    parser :: String -> Maybe [Name]
parser "" = Maybe [Name]
forall a. Maybe a
Nothing
    parser s :: String
s = [Name] -> Maybe [Name]
forall a. a -> Maybe a
Just ([Name] -> Maybe [Name]) -> [Name] -> Maybe [Name]
forall a b. (a -> b) -> a -> b
$ Text -> Name
Name (Text -> Name) -> (Text -> Text) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Name) -> [Text] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn "," (String -> Text
T.pack String
s)
    updater :: Acc -> [Name] -> Acc
updater acc :: Acc
acc ps :: [Name]
ps = Acc
acc {accPush :: [Name]
accPush = [Name]
ps}

noFetchFlagParser :: AnyParser Acc
noFetchFlagParser :: AnyParser Acc
noFetchFlagParser = Parser Bool Acc -> AnyParser Acc
forall acc a. Parser a acc -> AnyParser acc
AnyParser (Parser Bool Acc -> AnyParser Acc)
-> Parser Bool Acc -> AnyParser Acc
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Bool, Acc -> Bool -> Acc) -> Parser Bool Acc
forall a acc. (String -> Maybe a, acc -> a -> acc) -> Parser a acc
ExactParser (String -> Maybe Bool
forall a. (Eq a, IsString a) => a -> Maybe Bool
parser, Acc -> Bool -> Acc
updater)
  where
    parser :: a -> Maybe Bool
parser "--no-fetch" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool
False
    parser _ = Maybe Bool
forall a. Maybe a
Nothing
    updater :: Acc -> Bool -> Acc
updater acc :: Acc
acc m :: Bool
m = Acc
acc {accDoFetch :: Bool
accDoFetch = Bool
m}

help :: String
help :: String
help =
  "\nUsage: cli-utils fastforward [OPTIONS]\n\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "Fast-forwards all local branches with --ff-only.\n\nOptions:\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "  --path=<string>\tDirectory path, defaults to current directory.\n\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "  -u, --merge=upstream\tMerges each branches' upstream via @{u}. This is the default.\n\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "  -m, --merge=master\tMerges origin/master into each branch.\n\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "  --merge=<string>\tMerges branch given by <string> into each branch.\n\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "  --push=<list>\t\tList of branches to push to after we're done updating.\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\t\t\tEach branch is formatted \"remote_name branch_name\",\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\t\t\tand each \"remote_name branch_name\" is separated by a comma.\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\t\t\tFor instance, --push=\"origin dev, other temp\"."