module GitHUD.Config.Parse (
  parseConfigFile
  , commentParser
  , itemParser
  , fallThroughItemParser
  , configItemsFolder
  , ConfigItem(..)
  , colorConfigToColor
  , intensityConfigToIntensity
  , stringConfigToStringList
  , redirectionParser
  , strConfigToRedirection
  , boolConfigToBool
  , intConfigToInt
  ) where

import Control.Monad (void, when)
import System.Posix.Daemon (Redirection(ToFile, DevNull))
import Text.Parsec (parse)
import Text.Parsec.Char (anyChar, char, digit, newline, noneOf, letter, spaces, string)
import Text.Parsec.Combinator (choice, eof, many1, manyTill, optional, sepBy)
import Text.Parsec.Prim (many, try, unexpected, (<|>), (<?>))
import Text.Parsec.String (parseFromFile, Parser)

import GitHUD.Config.Types
import GitHUD.Terminal.Types

data ConfigItem = Item String String
                | Comment
                | ErrorLine deriving (ConfigItem -> ConfigItem -> Bool
(ConfigItem -> ConfigItem -> Bool)
-> (ConfigItem -> ConfigItem -> Bool) -> Eq ConfigItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigItem -> ConfigItem -> Bool
$c/= :: ConfigItem -> ConfigItem -> Bool
== :: ConfigItem -> ConfigItem -> Bool
$c== :: ConfigItem -> ConfigItem -> Bool
Eq, Int -> ConfigItem -> ShowS
[ConfigItem] -> ShowS
ConfigItem -> String
(Int -> ConfigItem -> ShowS)
-> (ConfigItem -> String)
-> ([ConfigItem] -> ShowS)
-> Show ConfigItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigItem] -> ShowS
$cshowList :: [ConfigItem] -> ShowS
show :: ConfigItem -> String
$cshow :: ConfigItem -> String
showsPrec :: Int -> ConfigItem -> ShowS
$cshowsPrec :: Int -> ConfigItem -> ShowS
Show)

parseConfigFile :: FilePath -> IO Config
parseConfigFile :: String -> IO Config
parseConfigFile String
filePath = do
  Either ParseError Config
eitherParsed <- Parser Config -> String -> IO (Either ParseError Config)
forall a. Parser a -> String -> IO (Either ParseError a)
parseFromFile Parser Config
configFileParser String
filePath
  Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ (ParseError -> Config)
-> (Config -> Config) -> Either ParseError Config -> Config
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Config -> ParseError -> Config
forall a b. a -> b -> a
const Config
defaultConfig)
    Config -> Config
forall a. a -> a
id
    Either ParseError Config
eitherParsed

configFileParser :: Parser Config
configFileParser :: Parser Config
configFileParser = do
  [ConfigItem]
items <- ParsecT String () Identity ConfigItem
-> ParsecT String () Identity [ConfigItem]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity ConfigItem
configItemParser
  Config -> Parser Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Parser Config) -> Config -> Parser Config
forall a b. (a -> b) -> a -> b
$ (Config -> ConfigItem -> Config)
-> Config -> [ConfigItem] -> Config
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Config -> ConfigItem -> Config
configItemsFolder Config
defaultConfig [ConfigItem]
items

configItemParser :: Parser ConfigItem
configItemParser :: ParsecT String () Identity ConfigItem
configItemParser = [ParsecT String () Identity ConfigItem]
-> ParsecT String () Identity ConfigItem
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
  ParsecT String () Identity ConfigItem
commentParser
  , ParsecT String () Identity ConfigItem
itemParser
  , ParsecT String () Identity ConfigItem
fallThroughItemParser
  ] ParsecT String () Identity ConfigItem
-> String -> ParsecT String () Identity ConfigItem
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"config file line"

endItem :: Parser ()
endItem :: Parser ()
endItem = [Parser ()] -> Parser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
  ParsecT String () Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  , Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  ] Parser () -> String -> Parser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"end of item"

commentParser :: Parser ConfigItem
commentParser :: ParsecT String () Identity ConfigItem
commentParser = ParsecT String () Identity ConfigItem
-> ParsecT String () Identity ConfigItem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity ConfigItem
 -> ParsecT String () Identity ConfigItem)
-> ParsecT String () Identity ConfigItem
-> ParsecT String () Identity ConfigItem
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
  ParsecT String () Identity Char
-> Parser () -> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Parser () -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser ()
endItem)
  ConfigItem -> ParsecT String () Identity ConfigItem
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigItem
Comment

itemParser :: Parser ConfigItem
itemParser :: ParsecT String () Identity ConfigItem
itemParser = ParsecT String () Identity ConfigItem
-> ParsecT String () Identity ConfigItem
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity ConfigItem
 -> ParsecT String () Identity ConfigItem)
-> ParsecT String () Identity ConfigItem
-> ParsecT String () Identity ConfigItem
forall a b. (a -> b) -> a -> b
$ do
  String
key <- ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
validKeyChar (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
key String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
"A key in the config file should not be empty"
  String
value <- ParsecT String () Identity Char
-> Parser () -> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Parser () -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser ()
endItem)
  ConfigItem -> ParsecT String () Identity ConfigItem
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigItem -> ParsecT String () Identity ConfigItem)
-> ConfigItem -> ParsecT String () Identity ConfigItem
forall a b. (a -> b) -> a -> b
$ String -> String -> ConfigItem
Item String
key String
value

validKeyChar :: Parser Char
validKeyChar :: ParsecT String () Identity Char
validKeyChar = ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')

-- | Must not be able to process an empty string
-- This is mandated by the use of 'many' in configFileParser
-- Therefore the definition `manyTill anyChar eof` is invalid, thus using newline
fallThroughItemParser :: Parser ConfigItem
fallThroughItemParser :: ParsecT String () Identity ConfigItem
fallThroughItemParser = do
  ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline)
  ConfigItem -> ParsecT String () Identity ConfigItem
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigItem
ErrorLine

configItemsFolder :: Config -> ConfigItem -> Config
configItemsFolder :: Config -> ConfigItem -> Config
configItemsFolder Config
conf (Item String
"show_part_repo_indicator" String
value) =
  Config
conf { confShowPartRepoIndicator :: Bool
confShowPartRepoIndicator = String -> Bool
boolConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"show_part_merge_branch_commits_diff" String
value) =
  Config
conf { confShowPartMergeBranchCommitsDiff :: Bool
confShowPartMergeBranchCommitsDiff = String -> Bool
boolConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"show_part_local_branch" String
value) =
  Config
conf { confShowPartLocalBranch :: Bool
confShowPartLocalBranch = String -> Bool
boolConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"show_part_commits_to_origin" String
value) =
  Config
conf { confShowPartCommitsToOrigin :: Bool
confShowPartCommitsToOrigin = String -> Bool
boolConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"show_part_local_changes_state" String
value) =
  Config
conf { confShowPartLocalChangesState :: Bool
confShowPartLocalChangesState = String -> Bool
boolConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"show_part_stashes" String
value) =
  Config
conf { confShowPartStashes :: Bool
confShowPartStashes = String -> Bool
boolConfigToIntensity String
value }

configItemsFolder Config
conf (Item String
"git_repo_indicator" String
repoIndicator) = Config
conf { confRepoIndicator :: String
confRepoIndicator = String
repoIndicator }

configItemsFolder Config
conf (Item String
"no_tracked_upstream_text" String
value) =
  Config
conf { confNoTrackedUpstreamString :: String
confNoTrackedUpstreamString = String
value }
configItemsFolder Config
conf (Item String
"no_tracked_upstream_text_color" String
value) =
  Config
conf { confNoTrackedUpstreamStringColor :: Color
confNoTrackedUpstreamStringColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"no_tracked_upstream_text_intensity" String
value) =
  Config
conf { confNoTrackedUpstreamStringIntensity :: ColorIntensity
confNoTrackedUpstreamStringIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"no_tracked_upstream_indicator" String
value) =
  Config
conf { confNoTrackedUpstreamIndicator :: String
confNoTrackedUpstreamIndicator = String
value }
configItemsFolder Config
conf (Item String
"no_tracked_upstream_indicator_color" String
value) =
  Config
conf { confNoTrackedUpstreamIndicatorColor :: Color
confNoTrackedUpstreamIndicatorColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"no_tracked_upstream_indicator_intensity" String
value) =
  Config
conf { confNoTrackedUpstreamIndicatorIntensity :: ColorIntensity
confNoTrackedUpstreamIndicatorIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }

configItemsFolder Config
conf (Item String
"merge_branch_commits_indicator" String
value) =
  Config
conf { confMergeBranchCommitsIndicator :: String
confMergeBranchCommitsIndicator = String
value }
configItemsFolder Config
conf (Item String
"merge_branch_commits_pull_prefix" String
value) =
  Config
conf { confMergeBranchCommitsOnlyPull :: String
confMergeBranchCommitsOnlyPull = String
value }
configItemsFolder Config
conf (Item String
"merge_branch_commits_push_prefix" String
value) =
  Config
conf { confMergeBranchCommitsOnlyPush :: String
confMergeBranchCommitsOnlyPush = String
value }
configItemsFolder Config
conf (Item String
"merge_branch_commits_push_pull_infix" String
value) =
  Config
conf { confMergeBranchCommitsBothPullPush :: String
confMergeBranchCommitsBothPullPush = String
value }
configItemsFolder Config
conf (Item String
"merge_branch_ignore_branches" String
value) =
  Config
conf { confMergeBranchIgnoreBranches :: [String]
confMergeBranchIgnoreBranches = String -> [String]
stringConfigToStringList String
value }

configItemsFolder Config
conf (Item String
"local_branch_prefix" String
value) =
  Config
conf { confLocalBranchNamePrefix :: String
confLocalBranchNamePrefix = String
value }
configItemsFolder Config
conf (Item String
"local_branch_suffix" String
value) =
  Config
conf { confLocalBranchNameSuffix :: String
confLocalBranchNameSuffix = String
value }
configItemsFolder Config
conf (Item String
"local_branch_color" String
value) =
  Config
conf { confLocalBranchColor :: Color
confLocalBranchColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"local_branch_intensity" String
value) =
  Config
conf { confLocalBranchIntensity :: ColorIntensity
confLocalBranchIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"local_detached_prefix" String
value) =
  Config
conf { confLocalDetachedPrefix :: String
confLocalDetachedPrefix = String
value }
configItemsFolder Config
conf (Item String
"local_detached_color" String
value) =
  Config
conf { confLocalDetachedColor :: Color
confLocalDetachedColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"local_detached_intensity" String
value) =
  Config
conf { confLocalDetachedIntensity :: ColorIntensity
confLocalDetachedIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }

configItemsFolder Config
conf (Item String
"local_commits_push_suffix" String
value) =
  Config
conf { confLocalCommitsPushSuffix :: String
confLocalCommitsPushSuffix = String
value }
configItemsFolder Config
conf (Item String
"local_commits_push_suffix_color" String
value) =
  Config
conf { confLocalCommitsPushSuffixColor :: Color
confLocalCommitsPushSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"local_commits_push_suffix_intensity" String
value) =
  Config
conf { confLocalCommitsPushSuffixIntensity :: ColorIntensity
confLocalCommitsPushSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"local_commits_pull_suffix" String
value) =
  Config
conf { confLocalCommitsPullSuffix :: String
confLocalCommitsPullSuffix = String
value }
configItemsFolder Config
conf (Item String
"local_commits_pull_suffix_color" String
value) =
  Config
conf { confLocalCommitsPullSuffixColor :: Color
confLocalCommitsPullSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"local_commits_pull_suffix_intensity" String
value) =
  Config
conf { confLocalCommitsPullSuffixIntensity :: ColorIntensity
confLocalCommitsPullSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"local_commits_push_pull_infix" String
value) =
  Config
conf { confLocalCommitsPushPullInfix :: String
confLocalCommitsPushPullInfix = String
value }
configItemsFolder Config
conf (Item String
"local_commits_push_pull_infix_color" String
value) =
  Config
conf { confLocalCommitsPushPullInfixColor :: Color
confLocalCommitsPushPullInfixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"local_commits_push_pull_infix_intensity" String
value) =
  Config
conf { confLocalCommitsPushPullInfixIntensity :: ColorIntensity
confLocalCommitsPushPullInfixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }

configItemsFolder Config
conf (Item String
"change_index_add_suffix" String
value) =
  Config
conf { confChangeIndexAddSuffix :: String
confChangeIndexAddSuffix = String
value }
configItemsFolder Config
conf (Item String
"change_index_add_suffix_color" String
value) =
  Config
conf { confChangeIndexAddSuffixColor :: Color
confChangeIndexAddSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"change_index_add_suffix_intensity" String
value) =
  Config
conf { confChangeIndexAddSuffixIntensity :: ColorIntensity
confChangeIndexAddSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"change_index_mod_suffix" String
value) =
  Config
conf { confChangeIndexModSuffix :: String
confChangeIndexModSuffix = String
value }
configItemsFolder Config
conf (Item String
"change_index_mod_suffix_color" String
value) =
  Config
conf { confChangeIndexModSuffixColor :: Color
confChangeIndexModSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"change_index_mod_suffix_intensity" String
value) =
  Config
conf { confChangeIndexModSuffixIntensity :: ColorIntensity
confChangeIndexModSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"change_index_del_suffix" String
value) =
  Config
conf { confChangeIndexDelSuffix :: String
confChangeIndexDelSuffix = String
value }
configItemsFolder Config
conf (Item String
"change_index_del_suffix_color" String
value) =
  Config
conf { confChangeIndexDelSuffixColor :: Color
confChangeIndexDelSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"change_index_del_suffix_intensity" String
value) =
  Config
conf { confChangeIndexDelSuffixIntensity :: ColorIntensity
confChangeIndexDelSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"change_local_add_suffix" String
value) =
  Config
conf { confChangeLocalAddSuffix :: String
confChangeLocalAddSuffix = String
value }
configItemsFolder Config
conf (Item String
"change_local_add_suffix_color" String
value) =
  Config
conf { confChangeLocalAddSuffixColor :: Color
confChangeLocalAddSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"change_local_add_suffix_intensity" String
value) =
  Config
conf { confChangeLocalAddSuffixIntensity :: ColorIntensity
confChangeLocalAddSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"change_local_mod_suffix" String
value) =
  Config
conf { confChangeLocalModSuffix :: String
confChangeLocalModSuffix = String
value }
configItemsFolder Config
conf (Item String
"change_local_mod_suffix_color" String
value) =
  Config
conf { confChangeLocalModSuffixColor :: Color
confChangeLocalModSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"change_local_mod_suffix_intensity" String
value) =
  Config
conf { confChangeLocalModSuffixIntensity :: ColorIntensity
confChangeLocalModSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"change_local_del_suffix" String
value) =
  Config
conf { confChangeLocalDelSuffix :: String
confChangeLocalDelSuffix = String
value }
configItemsFolder Config
conf (Item String
"change_local_del_suffix_color" String
value) =
  Config
conf { confChangeLocalDelSuffixColor :: Color
confChangeLocalDelSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"change_local_del_suffix_intensity" String
value) =
  Config
conf { confChangeLocalDelSuffixIntensity :: ColorIntensity
confChangeLocalDelSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"change_renamed_suffix" String
value) =
  Config
conf { confChangeRenamedSuffix :: String
confChangeRenamedSuffix = String
value }
configItemsFolder Config
conf (Item String
"change_renamed_suffix_color" String
value) =
  Config
conf { confChangeRenamedSuffixColor :: Color
confChangeRenamedSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"change_renamed_suffix_intensity" String
value) =
  Config
conf { confChangeRenamedSuffixIntensity :: ColorIntensity
confChangeRenamedSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }
configItemsFolder Config
conf (Item String
"change_conflicted_suffix" String
value) =
  Config
conf { confChangeConflictedSuffix :: String
confChangeConflictedSuffix = String
value }
configItemsFolder Config
conf (Item String
"change_conflicted_suffix_color" String
value) =
  Config
conf { confChangeConflictedSuffixColor :: Color
confChangeConflictedSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"change_conflicted_suffix_intensity" String
value) =
  Config
conf { confChangeConflictedSuffixIntensity :: ColorIntensity
confChangeConflictedSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }

configItemsFolder Config
conf (Item String
"stash_suffix" String
value) =
  Config
conf { confStashSuffix :: String
confStashSuffix = String
value }
configItemsFolder Config
conf (Item String
"stash_suffix_color" String
value) =
  Config
conf { confStashSuffixColor :: Color
confStashSuffixColor = String -> Color
colorConfigToColor String
value }
configItemsFolder Config
conf (Item String
"stash_suffix_intensity" String
value) =
  Config
conf { confStashSuffixIntensity :: ColorIntensity
confStashSuffixIntensity = String -> ColorIntensity
intensityConfigToIntensity String
value }

configItemsFolder Config
conf (Item String
"run_fetcher_daemon" String
value) =
  Config
conf { confRunFetcherDaemon :: Bool
confRunFetcherDaemon = String -> Bool
boolConfigToBool String
value }
configItemsFolder Config
conf (Item String
"githudd_sleep_seconds" String
value) =
  Config
conf { confGithuddSleepSeconds :: Int
confGithuddSleepSeconds = String -> Int
intConfigToInt String
value }
configItemsFolder Config
conf (Item String
"githudd_pid_file_path" String
value) =
  Config
conf { confGithuddPidFilePath :: String
confGithuddPidFilePath = String
value }
configItemsFolder Config
conf (Item String
"githudd_lock_file_path" String
value) =
  Config
conf { confGithuddLockFilePath :: String
confGithuddLockFilePath = String
value }
configItemsFolder Config
conf (Item String
"githudd_socket_file_path" String
value) =
  Config
conf { confGithuddSocketFilePath :: String
confGithuddSocketFilePath = String
value }
configItemsFolder Config
conf (Item String
"githudd_log_file_path" String
value) =
  Config
conf { confGithuddLogFilePath :: Redirection
confGithuddLogFilePath = String -> Redirection
strConfigToRedirection String
value }

configItemsFolder Config
conf ConfigItem
_ = Config
conf

colorConfigToColor :: String -> Color
colorConfigToColor :: String -> Color
colorConfigToColor String
str =
  (ParseError -> Color)
-> (Color -> Color) -> Either ParseError Color -> Color
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Color -> ParseError -> Color
forall a b. a -> b -> a
const Color
NoColor)
    Color -> Color
forall a. a -> a
id
    (Parsec String () Color
-> String -> String -> Either ParseError Color
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () Color
colorParser String
"" String
str)

colorParser :: Parser Color
colorParser :: Parsec String () Color
colorParser = [Parsec String () Color] -> Parsec String () Color
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
    String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Black"   ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
Black
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Red"     ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
Red
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Green"   ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
Green
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Yellow"  ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
Yellow
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Blue"    ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
Blue
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Magenta" ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
Magenta
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Cyan"    ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
Cyan
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"White"   ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
White
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"NoColor" ParsecT String () Identity String
-> Parsec String () Color -> Parsec String () Color
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Color -> Parsec String () Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
NoColor
  ] Parsec String () Color -> String -> Parsec String () Color
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"color"

intensityConfigToIntensity :: String -> ColorIntensity
intensityConfigToIntensity :: String -> ColorIntensity
intensityConfigToIntensity String
str =
  (ParseError -> ColorIntensity)
-> (ColorIntensity -> ColorIntensity)
-> Either ParseError ColorIntensity
-> ColorIntensity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (ColorIntensity -> ParseError -> ColorIntensity
forall a b. a -> b -> a
const ColorIntensity
Vivid)
    ColorIntensity -> ColorIntensity
forall a. a -> a
id
    (Parsec String () ColorIntensity
-> String -> String -> Either ParseError ColorIntensity
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () ColorIntensity
intensityParser String
"" String
str)

intensityParser :: Parser ColorIntensity
intensityParser :: Parsec String () ColorIntensity
intensityParser = [Parsec String () ColorIntensity]
-> Parsec String () ColorIntensity
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
    String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Dull" ParsecT String () Identity String
-> Parsec String () ColorIntensity
-> Parsec String () ColorIntensity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ColorIntensity -> Parsec String () ColorIntensity
forall (m :: * -> *) a. Monad m => a -> m a
return ColorIntensity
Dull
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Vivid" ParsecT String () Identity String
-> Parsec String () ColorIntensity
-> Parsec String () ColorIntensity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ColorIntensity -> Parsec String () ColorIntensity
forall (m :: * -> *) a. Monad m => a -> m a
return ColorIntensity
Vivid
  ] Parsec String () ColorIntensity
-> String -> Parsec String () ColorIntensity
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"intensity"

boolConfigToIntensity :: String -> Bool
boolConfigToIntensity :: String -> Bool
boolConfigToIntensity String
str =
  (ParseError -> Bool)
-> (Bool -> Bool) -> Either ParseError Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Bool -> ParseError -> Bool
forall a b. a -> b -> a
const Bool
True)
    Bool -> Bool
forall a. a -> a
id
    (Parsec String () Bool -> String -> String -> Either ParseError Bool
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () Bool
boolParser String
"" String
str)

stringConfigToStringList :: String -> [String]
stringConfigToStringList :: String -> [String]
stringConfigToStringList String
str =
  (ParseError -> [String])
-> ([String] -> [String]) -> Either ParseError [String] -> [String]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ([String] -> ParseError -> [String]
forall a b. a -> b -> a
const [])
    [String] -> [String]
forall a. a -> a
id
    (Parsec String () [String]
-> String -> String -> Either ParseError [String]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [String]
stringListParser String
"" String
str)

stringListParser :: Parser [String]
stringListParser :: Parsec String () [String]
stringListParser = do
  [String]
branchNameList <- ParsecT String () Identity String
-> ParsecT String () Identity Char -> Parsec String () [String]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepBy ParsecT String () Identity String
stripedBranchName (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
  [String] -> Parsec String () [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Parsec String () [String])
-> [String] -> Parsec String () [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
noEmptyStringFilter [String]
branchNameList

noEmptyStringFilter :: String -> Bool
noEmptyStringFilter :: String -> Bool
noEmptyStringFilter = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=) String
""

stripedBranchName :: Parser String
stripedBranchName :: ParsecT String () Identity String
stripedBranchName = do
  Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String
branchName <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
',', Char
' '])
  Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
branchName

intParser :: Parser Int
intParser :: Parser Int
intParser = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ParsecT String () Identity String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

intConfigToInt :: String -> Int
intConfigToInt :: String -> Int
intConfigToInt String
str =
  (ParseError -> Int) -> (Int -> Int) -> Either ParseError Int -> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Int -> ParseError -> Int
forall a b. a -> b -> a
const Int
30)
    Int -> Int
forall a. a -> a
id
    (Parser Int -> String -> String -> Either ParseError Int
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser Int
intParser String
"" String
str)

boolParser :: Parser Bool
boolParser :: Parsec String () Bool
boolParser = [Parsec String () Bool] -> Parsec String () Bool
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
    String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"False" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"F" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"false" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"f" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"No" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"N" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"no" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"n" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"True" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"T" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"true" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"t" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Yes" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Y" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"yes" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  , String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"y" ParsecT String () Identity String
-> Parsec String () Bool -> Parsec String () Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parsec String () Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  ] Parsec String () Bool -> String -> Parsec String () Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bool"

boolConfigToBool :: String -> Bool
boolConfigToBool :: String -> Bool
boolConfigToBool String
str =
  (ParseError -> Bool)
-> (Bool -> Bool) -> Either ParseError Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Bool -> ParseError -> Bool
forall a b. a -> b -> a
const Bool
False)
    Bool -> Bool
forall a. a -> a
id
    (Parsec String () Bool -> String -> String -> Either ParseError Bool
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () Bool
boolParser String
"" String
str)

strConfigToRedirection :: String -> Redirection
strConfigToRedirection :: String -> Redirection
strConfigToRedirection String
str =
  (ParseError -> Redirection)
-> (Redirection -> Redirection)
-> Either ParseError Redirection
-> Redirection
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Redirection -> ParseError -> Redirection
forall a b. a -> b -> a
const Redirection
DevNull)
    Redirection -> Redirection
forall a. a -> a
id
    (Parsec String () Redirection
-> String -> String -> Either ParseError Redirection
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () Redirection
redirectionParser String
"" String
str)

redirectionParser :: Parser Redirection
redirectionParser :: Parsec String () Redirection
redirectionParser =
  [Parsec String () Redirection] -> Parsec String () Redirection
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
    ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/dev/null") ParsecT String () Identity String
-> Parsec String () Redirection -> Parsec String () Redirection
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Redirection -> Parsec String () Redirection
forall (m :: * -> *) a. Monad m => a -> m a
return Redirection
DevNull
  , String -> Redirection
ToFile (String -> Redirection)
-> ParsecT String () Identity String
-> Parsec String () Redirection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
  ] Parsec String () Redirection
-> String -> Parsec String () Redirection
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Redirection"