{-# LANGUAGE UndecidableInstances, OverlappingInstances #-}
module Data.ConfigFile
(
SectionSpec, OptionSpec, ConfigParser(..),
CPErrorData(..), CPError,
emptyCP,
simpleAccess, interpolatingAccess,
readfile, readhandle, readstring,
Get_C(..),
sections, has_section,
options, has_option,
items,
set, setshow, remove_option,
add_section, remove_section,
merge,
to_string
) where
import Data.ConfigFile.Types
import Data.ConfigFile.Parser
import Data.Either.Utils
import Data.String.Utils
import qualified Data.Map as Map
import Data.List
import System.IO(Handle)
import Data.Char
import Control.Monad.Error
import Text.ParserCombinators.Parsec.Error (errorMessages, Message(..))
import Text.ParserCombinators.Parsec (parse)
emptyCP :: ConfigParser
emptyCP :: ConfigParser
emptyCP = ConfigParser :: CPData
-> (SectionSpec -> SectionSpec)
-> (ConfigParser
-> SectionSpec -> SectionSpec -> Either CPError SectionSpec)
-> Bool
-> (ConfigParser
-> SectionSpec -> SectionSpec -> Either CPError SectionSpec)
-> ConfigParser
ConfigParser { content :: CPData
content = ParseOutput -> CPData
fromAL [(SectionSpec
"DEFAULT", [])],
defaulthandler :: ConfigParser
-> SectionSpec -> SectionSpec -> Either CPError SectionSpec
defaulthandler = ConfigParser
-> SectionSpec -> SectionSpec -> Either CPError SectionSpec
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
defdefaulthandler,
optionxform :: SectionSpec -> SectionSpec
optionxform = (Char -> Char) -> SectionSpec -> SectionSpec
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower,
usedefault :: Bool
usedefault = Bool
True,
accessfunc :: ConfigParser
-> SectionSpec -> SectionSpec -> Either CPError SectionSpec
accessfunc = ConfigParser
-> SectionSpec -> SectionSpec -> Either CPError SectionSpec
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
simpleAccess}
fromAL :: ParseOutput -> CPData
fromAL :: ParseOutput -> CPData
fromAL ParseOutput
origal =
let conv :: CPData -> (String, [(String, String)]) -> CPData
conv :: CPData -> (SectionSpec, [(SectionSpec, SectionSpec)]) -> CPData
conv CPData
fm (SectionSpec, [(SectionSpec, SectionSpec)])
sect = SectionSpec -> Map SectionSpec SectionSpec -> CPData -> CPData
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ((SectionSpec, [(SectionSpec, SectionSpec)]) -> SectionSpec
forall a b. (a, b) -> a
fst (SectionSpec, [(SectionSpec, SectionSpec)])
sect) ([(SectionSpec, SectionSpec)] -> Map SectionSpec SectionSpec
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SectionSpec, SectionSpec)] -> Map SectionSpec SectionSpec)
-> [(SectionSpec, SectionSpec)] -> Map SectionSpec SectionSpec
forall a b. (a -> b) -> a -> b
$ (SectionSpec, [(SectionSpec, SectionSpec)])
-> [(SectionSpec, SectionSpec)]
forall a b. (a, b) -> b
snd (SectionSpec, [(SectionSpec, SectionSpec)])
sect) CPData
fm
in
(CPData -> (SectionSpec, [(SectionSpec, SectionSpec)]) -> CPData)
-> CPData -> ParseOutput -> CPData
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CPData -> (SectionSpec, [(SectionSpec, SectionSpec)]) -> CPData
conv CPData
forall k a. Map k a
Map.empty ParseOutput
origal
simpleAccess :: MonadError CPError m =>
ConfigParser -> SectionSpec -> OptionSpec -> m String
simpleAccess :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
simpleAccess ConfigParser
cp SectionSpec
s SectionSpec
o = ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
defdefaulthandler ConfigParser
cp SectionSpec
s (ConfigParser -> SectionSpec -> SectionSpec
optionxform ConfigParser
cp (SectionSpec -> SectionSpec) -> SectionSpec -> SectionSpec
forall a b. (a -> b) -> a -> b
$ SectionSpec
o)
interpolatingAccess :: MonadError CPError m =>
Int ->
ConfigParser -> SectionSpec -> OptionSpec
-> m String
interpolatingAccess :: forall (m :: * -> *).
MonadError CPError m =>
Int -> ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
interpolatingAccess Int
maxdepth ConfigParser
cp SectionSpec
s SectionSpec
o =
if Int
maxdepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
then SectionSpec -> m SectionSpec
forall {m :: * -> *} {a}.
MonadError CPError m =>
SectionSpec -> m a
interError SectionSpec
"maximum interpolation depth exceeded"
else do SectionSpec
x <- ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
simpleAccess ConfigParser
cp SectionSpec
s SectionSpec
o
case Parsec SectionSpec () SectionSpec
-> SectionSpec -> SectionSpec -> Either ParseError SectionSpec
forall s t a.
Stream s Identity t =>
Parsec s () a -> SectionSpec -> s -> Either ParseError a
parse ((SectionSpec -> Either CPError SectionSpec)
-> Parsec SectionSpec () SectionSpec
interpmain ((SectionSpec -> Either CPError SectionSpec)
-> Parsec SectionSpec () SectionSpec)
-> (SectionSpec -> Either CPError SectionSpec)
-> Parsec SectionSpec () SectionSpec
forall a b. (a -> b) -> a -> b
$ SectionSpec -> Either CPError SectionSpec
lookupfunc) (SectionSpec
s SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
"/" SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
o) SectionSpec
x of
Left ParseError
y -> case [Message] -> Message
forall a. [a] -> a
head (ParseError -> [Message]
errorMessages ParseError
y) of
Message SectionSpec
z -> SectionSpec -> m SectionSpec
forall {m :: * -> *} {a}.
MonadError CPError m =>
SectionSpec -> m a
interError SectionSpec
z
Message
_ -> SectionSpec -> m SectionSpec
forall {m :: * -> *} {a}.
MonadError CPError m =>
SectionSpec -> m a
interError (ParseError -> SectionSpec
forall a. Show a => a -> SectionSpec
show ParseError
y)
Right SectionSpec
y -> SectionSpec -> m SectionSpec
forall (m :: * -> *) a. Monad m => a -> m a
return SectionSpec
y
where
lookupfunc :: SectionSpec -> Either CPError SectionSpec
lookupfunc = Int
-> ConfigParser
-> SectionSpec
-> SectionSpec
-> Either CPError SectionSpec
forall (m :: * -> *).
MonadError CPError m =>
Int -> ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
interpolatingAccess (Int
maxdepth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ConfigParser
cp SectionSpec
s
interError :: SectionSpec -> m a
interError SectionSpec
x = CPError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SectionSpec -> CPErrorData
InterpolationError SectionSpec
x, SectionSpec
"interpolatingAccess")
defdefaulthandler :: MonadError CPError m =>
ConfigParser -> SectionSpec -> OptionSpec -> m String
defdefaulthandler :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
defdefaulthandler ConfigParser
cp SectionSpec
sectn SectionSpec
opt =
let fm :: CPData
fm = ConfigParser -> CPData
content ConfigParser
cp
lookUp :: SectionSpec -> SectionSpec -> m SectionSpec
lookUp SectionSpec
s SectionSpec
o = do Map SectionSpec SectionSpec
sect <- CPError
-> Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec)
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (SectionSpec -> CPErrorData
NoSection SectionSpec
s,
SectionSpec
"get " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec -> SectionSpec -> SectionSpec
formatSO SectionSpec
sectn SectionSpec
opt) (Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec))
-> Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec)
forall a b. (a -> b) -> a -> b
$
SectionSpec -> CPData -> Maybe (Map SectionSpec SectionSpec)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SectionSpec
s CPData
fm
CPError -> Maybe SectionSpec -> m SectionSpec
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (SectionSpec -> CPErrorData
NoOption SectionSpec
o,
SectionSpec
"get " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec -> SectionSpec -> SectionSpec
formatSO SectionSpec
sectn SectionSpec
opt) (Maybe SectionSpec -> m SectionSpec)
-> Maybe SectionSpec -> m SectionSpec
forall a b. (a -> b) -> a -> b
$
SectionSpec -> Map SectionSpec SectionSpec -> Maybe SectionSpec
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SectionSpec
o Map SectionSpec SectionSpec
sect
trydefault :: CPError -> m SectionSpec
trydefault CPError
e = if (ConfigParser -> Bool
usedefault ConfigParser
cp)
then
SectionSpec -> SectionSpec -> m SectionSpec
forall {m :: * -> *}.
MonadError CPError m =>
SectionSpec -> SectionSpec -> m SectionSpec
lookUp SectionSpec
"DEFAULT" SectionSpec
opt
m SectionSpec -> (CPError -> m SectionSpec) -> m SectionSpec
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\CPError
_ -> CPError -> m SectionSpec
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CPError
e)
else CPError -> m SectionSpec
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CPError
e
in
SectionSpec -> SectionSpec -> m SectionSpec
forall {m :: * -> *}.
MonadError CPError m =>
SectionSpec -> SectionSpec -> m SectionSpec
lookUp SectionSpec
sectn SectionSpec
opt m SectionSpec -> (CPError -> m SectionSpec) -> m SectionSpec
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` CPError -> m SectionSpec
forall {m :: * -> *}.
MonadError CPError m =>
CPError -> m SectionSpec
trydefault
merge :: ConfigParser -> ConfigParser -> ConfigParser
merge :: ConfigParser -> ConfigParser -> ConfigParser
merge ConfigParser
src ConfigParser
dest =
let conv :: String -> String
conv :: SectionSpec -> SectionSpec
conv = ConfigParser -> SectionSpec -> SectionSpec
optionxform ConfigParser
dest
convFM :: CPOptions -> CPOptions
convFM :: Map SectionSpec SectionSpec -> Map SectionSpec SectionSpec
convFM = [(SectionSpec, SectionSpec)] -> Map SectionSpec SectionSpec
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SectionSpec, SectionSpec)] -> Map SectionSpec SectionSpec)
-> (Map SectionSpec SectionSpec -> [(SectionSpec, SectionSpec)])
-> Map SectionSpec SectionSpec
-> Map SectionSpec SectionSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SectionSpec, SectionSpec) -> (SectionSpec, SectionSpec))
-> [(SectionSpec, SectionSpec)] -> [(SectionSpec, SectionSpec)]
forall a b. (a -> b) -> [a] -> [b]
map (\(SectionSpec, SectionSpec)
x -> (SectionSpec -> SectionSpec
conv ((SectionSpec, SectionSpec) -> SectionSpec
forall a b. (a, b) -> a
fst (SectionSpec, SectionSpec)
x), (SectionSpec, SectionSpec) -> SectionSpec
forall a b. (a, b) -> b
snd (SectionSpec, SectionSpec)
x)) ([(SectionSpec, SectionSpec)] -> [(SectionSpec, SectionSpec)])
-> (Map SectionSpec SectionSpec -> [(SectionSpec, SectionSpec)])
-> Map SectionSpec SectionSpec
-> [(SectionSpec, SectionSpec)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SectionSpec SectionSpec -> [(SectionSpec, SectionSpec)]
forall k a. Map k a -> [(k, a)]
Map.toList
mergesects :: Map k a -> Map k a -> Map k a
mergesects Map k a
a Map k a
b = Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
a Map k a
b
in
ConfigParser
dest { content :: CPData
content = (Map SectionSpec SectionSpec
-> Map SectionSpec SectionSpec -> Map SectionSpec SectionSpec)
-> CPData -> CPData -> CPData
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map SectionSpec SectionSpec
-> Map SectionSpec SectionSpec -> Map SectionSpec SectionSpec
forall k a. Ord k => Map k a -> Map k a -> Map k a
mergesects
(ConfigParser -> CPData
content ConfigParser
dest) ((Map SectionSpec SectionSpec -> Map SectionSpec SectionSpec)
-> CPData -> CPData
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map SectionSpec SectionSpec -> Map SectionSpec SectionSpec
convFM (ConfigParser -> CPData
content ConfigParser
src)) }
readutil :: ConfigParser -> ParseOutput -> ConfigParser
readutil :: ConfigParser -> ParseOutput -> ConfigParser
readutil ConfigParser
old ParseOutput
new = ConfigParser -> ConfigParser -> ConfigParser
merge ConfigParser
old (ConfigParser -> ConfigParser) -> ConfigParser -> ConfigParser
forall a b. (a -> b) -> a -> b
$ ConfigParser
old { content :: CPData
content = ParseOutput -> CPData
fromAL ParseOutput
new }
readfile :: MonadError CPError m => ConfigParser -> FilePath -> IO (m ConfigParser)
readfile :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> IO (m ConfigParser)
readfile ConfigParser
cp SectionSpec
fp = do m ParseOutput
n <- SectionSpec -> IO (m ParseOutput)
forall (m :: * -> *).
MonadError CPError m =>
SectionSpec -> IO (m ParseOutput)
parse_file SectionSpec
fp
m ConfigParser -> IO (m ConfigParser)
forall (m :: * -> *) a. Monad m => a -> m a
return (m ConfigParser -> IO (m ConfigParser))
-> m ConfigParser -> IO (m ConfigParser)
forall a b. (a -> b) -> a -> b
$ m ParseOutput
n m ParseOutput -> (ParseOutput -> m ConfigParser) -> m ConfigParser
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ConfigParser -> m ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> m ConfigParser)
-> (ParseOutput -> ConfigParser) -> ParseOutput -> m ConfigParser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigParser -> ParseOutput -> ConfigParser
readutil ConfigParser
cp)
readhandle :: MonadError CPError m => ConfigParser -> Handle -> IO (m ConfigParser)
readhandle :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> Handle -> IO (m ConfigParser)
readhandle ConfigParser
cp Handle
h = do m ParseOutput
n <- Handle -> IO (m ParseOutput)
forall (m :: * -> *).
MonadError CPError m =>
Handle -> IO (m ParseOutput)
parse_handle Handle
h
m ConfigParser -> IO (m ConfigParser)
forall (m :: * -> *) a. Monad m => a -> m a
return (m ConfigParser -> IO (m ConfigParser))
-> m ConfigParser -> IO (m ConfigParser)
forall a b. (a -> b) -> a -> b
$ m ParseOutput
n m ParseOutput -> (ParseOutput -> m ConfigParser) -> m ConfigParser
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ConfigParser -> m ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> m ConfigParser)
-> (ParseOutput -> ConfigParser) -> ParseOutput -> m ConfigParser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfigParser -> ParseOutput -> ConfigParser
readutil ConfigParser
cp))
readstring :: MonadError CPError m =>
ConfigParser -> String -> m ConfigParser
readstring :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> m ConfigParser
readstring ConfigParser
cp SectionSpec
s = do
ParseOutput
n <- SectionSpec -> m ParseOutput
forall (m :: * -> *).
MonadError CPError m =>
SectionSpec -> m ParseOutput
parse_string SectionSpec
s
ConfigParser -> m ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> m ConfigParser) -> ConfigParser -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ ConfigParser -> ParseOutput -> ConfigParser
readutil ConfigParser
cp ParseOutput
n
sections :: ConfigParser -> [SectionSpec]
sections :: ConfigParser -> [SectionSpec]
sections = (SectionSpec -> Bool) -> [SectionSpec] -> [SectionSpec]
forall a. (a -> Bool) -> [a] -> [a]
filter (SectionSpec -> SectionSpec -> Bool
forall a. Eq a => a -> a -> Bool
/= SectionSpec
"DEFAULT") ([SectionSpec] -> [SectionSpec])
-> (ConfigParser -> [SectionSpec]) -> ConfigParser -> [SectionSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPData -> [SectionSpec]
forall k a. Map k a -> [k]
Map.keys (CPData -> [SectionSpec])
-> (ConfigParser -> CPData) -> ConfigParser -> [SectionSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigParser -> CPData
content
has_section :: ConfigParser -> SectionSpec -> Bool
has_section :: ConfigParser -> SectionSpec -> Bool
has_section ConfigParser
cp SectionSpec
x = SectionSpec -> CPData -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member SectionSpec
x (ConfigParser -> CPData
content ConfigParser
cp)
add_section :: MonadError CPError m =>
ConfigParser -> SectionSpec -> m ConfigParser
add_section :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> m ConfigParser
add_section ConfigParser
cp SectionSpec
s =
if ConfigParser -> SectionSpec -> Bool
has_section ConfigParser
cp SectionSpec
s
then CPError -> m ConfigParser
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CPError -> m ConfigParser) -> CPError -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ (SectionSpec -> CPErrorData
SectionAlreadyExists SectionSpec
s, SectionSpec
"add_section")
else ConfigParser -> m ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> m ConfigParser) -> ConfigParser -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ ConfigParser
cp {content :: CPData
content = SectionSpec -> Map SectionSpec SectionSpec -> CPData -> CPData
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SectionSpec
s Map SectionSpec SectionSpec
forall k a. Map k a
Map.empty (ConfigParser -> CPData
content ConfigParser
cp)}
remove_section :: MonadError CPError m =>
ConfigParser -> SectionSpec -> m ConfigParser
remove_section :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> m ConfigParser
remove_section ConfigParser
_ SectionSpec
"DEFAULT" = CPError -> m ConfigParser
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CPError -> m ConfigParser) -> CPError -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ (SectionSpec -> CPErrorData
NoSection SectionSpec
"DEFAULT", SectionSpec
"remove_section")
remove_section ConfigParser
cp SectionSpec
s =
if ConfigParser -> SectionSpec -> Bool
has_section ConfigParser
cp SectionSpec
s
then ConfigParser -> m ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> m ConfigParser) -> ConfigParser -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ ConfigParser
cp {content :: CPData
content = SectionSpec -> CPData -> CPData
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete SectionSpec
s (ConfigParser -> CPData
content ConfigParser
cp)}
else CPError -> m ConfigParser
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CPError -> m ConfigParser) -> CPError -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ (SectionSpec -> CPErrorData
NoSection SectionSpec
s, SectionSpec
"remove_section")
remove_option :: MonadError CPError m =>
ConfigParser -> SectionSpec -> OptionSpec -> m ConfigParser
remove_option :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m ConfigParser
remove_option ConfigParser
cp SectionSpec
s SectionSpec
passedo =
do Map SectionSpec SectionSpec
sectmap <- CPError
-> Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec)
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (SectionSpec -> CPErrorData
NoSection SectionSpec
s,
SectionSpec
"remove_option " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec -> SectionSpec -> SectionSpec
formatSO SectionSpec
s SectionSpec
passedo) (Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec))
-> Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec)
forall a b. (a -> b) -> a -> b
$
SectionSpec -> CPData -> Maybe (Map SectionSpec SectionSpec)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SectionSpec
s (ConfigParser -> CPData
content ConfigParser
cp)
let o :: SectionSpec
o = (ConfigParser -> SectionSpec -> SectionSpec
optionxform ConfigParser
cp) SectionSpec
passedo
let newsect :: Map SectionSpec SectionSpec
newsect = SectionSpec
-> Map SectionSpec SectionSpec -> Map SectionSpec SectionSpec
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete SectionSpec
o Map SectionSpec SectionSpec
sectmap
let newmap :: CPData
newmap = SectionSpec -> Map SectionSpec SectionSpec -> CPData -> CPData
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SectionSpec
s Map SectionSpec SectionSpec
newsect (ConfigParser -> CPData
content ConfigParser
cp)
if SectionSpec -> Map SectionSpec SectionSpec -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member SectionSpec
o Map SectionSpec SectionSpec
sectmap
then ConfigParser -> m ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> m ConfigParser) -> ConfigParser -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ ConfigParser
cp {content :: CPData
content = CPData
newmap}
else CPError -> m ConfigParser
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CPError -> m ConfigParser) -> CPError -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ (SectionSpec -> CPErrorData
NoOption SectionSpec
o,
SectionSpec
"remove_option " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec -> SectionSpec -> SectionSpec
formatSO SectionSpec
s SectionSpec
passedo)
options :: MonadError CPError m =>
ConfigParser -> SectionSpec -> m [OptionSpec]
options :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> m [SectionSpec]
options ConfigParser
cp SectionSpec
x = CPError -> Maybe [SectionSpec] -> m [SectionSpec]
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (SectionSpec -> CPErrorData
NoSection SectionSpec
x, SectionSpec
"options") (Maybe [SectionSpec] -> m [SectionSpec])
-> Maybe [SectionSpec] -> m [SectionSpec]
forall a b. (a -> b) -> a -> b
$
do
Map SectionSpec SectionSpec
o <- SectionSpec -> CPData -> Maybe (Map SectionSpec SectionSpec)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SectionSpec
x (ConfigParser -> CPData
content ConfigParser
cp)
[SectionSpec] -> Maybe [SectionSpec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SectionSpec] -> Maybe [SectionSpec])
-> [SectionSpec] -> Maybe [SectionSpec]
forall a b. (a -> b) -> a -> b
$ Map SectionSpec SectionSpec -> [SectionSpec]
forall k a. Map k a -> [k]
Map.keys Map SectionSpec SectionSpec
o
has_option :: ConfigParser -> SectionSpec -> OptionSpec -> Bool
has_option :: ConfigParser -> SectionSpec -> SectionSpec -> Bool
has_option ConfigParser
cp SectionSpec
s SectionSpec
o =
let c :: CPData
c = ConfigParser -> CPData
content ConfigParser
cp
v :: Maybe Bool
v = do Map SectionSpec SectionSpec
secthash <- SectionSpec -> CPData -> Maybe (Map SectionSpec SectionSpec)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SectionSpec
s CPData
c
Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ SectionSpec -> Map SectionSpec SectionSpec -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (ConfigParser -> SectionSpec -> SectionSpec
optionxform ConfigParser
cp (SectionSpec -> SectionSpec) -> SectionSpec -> SectionSpec
forall a b. (a -> b) -> a -> b
$ SectionSpec
o) Map SectionSpec SectionSpec
secthash
in Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
forall a. a -> a
id Maybe Bool
v
class Get_C a where
get :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m a
instance Get_C String where
get :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
get ConfigParser
cp SectionSpec
s SectionSpec
o = Either CPError SectionSpec -> m SectionSpec
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
eitherToMonadError (Either CPError SectionSpec -> m SectionSpec)
-> Either CPError SectionSpec -> m SectionSpec
forall a b. (a -> b) -> a -> b
$ (ConfigParser
-> ConfigParser
-> SectionSpec
-> SectionSpec
-> Either CPError SectionSpec
accessfunc ConfigParser
cp) ConfigParser
cp SectionSpec
s SectionSpec
o
instance Get_C Bool where
get :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m Bool
get = ConfigParser -> SectionSpec -> SectionSpec -> m Bool
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m Bool
getbool
instance Read t => Get_C t where
get :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m t
get = ConfigParser -> SectionSpec -> SectionSpec -> m t
forall b (m :: * -> *).
(Read b, MonadError CPError m) =>
ConfigParser -> SectionSpec -> SectionSpec -> m b
genericget
readMaybe :: Read a => String -> Maybe a
readMaybe :: forall a. Read a => SectionSpec -> Maybe a
readMaybe SectionSpec
s = case [a
x | (a
x, SectionSpec
t) <- ReadS a
forall a. Read a => ReadS a
reads SectionSpec
s, (SectionSpec
"",SectionSpec
"") <- ReadS SectionSpec
lex SectionSpec
t] of
[a
x] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
[a]
_ -> Maybe a
forall a. Maybe a
Nothing
genericget :: (Read b, MonadError CPError m) => ConfigParser -> SectionSpec -> OptionSpec -> m b
genericget :: forall b (m :: * -> *).
(Read b, MonadError CPError m) =>
ConfigParser -> SectionSpec -> SectionSpec -> m b
genericget ConfigParser
cp SectionSpec
s SectionSpec
o = do
SectionSpec
val <- ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> SectionSpec -> SectionSpec -> m a
get ConfigParser
cp SectionSpec
s SectionSpec
o
let errMsg :: SectionSpec
errMsg = SectionSpec
"couldn't parse value " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
val SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
" from " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec -> SectionSpec -> SectionSpec
formatSO SectionSpec
s SectionSpec
o
m b -> (b -> m b) -> Maybe b -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CPError -> m b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SectionSpec -> CPErrorData
ParseError SectionSpec
errMsg, SectionSpec
"genericget"))
b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return
(Maybe b -> m b) -> Maybe b -> m b
forall a b. (a -> b) -> a -> b
$ SectionSpec -> Maybe b
forall a. Read a => SectionSpec -> Maybe a
readMaybe SectionSpec
val
getbool :: MonadError CPError m =>
ConfigParser -> SectionSpec -> OptionSpec -> m Bool
getbool :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> SectionSpec -> m Bool
getbool ConfigParser
cp SectionSpec
s SectionSpec
o =
do SectionSpec
val <- ConfigParser -> SectionSpec -> SectionSpec -> m SectionSpec
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> SectionSpec -> SectionSpec -> m a
get ConfigParser
cp SectionSpec
s SectionSpec
o
case (Char -> Char) -> SectionSpec -> SectionSpec
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (SectionSpec -> SectionSpec)
-> (SectionSpec -> SectionSpec) -> SectionSpec -> SectionSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionSpec -> SectionSpec
strip (SectionSpec -> SectionSpec) -> SectionSpec -> SectionSpec
forall a b. (a -> b) -> a -> b
$ SectionSpec
val of
SectionSpec
"1" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
SectionSpec
"yes" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
SectionSpec
"on" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
SectionSpec
"enabled" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
SectionSpec
"true" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
SectionSpec
"0" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
SectionSpec
"no" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
SectionSpec
"off" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
SectionSpec
"disabled" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
SectionSpec
"false" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
SectionSpec
_ -> CPError -> m Bool
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SectionSpec -> CPErrorData
ParseError (SectionSpec -> CPErrorData) -> SectionSpec -> CPErrorData
forall a b. (a -> b) -> a -> b
$ SectionSpec
"couldn't parse bool " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++
SectionSpec
val SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
" from " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec -> SectionSpec -> SectionSpec
formatSO SectionSpec
s SectionSpec
o, SectionSpec
"getbool")
formatSO :: [Char] -> [Char] -> [Char]
formatSO :: SectionSpec -> SectionSpec -> SectionSpec
formatSO SectionSpec
s SectionSpec
o =
SectionSpec
"(" SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
s SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
"/" SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
o SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
")"
items :: MonadError CPError m =>
ConfigParser -> SectionSpec -> m [(OptionSpec, String)]
items :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> SectionSpec -> m [(SectionSpec, SectionSpec)]
items ConfigParser
cp SectionSpec
s = do Map SectionSpec SectionSpec
fm <- CPError
-> Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec)
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (SectionSpec -> CPErrorData
NoSection SectionSpec
s, SectionSpec
"items") (Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec))
-> Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec)
forall a b. (a -> b) -> a -> b
$
SectionSpec -> CPData -> Maybe (Map SectionSpec SectionSpec)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SectionSpec
s (ConfigParser -> CPData
content ConfigParser
cp)
[(SectionSpec, SectionSpec)] -> m [(SectionSpec, SectionSpec)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SectionSpec, SectionSpec)] -> m [(SectionSpec, SectionSpec)])
-> [(SectionSpec, SectionSpec)] -> m [(SectionSpec, SectionSpec)]
forall a b. (a -> b) -> a -> b
$ Map SectionSpec SectionSpec -> [(SectionSpec, SectionSpec)]
forall k a. Map k a -> [(k, a)]
Map.toList Map SectionSpec SectionSpec
fm
set :: MonadError CPError m =>
ConfigParser -> SectionSpec -> OptionSpec -> String -> m ConfigParser
set :: forall (m :: * -> *).
MonadError CPError m =>
ConfigParser
-> SectionSpec -> SectionSpec -> SectionSpec -> m ConfigParser
set ConfigParser
cp SectionSpec
s SectionSpec
passedo SectionSpec
val =
do Map SectionSpec SectionSpec
sectmap <- CPError
-> Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec)
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (SectionSpec -> CPErrorData
NoSection SectionSpec
s, SectionSpec
"set " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec -> SectionSpec -> SectionSpec
formatSO SectionSpec
s SectionSpec
passedo) (Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec))
-> Maybe (Map SectionSpec SectionSpec)
-> m (Map SectionSpec SectionSpec)
forall a b. (a -> b) -> a -> b
$
SectionSpec -> CPData -> Maybe (Map SectionSpec SectionSpec)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SectionSpec
s (ConfigParser -> CPData
content ConfigParser
cp)
let o :: SectionSpec
o = (ConfigParser -> SectionSpec -> SectionSpec
optionxform ConfigParser
cp) SectionSpec
passedo
let newsect :: Map SectionSpec SectionSpec
newsect = SectionSpec
-> SectionSpec
-> Map SectionSpec SectionSpec
-> Map SectionSpec SectionSpec
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SectionSpec
o SectionSpec
val Map SectionSpec SectionSpec
sectmap
let newmap :: CPData
newmap = SectionSpec -> Map SectionSpec SectionSpec -> CPData -> CPData
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SectionSpec
s Map SectionSpec SectionSpec
newsect (ConfigParser -> CPData
content ConfigParser
cp)
ConfigParser -> m ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> m ConfigParser) -> ConfigParser -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ ConfigParser
cp { content :: CPData
content = CPData
newmap}
setshow :: (Show a, MonadError CPError m) =>
ConfigParser -> SectionSpec -> OptionSpec -> a -> m ConfigParser
setshow :: forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
ConfigParser -> SectionSpec -> SectionSpec -> a -> m ConfigParser
setshow ConfigParser
cp SectionSpec
s SectionSpec
o a
val = ConfigParser
-> SectionSpec -> SectionSpec -> SectionSpec -> m ConfigParser
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser
-> SectionSpec -> SectionSpec -> SectionSpec -> m ConfigParser
set ConfigParser
cp SectionSpec
s SectionSpec
o (a -> SectionSpec
forall a. Show a => a -> SectionSpec
show a
val)
to_string :: ConfigParser -> String
to_string :: ConfigParser -> SectionSpec
to_string ConfigParser
cp =
let gen_option :: (SectionSpec, SectionSpec) -> SectionSpec
gen_option (SectionSpec
key, SectionSpec
value) =
SectionSpec
key SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
": " SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ (SectionSpec -> SectionSpec -> SectionSpec -> SectionSpec
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace SectionSpec
"\n" SectionSpec
"\n " SectionSpec
value) SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
"\n"
gen_section :: (SectionSpec, Map SectionSpec SectionSpec) -> SectionSpec
gen_section (SectionSpec
sect, Map SectionSpec SectionSpec
valfm) =
if (SectionSpec
sect SectionSpec -> SectionSpec -> Bool
forall a. Eq a => a -> a -> Bool
/= SectionSpec
"DEFAULT") Bool -> Bool -> Bool
|| (Map SectionSpec SectionSpec -> Int
forall k a. Map k a -> Int
Map.size Map SectionSpec SectionSpec
valfm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
then SectionSpec
"[" SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
sect SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
"]\n" SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++
([SectionSpec] -> SectionSpec
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([SectionSpec] -> SectionSpec) -> [SectionSpec] -> SectionSpec
forall a b. (a -> b) -> a -> b
$ ((SectionSpec, SectionSpec) -> SectionSpec)
-> [(SectionSpec, SectionSpec)] -> [SectionSpec]
forall a b. (a -> b) -> [a] -> [b]
map (SectionSpec, SectionSpec) -> SectionSpec
gen_option (Map SectionSpec SectionSpec -> [(SectionSpec, SectionSpec)]
forall k a. Map k a -> [(k, a)]
Map.toList Map SectionSpec SectionSpec
valfm)) SectionSpec -> SectionSpec -> SectionSpec
forall a. [a] -> [a] -> [a]
++ SectionSpec
"\n"
else SectionSpec
""
in
[SectionSpec] -> SectionSpec
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([SectionSpec] -> SectionSpec) -> [SectionSpec] -> SectionSpec
forall a b. (a -> b) -> a -> b
$ ((SectionSpec, Map SectionSpec SectionSpec) -> SectionSpec)
-> [(SectionSpec, Map SectionSpec SectionSpec)] -> [SectionSpec]
forall a b. (a -> b) -> [a] -> [b]
map (SectionSpec, Map SectionSpec SectionSpec) -> SectionSpec
gen_section (CPData -> [(SectionSpec, Map SectionSpec SectionSpec)]
forall k a. Map k a -> [(k, a)]
Map.toList (ConfigParser -> CPData
content ConfigParser
cp))