{-# LANGUAGE ImportQualifiedPost #-}

{- |
Module    : Data.Ini
Copyright : 2011-2014 Magnus Therning
License   : BSD3

A representation of configuration options.  It consists of /sections/,
each which can contain 0 or more /options/.  Each options is a /key/,
/value/ pair.

This module contains the API for constructing, manipulating, and querying
configurations.
-}
module Data.Ini where

-- {{{1 imports
import Data.Map qualified as M
import Data.Maybe (isJust)

import Data.Ini.Types (Config, OptionName, OptionValue, Section, SectionName)

-- {{{1 configurations

-- | Constructs an empty configuration.
emptyConfig :: Config
emptyConfig :: Config
emptyConfig = forall k a. Map k a
M.empty

-- {{{1 sections

-- | Returns @True@ iff the configuration has a section with that name.
hasSection :: SectionName -> Config -> Bool
hasSection :: SectionName -> Config -> Bool
hasSection = forall k a. Ord k => k -> Map k a -> Bool
M.member

-- | Returns the section with the given name if it exists in the configuration.
getSection :: SectionName -> Config -> Maybe Section
getSection :: SectionName -> Config -> Maybe Section
getSection = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup

-- | Returns a list of the names of all section.
sections :: Config -> [SectionName]
sections :: Config -> [SectionName]
sections = forall k a. Map k a -> [k]
M.keys

-- | Removes the section if it exists.
delSection :: SectionName -> Config -> Config
delSection :: SectionName -> Config -> Config
delSection = forall k a. Ord k => k -> Map k a -> Map k a
M.delete

-- {{{1 options

-- | Returns @True@ if the names section has the option.
hasOption :: SectionName -> OptionName -> Config -> Bool
hasOption :: SectionName -> SectionName -> Config -> Bool
hasOption SectionName
sn SectionName
on Config
cfg = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ SectionName -> Config -> Maybe Section
getSection SectionName
sn Config
cfg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SectionName
on

-- | Returns the value of the option, if it exists.
getOption :: SectionName -> OptionName -> Config -> Maybe OptionValue
getOption :: SectionName -> SectionName -> Config -> Maybe SectionName
getOption SectionName
sn SectionName
on Config
cfg = SectionName -> Config -> Maybe Section
getSection SectionName
sn Config
cfg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SectionName
on

-- | Returns a list of all options in the section.
options :: SectionName -> Config -> [OptionName]
options :: SectionName -> Config -> [SectionName]
options SectionName
sn Config
cfg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall k a. Map k a -> [k]
M.keys (SectionName -> Config -> Maybe Section
getSection SectionName
sn Config
cfg)

-- | Sets the value of the option, adding it if it doesn't exist.
setOption :: SectionName -> OptionName -> OptionValue -> Config -> Config
setOption :: SectionName -> SectionName -> SectionName -> Config -> Config
setOption SectionName
sn SectionName
on SectionName
ov Config
cfg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SectionName
sn Section
new_s Config
cfg) (\Section
sec -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SectionName
sn (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SectionName
on SectionName
ov Section
sec) Config
cfg) Maybe Section
s
  where
    s :: Maybe Section
s = SectionName -> Config -> Maybe Section
getSection SectionName
sn Config
cfg
    new_s :: Section
new_s = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SectionName
on SectionName
ov forall k a. Map k a
M.empty

-- | Removes the option if it exists.  Empty sections are pruned.
delOption :: SectionName -> OptionName -> Config -> Config
delOption :: SectionName -> SectionName -> Config -> Config
delOption SectionName
sn SectionName
on Config
cfg =
    if Bool
sEmptyAfterDelete
        then forall k a. Ord k => k -> Map k a -> Map k a
M.delete SectionName
sn Config
cfg
        else forall b a. b -> (a -> b) -> Maybe a -> b
maybe Config
cfg (\Section
sec -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SectionName
sn (forall k a. Ord k => k -> Map k a -> Map k a
M.delete SectionName
on Section
sec) Config
cfg) Maybe Section
s
  where
    s :: Maybe Section
s = SectionName -> Config -> Maybe Section
getSection SectionName
sn Config
cfg
    sEmptyAfterDelete :: Bool
sEmptyAfterDelete = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\Section
sec -> forall k a. Map k a
M.empty forall a. Eq a => a -> a -> Bool
== forall k a. Ord k => k -> Map k a -> Map k a
M.delete SectionName
on Section
sec) Maybe Section
s

-- | Returns all options and their values of a section.
allItems :: SectionName -> Config -> [(OptionName, OptionValue)]
allItems :: SectionName -> Config -> [(SectionName, SectionName)]
allItems SectionName
sn Config
cfg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall k a. Map k a -> [(k, a)]
M.toList (SectionName -> Config -> Maybe Section
getSection SectionName
sn Config
cfg)