{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

-- | Clean configuration files in the INI format.
--
-- Format rules and recommendations:
--
--  * The @: @ syntax is space-sensitive.
--
--  * Keys are case-sensitive.
--
--  * Lower-case is recommended.
--
--  * Values can be empty.
--
--  * Keys cannot key separators, section delimiters, or comment markers.
--
--  * Comments must start at the beginning of the line and start with @;@ or @#@.
--
-- An example configuration file:
--
-- @
-- # Some comment.
-- [SERVER]
-- port=6667
-- hostname=localhost
-- ; another comment here
-- [AUTH]
-- user: hello
-- pass: world
-- salt:
-- @
--
-- Parsing example:
--
-- >>> parseIni "[SERVER]\nport: 6667\nhostname: localhost"
-- Right (Ini {unIni = fromList [("SERVER",fromList [("hostname","localhost"),("port","6667")])]})
--

module Data.Ini
  (-- * Reading
   readIniFile
  ,parseIni
  ,lookupValue
  ,lookupArray
  ,readValue
  ,readArray
  ,parseValue
  ,sections
  ,keys
   -- * Writing
  ,printIni
  ,writeIniFile
   -- * Advanced writing
  ,KeySeparator(..)
  ,WriteIniSettings(..)
  ,defaultWriteIniSettings
  ,printIniWith
  ,writeIniFileWith
   -- * Types
  ,Ini(..)
  ,unIni
   -- * Parsers
  ,iniParser
  ,sectionParser
  ,keyValueParser
  )
  where

import           Control.Applicative
import           Control.Monad
import           Data.Attoparsec.Combinator
import           Data.Attoparsec.Text
import           Data.Char
import           Data.HashMap.Strict        (HashMap)
import qualified Data.HashMap.Strict        as M
import Data.Maybe
import           Data.Semigroup
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import qualified Data.Text.IO               as T
import           Prelude                    hiding (takeWhile)

-- | An INI configuration.
data Ini =
  Ini
    { Ini -> HashMap Text [(Text, Text)]
iniSections :: HashMap Text [(Text, Text)]
    , Ini -> [(Text, Text)]
iniGlobals  :: [(Text, Text)]
    }
  deriving (Int -> Ini -> ShowS
[Ini] -> ShowS
Ini -> [Char]
(Int -> Ini -> ShowS)
-> (Ini -> [Char]) -> ([Ini] -> ShowS) -> Show Ini
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ini -> ShowS
showsPrec :: Int -> Ini -> ShowS
$cshow :: Ini -> [Char]
show :: Ini -> [Char]
$cshowList :: [Ini] -> ShowS
showList :: [Ini] -> ShowS
Show, Ini -> Ini -> Bool
(Ini -> Ini -> Bool) -> (Ini -> Ini -> Bool) -> Eq Ini
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ini -> Ini -> Bool
== :: Ini -> Ini -> Bool
$c/= :: Ini -> Ini -> Bool
/= :: Ini -> Ini -> Bool
Eq)

instance Semigroup Ini where
  Ini
x <> :: Ini -> Ini -> Ini
<> Ini
y = Ini {iniGlobals :: [(Text, Text)]
iniGlobals = [(Text, Text)]
forall a. Monoid a => a
mempty, iniSections :: HashMap Text [(Text, Text)]
iniSections = Ini -> HashMap Text [(Text, Text)]
iniSections Ini
x HashMap Text [(Text, Text)]
-> HashMap Text [(Text, Text)] -> HashMap Text [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> Ini -> HashMap Text [(Text, Text)]
iniSections Ini
y}

instance Monoid Ini where
  mempty :: Ini
mempty = Ini {iniGlobals :: [(Text, Text)]
iniGlobals = [(Text, Text)]
forall a. Monoid a => a
mempty, iniSections :: HashMap Text [(Text, Text)]
iniSections = HashMap Text [(Text, Text)]
forall a. Monoid a => a
mempty}
  mappend :: Ini -> Ini -> Ini
mappend = Ini -> Ini -> Ini
forall a. Semigroup a => a -> a -> a
(<>)


{-# DEPRECATED #-}
unIni :: Ini -> HashMap Text (HashMap Text Text)
unIni :: Ini -> HashMap Text (HashMap Text Text)
unIni = ([(Text, Text)] -> HashMap Text Text)
-> HashMap Text [(Text, Text)] -> HashMap Text (HashMap Text Text)
forall a b. (a -> b) -> HashMap Text a -> HashMap Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList (HashMap Text [(Text, Text)] -> HashMap Text (HashMap Text Text))
-> (Ini -> HashMap Text [(Text, Text)])
-> Ini
-> HashMap Text (HashMap Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ini -> HashMap Text [(Text, Text)]
iniSections

-- | Parse an INI file.
readIniFile :: FilePath -> IO (Either String Ini)
readIniFile :: [Char] -> IO (Either [Char] Ini)
readIniFile = (Text -> Either [Char] Ini) -> IO Text -> IO (Either [Char] Ini)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either [Char] Ini
parseIni (IO Text -> IO (Either [Char] Ini))
-> ([Char] -> IO Text) -> [Char] -> IO (Either [Char] Ini)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO Text
T.readFile

-- | Parse an INI config.
parseIni :: Text -> Either String Ini
parseIni :: Text -> Either [Char] Ini
parseIni = Parser Ini -> Text -> Either [Char] Ini
forall a. Parser a -> Text -> Either [Char] a
parseOnly Parser Ini
iniParser

-- | Lookup one value in the config.
--
-- Example:
--
-- >>> parseIni "[SERVER]\nport: 6667\nhostname: localhost" >>= lookupValue "SERVER" "hostname"
-- Right "localhost"
lookupValue :: Text -- ^ Section name
            -> Text -- ^ Key
            -> Ini -> Either String Text
lookupValue :: Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
name Text
key (Ini {iniSections :: Ini -> HashMap Text [(Text, Text)]
iniSections=HashMap Text [(Text, Text)]
secs}) =
  case Text -> HashMap Text [(Text, Text)] -> Maybe [(Text, Text)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
name HashMap Text [(Text, Text)]
secs of
    Maybe [(Text, Text)]
Nothing -> [Char] -> Either [Char] Text
forall a b. a -> Either a b
Left ([Char]
"Couldn't find section: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
name)
    Just [(Text, Text)]
section ->
      case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
key [(Text, Text)]
section of
        Maybe Text
Nothing -> [Char] -> Either [Char] Text
forall a b. a -> Either a b
Left ([Char]
"Couldn't find key: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
key)
        Just Text
value -> Text -> Either [Char] Text
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
value

-- | Lookup one value in the config.
--
-- Example:
--
-- >>> parseIni "[SERVER]\nport: 6667\nhostname: localhost" >>= lookupValue "SERVER" "hostname"
-- Right "localhost"
lookupArray :: Text -- ^ Section name
            -> Text -- ^ Key
            -> Ini -> Either String [Text]
lookupArray :: Text -> Text -> Ini -> Either [Char] [Text]
lookupArray Text
name Text
key (Ini {iniSections :: Ini -> HashMap Text [(Text, Text)]
iniSections = HashMap Text [(Text, Text)]
secs}) =
  case Text -> HashMap Text [(Text, Text)] -> Maybe [(Text, Text)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
name HashMap Text [(Text, Text)]
secs of
    Maybe [(Text, Text)]
Nothing -> [Char] -> Either [Char] [Text]
forall a b. a -> Either a b
Left ([Char]
"Couldn't find section: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
name)
    Just [(Text, Text)]
section ->
      case ((Text, Text) -> Maybe Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
             (\(Text
k, Text
v) ->
                if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key
                  then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v
                  else Maybe Text
forall a. Maybe a
Nothing)
             [(Text, Text)]
section of
        [] -> [Char] -> Either [Char] [Text]
forall a b. a -> Either a b
Left ([Char]
"Couldn't find key: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
key)
        [Text]
values -> [Text] -> Either [Char] [Text]
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
values

-- | Get the sections in the config.
--
-- Example:
--
-- >>> sections <$> parseIni "[SERVER]\nport: 6667\nhostname: localhost"
-- Right ["SERVER"]
sections :: Ini -> [Text]
sections :: Ini -> [Text]
sections = HashMap Text [(Text, Text)] -> [Text]
forall k v. HashMap k v -> [k]
M.keys (HashMap Text [(Text, Text)] -> [Text])
-> (Ini -> HashMap Text [(Text, Text)]) -> Ini -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ini -> HashMap Text [(Text, Text)]
iniSections

-- | Get the keys in a section.
--
-- Example:
--
-- >>> parseIni "[SERVER]\nport: 6667\nhostname: localhost" >>= keys "SERVER"
-- Right ["hostname","port"]
keys :: Text -- ^ Section name
     -> Ini -> Either String [Text]
keys :: Text -> Ini -> Either [Char] [Text]
keys Text
name Ini
i =
  case Text -> HashMap Text [(Text, Text)] -> Maybe [(Text, Text)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
name (Ini -> HashMap Text [(Text, Text)]
iniSections Ini
i) of
    Maybe [(Text, Text)]
Nothing -> [Char] -> Either [Char] [Text]
forall a b. a -> Either a b
Left ([Char]
"Couldn't find section: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
name)
    Just [(Text, Text)]
section -> [Text] -> Either [Char] [Text]
forall a b. b -> Either a b
Right (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst [(Text, Text)]
section)

-- | Read a value using a reader from "Data.Text.Read".
readValue :: Text -- ^ Section name
          -> Text -- ^ Key
          -> (Text -> Either String (a, Text))
          -> Ini
          -> Either String a
readValue :: forall a.
Text
-> Text
-> (Text -> Either [Char] (a, Text))
-> Ini
-> Either [Char] a
readValue Text
section Text
key Text -> Either [Char] (a, Text)
f Ini
ini =
  Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
section Text
key Ini
ini Either [Char] Text
-> (Text -> Either [Char] (a, Text)) -> Either [Char] (a, Text)
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either [Char] (a, Text)
f Either [Char] (a, Text)
-> ((a, Text) -> Either [Char] a) -> Either [Char] a
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either [Char] a
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either [Char] a)
-> ((a, Text) -> a) -> (a, Text) -> Either [Char] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Text) -> a
forall a b. (a, b) -> a
fst

-- | Read an array of values using a reader from "Data.Text.Read".
readArray :: Text -- ^ Section name
          -> Text -- ^ Key
          -> (Text -> Either String (a, Text))
          -> Ini
          -> Either String [a]
readArray :: forall a.
Text
-> Text
-> (Text -> Either [Char] (a, Text))
-> Ini
-> Either [Char] [a]
readArray Text
section Text
key Text -> Either [Char] (a, Text)
f Ini
ini =
  ([(a, Text)] -> [a])
-> Either [Char] [(a, Text)] -> Either [Char] [a]
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, Text) -> a) -> [(a, Text)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Text) -> a
forall a b. (a, b) -> a
fst) (Text -> Text -> Ini -> Either [Char] [Text]
lookupArray Text
section Text
key Ini
ini Either [Char] [Text]
-> ([Text] -> Either [Char] [(a, Text)])
-> Either [Char] [(a, Text)]
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Either [Char] (a, Text))
-> [Text] -> Either [Char] [(a, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Either [Char] (a, Text)
f)

-- | Parse a value using a reader from "Data.Attoparsec.Text".
parseValue :: Text -- ^ Section name
           -> Text -- ^ Key
           -> Parser a
           -> Ini
           -> Either String a
parseValue :: forall a. Text -> Text -> Parser a -> Ini -> Either [Char] a
parseValue Text
section Text
key Parser a
f Ini
ini =
  Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
section Text
key Ini
ini Either [Char] Text -> (Text -> Either [Char] a) -> Either [Char] a
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser a -> Text -> Either [Char] a
forall a. Parser a -> Text -> Either [Char] a
parseOnly (Parser a
f Parser a -> Parser Text () -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
skipSpace Parser Text () -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput))

-- | Print the INI config to a file.
writeIniFile :: FilePath -> Ini -> IO ()
writeIniFile :: [Char] -> Ini -> IO ()
writeIniFile = WriteIniSettings -> [Char] -> Ini -> IO ()
writeIniFileWith WriteIniSettings
defaultWriteIniSettings

-- | Print an INI config.
printIni :: Ini -> Text
printIni :: Ini -> Text
printIni = WriteIniSettings -> Ini -> Text
printIniWith WriteIniSettings
defaultWriteIniSettings

-- | Either @:@ or @=@.
data KeySeparator
  = ColonKeySeparator
  | EqualsKeySeparator
  deriving (KeySeparator -> KeySeparator -> Bool
(KeySeparator -> KeySeparator -> Bool)
-> (KeySeparator -> KeySeparator -> Bool) -> Eq KeySeparator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeySeparator -> KeySeparator -> Bool
== :: KeySeparator -> KeySeparator -> Bool
$c/= :: KeySeparator -> KeySeparator -> Bool
/= :: KeySeparator -> KeySeparator -> Bool
Eq, Int -> KeySeparator -> ShowS
[KeySeparator] -> ShowS
KeySeparator -> [Char]
(Int -> KeySeparator -> ShowS)
-> (KeySeparator -> [Char])
-> ([KeySeparator] -> ShowS)
-> Show KeySeparator
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeySeparator -> ShowS
showsPrec :: Int -> KeySeparator -> ShowS
$cshow :: KeySeparator -> [Char]
show :: KeySeparator -> [Char]
$cshowList :: [KeySeparator] -> ShowS
showList :: [KeySeparator] -> ShowS
Show)

-- | Settings determining how an INI file is written.
data WriteIniSettings = WriteIniSettings
  { WriteIniSettings -> KeySeparator
writeIniKeySeparator :: KeySeparator
  } deriving (Int -> WriteIniSettings -> ShowS
[WriteIniSettings] -> ShowS
WriteIniSettings -> [Char]
(Int -> WriteIniSettings -> ShowS)
-> (WriteIniSettings -> [Char])
-> ([WriteIniSettings] -> ShowS)
-> Show WriteIniSettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriteIniSettings -> ShowS
showsPrec :: Int -> WriteIniSettings -> ShowS
$cshow :: WriteIniSettings -> [Char]
show :: WriteIniSettings -> [Char]
$cshowList :: [WriteIniSettings] -> ShowS
showList :: [WriteIniSettings] -> ShowS
Show)

-- | The default settings for writing INI files.
defaultWriteIniSettings :: WriteIniSettings
defaultWriteIniSettings :: WriteIniSettings
defaultWriteIniSettings = WriteIniSettings
  { writeIniKeySeparator :: KeySeparator
writeIniKeySeparator = KeySeparator
ColonKeySeparator
  }

-- | Print the INI config to a file.
writeIniFileWith :: WriteIniSettings -> FilePath -> Ini -> IO ()
writeIniFileWith :: WriteIniSettings -> [Char] -> Ini -> IO ()
writeIniFileWith WriteIniSettings
wis [Char]
fp = [Char] -> Text -> IO ()
T.writeFile [Char]
fp (Text -> IO ()) -> (Ini -> Text) -> Ini -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriteIniSettings -> Ini -> Text
printIniWith WriteIniSettings
wis

-- | Print an INI config.
printIniWith :: WriteIniSettings -> Ini -> Text
printIniWith :: WriteIniSettings -> Ini -> Text
printIniWith WriteIniSettings
wis Ini
i =
  [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
buildPair (Ini -> [(Text, Text)]
iniGlobals Ini
i)) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
             (((Text, [(Text, Text)]) -> Text)
-> [(Text, [(Text, Text)])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [(Text, Text)]) -> Text
buildSection (HashMap Text [(Text, Text)] -> [(Text, [(Text, Text)])]
forall k v. HashMap k v -> [(k, v)]
M.toList (Ini -> HashMap Text [(Text, Text)]
iniSections Ini
i)))
  where buildSection :: (Text, [(Text, Text)]) -> Text
buildSection (Text
name,[(Text, Text)]
pairs) =
          Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          [Text] -> Text
T.concat (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
buildPair [(Text, Text)]
pairs)
        buildPair :: (Text, Text) -> Text
buildPair (Text
name,Text
value) =
          Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
separator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        separator :: Text
separator = case WriteIniSettings -> KeySeparator
writeIniKeySeparator WriteIniSettings
wis of
          KeySeparator
ColonKeySeparator  -> Text
": "
          KeySeparator
EqualsKeySeparator -> Text
"="

-- | Parser for an INI.
iniParser :: Parser Ini
iniParser :: Parser Ini
iniParser =
  (\[(Text, Text)]
kv [(Text, [(Text, Text)])]
secs -> Ini {iniSections :: HashMap Text [(Text, Text)]
iniSections = [(Text, [(Text, Text)])] -> HashMap Text [(Text, Text)]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(Text, [(Text, Text)])]
secs, iniGlobals :: [(Text, Text)]
iniGlobals = [(Text, Text)]
kv}) ([(Text, Text)] -> [(Text, [(Text, Text)])] -> Ini)
-> Parser Text [(Text, Text)]
-> Parser Text ([(Text, [(Text, Text)])] -> Ini)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Parser Text (Text, Text) -> Parser Text [(Text, Text)]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text (Text, Text)
keyValueParser Parser Text ([(Text, [(Text, Text)])] -> Ini)
-> Parser Text [(Text, [(Text, Text)])] -> Parser Ini
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser Text (Text, [(Text, Text)])
-> Parser Text [(Text, [(Text, Text)])]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text (Text, [(Text, Text)])
sectionParser Parser Ini -> Parser Text () -> Parser Ini
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
  (Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput Parser Text () -> Parser Text () -> Parser Text ()
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Text ()
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Text ())
-> (Text -> [Char]) -> Text -> Parser Text ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> Parser Text ()) -> Parser Text Text -> Parser Text ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> Parser Text Text
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isControl)))

-- | A section. Format: @[foo]@. Conventionally, @[FOO]@.
sectionParser :: Parser (Text,[(Text, Text)])
sectionParser :: Parser Text (Text, [(Text, Text)])
sectionParser =
  do Parser Text ()
skipEndOfLine
     Parser Text ()
skipComments
     Parser Text ()
skipEndOfLine
     Char
_ <- Char -> Parser Char
char Char
'['
     Text
name <- (Char -> Bool) -> Parser Text Text
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
']' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[')
     Char
_ <- Char -> Parser Char
char Char
']'
     Parser Text ()
skipEndOfLine
     [(Text, Text)]
values <- Parser Text (Text, Text) -> Parser Text [(Text, Text)]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text (Text, Text)
keyValueParser
     (Text, [(Text, Text)]) -> Parser Text (Text, [(Text, Text)])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
T.strip Text
name, [(Text, Text)]
values)

-- | A key-value pair. Either @foo: bar@ or @foo=bar@.
keyValueParser :: Parser (Text,Text)
keyValueParser :: Parser Text (Text, Text)
keyValueParser =
  do Parser Text ()
skipEndOfLine
     Parser Text ()
skipComments
     Parser Text ()
skipEndOfLine
     Text
key <- (Char -> Bool) -> Parser Text Text
takeWhile1 (\Char
c -> Bool -> Bool
not (Char -> Bool
isDelim Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']'))
     Char
delim <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isDelim
     Text
value <- (Text -> Text) -> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Text -> Text
clean Char
delim) ((Char -> Bool) -> Parser Text Text
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine))
     Parser Text ()
skipEndOfLine
     (Text, Text) -> Parser Text (Text, Text)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
T.strip Text
key, Text -> Text
T.strip Text
value)
  where clean :: Char -> Text -> Text
clean Char
':' = Int -> Text -> Text
T.drop Int
1
        clean Char
_   = Text -> Text
forall a. a -> a
id

-- | Is the given character a delimiter?
isDelim :: Char -> Bool
isDelim :: Char -> Bool
isDelim Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'

-- | Skip end of line and whitespace beyond.
skipEndOfLine :: Parser ()
skipEndOfLine :: Parser Text ()
skipEndOfLine = (Char -> Bool) -> Parser Text ()
skipWhile Char -> Bool
isSpace

-- | Skip comments starting at the beginning of the line.
skipComments :: Parser ()
skipComments :: Parser Text ()
skipComments =
  Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (do Char
_ <- (Char -> Bool) -> Parser Char
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
               (Char -> Bool) -> Parser Text ()
skipWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine)
               Parser Text ()
skipEndOfLine)