{-# LANGUAGE OverloadedStrings #-}
module Git.FastForward.Core.Internal
( branchUpToDate,
mergeTypeToCmd,
remoteUpToDate,
textToLocalBranches,
)
where
import qualified Data.Foldable as F
import qualified Data.Text as T
import Git.FastForward.Types.LocalBranches
import Git.FastForward.Types.MergeType
import Git.Types.GitTypes
data LocalBranchesParser = LocalBranchesParser (Maybe CurrentBranch) [Name]
textToLocalBranches :: T.Text -> Either T.Text LocalBranches
textToLocalBranches :: Text -> Either Text LocalBranches
textToLocalBranches s :: Text
s =
let ls :: [Text]
ls = Text -> [Text]
T.lines Text
s
res :: LocalBranchesParser
res = [Text] -> LocalBranchesParser
linesToParser [Text]
ls
in case LocalBranchesParser
res of
LocalBranchesParser (Just curr :: CurrentBranch
curr) ns :: [CurrentBranch]
ns -> LocalBranches -> Either Text LocalBranches
forall a b. b -> Either a b
Right (LocalBranches -> Either Text LocalBranches)
-> LocalBranches -> Either Text LocalBranches
forall a b. (a -> b) -> a -> b
$ CurrentBranch -> [CurrentBranch] -> LocalBranches
LocalBranches CurrentBranch
curr [CurrentBranch]
ns
_ -> Text -> Either Text LocalBranches
forall a b. a -> Either a b
Left (Text -> Either Text LocalBranches)
-> Text -> Either Text LocalBranches
forall a b. (a -> b) -> a -> b
$ "Error parsing local branches: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
linesToParser :: [T.Text] -> LocalBranchesParser
linesToParser :: [Text] -> LocalBranchesParser
linesToParser = (LocalBranchesParser -> Text -> LocalBranchesParser)
-> LocalBranchesParser -> [Text] -> LocalBranchesParser
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' LocalBranchesParser -> Text -> LocalBranchesParser
f (Maybe CurrentBranch -> [CurrentBranch] -> LocalBranchesParser
LocalBranchesParser Maybe CurrentBranch
forall a. Maybe a
Nothing [])
where
f :: LocalBranchesParser -> Text -> LocalBranchesParser
f (LocalBranchesParser curr :: Maybe CurrentBranch
curr ns :: [CurrentBranch]
ns) txt :: Text
txt =
case Text -> Either CurrentBranch CurrentBranch
starredBranch Text
txt of
Right curr' :: CurrentBranch
curr' -> Maybe CurrentBranch -> [CurrentBranch] -> LocalBranchesParser
LocalBranchesParser (CurrentBranch -> Maybe CurrentBranch
forall a. a -> Maybe a
Just CurrentBranch
curr') (CurrentBranch
curr' CurrentBranch -> [CurrentBranch] -> [CurrentBranch]
forall a. a -> [a] -> [a]
: [CurrentBranch]
ns)
Left other :: CurrentBranch
other -> Maybe CurrentBranch -> [CurrentBranch] -> LocalBranchesParser
LocalBranchesParser Maybe CurrentBranch
curr (CurrentBranch
other CurrentBranch -> [CurrentBranch] -> [CurrentBranch]
forall a. a -> [a] -> [a]
: [CurrentBranch]
ns)
starredBranch :: T.Text -> Either Name CurrentBranch
starredBranch :: Text -> Either CurrentBranch CurrentBranch
starredBranch b :: Text
b =
case Text -> Text -> [Text]
T.splitOn "* " Text
b of
[_, curr :: Text
curr] -> CurrentBranch -> Either CurrentBranch CurrentBranch
forall a b. b -> Either a b
Right (CurrentBranch -> Either CurrentBranch CurrentBranch)
-> CurrentBranch -> Either CurrentBranch CurrentBranch
forall a b. (a -> b) -> a -> b
$ Text -> CurrentBranch
Name (Text -> CurrentBranch) -> Text -> CurrentBranch
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
curr
_ -> CurrentBranch -> Either CurrentBranch CurrentBranch
forall a b. a -> Either a b
Left (CurrentBranch -> Either CurrentBranch CurrentBranch)
-> CurrentBranch -> Either CurrentBranch CurrentBranch
forall a b. (a -> b) -> a -> b
$ Text -> CurrentBranch
Name (Text -> CurrentBranch) -> Text -> CurrentBranch
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
b
branchUpToDate :: T.Text -> Bool
branchUpToDate :: Text -> Bool
branchUpToDate t :: Text
t =
Text -> Text -> Bool
T.isPrefixOf "Already up to date" Text
t
Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf "Already up-to-date" Text
t
remoteUpToDate :: T.Text -> Bool
remoteUpToDate :: Text -> Bool
remoteUpToDate t :: Text
t =
Text -> Text -> Bool
T.isPrefixOf "Everything up-to-date" Text
t
Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf "Everything up to date" Text
t
mergeTypeToCmd :: MergeType -> T.Text
mergeTypeToCmd :: MergeType -> Text
mergeTypeToCmd Upstream = "git merge @{u} --ff-only"
mergeTypeToCmd Master = "git merge origin/master --ff-only"
mergeTypeToCmd (Other (Name up :: Text
up)) = "git merge \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
up Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\" --ff-only"