{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Program.Mighty.Config (
  -- * Parsing a configuration file.
    parseOption
#ifdef DHALL
  , parseOptionDhall
#else
  , Natural
#endif
  -- * Creating 'Option'.
  , defaultOption
  -- * Types
  , Option(..)
  ) where

import Data.List.Split (splitOn)
import Text.Parsec
import Text.Parsec.ByteString.Lazy
#ifdef DHALL
import Data.String (fromString)
import qualified Data.Text as T
import Dhall(Generic, Natural, input, auto, FromDhall)
import qualified Program.Mighty.Dhall.Option as Do

#else
import Program.Mighty.Types
#endif

import Program.Mighty.Parser

----------------------------------------------------------------

data Option = Option {
    Option -> Natural
opt_port :: Natural
  , Option -> [Char]
opt_host :: String
  , Option -> Bool
opt_debug_mode :: Bool
  , Option -> [Char]
opt_user  :: String
  , Option -> [Char]
opt_group :: String
  , Option -> [Char]
opt_pid_file    :: FilePath
  , Option -> [Char]
opt_report_file :: FilePath
  , Option -> Bool
opt_logging :: Bool
  , Option -> [Char]
opt_log_file :: FilePath
  , Option -> Natural
opt_log_file_size :: Natural
  , Option -> Natural
opt_log_backup_number :: Natural
  , Option -> [Char]
opt_index_file :: FilePath
  , Option -> [Char]
opt_index_cgi  :: FilePath
  , Option -> [Char]
opt_status_file_dir :: FilePath
  , Option -> Natural
opt_connection_timeout :: Natural
  , Option -> Natural
opt_proxy_timeout      :: Natural
  , Option -> Natural
opt_fd_cache_duration  :: Natural
  , Option -> Natural
opt_service :: Natural
  , Option -> Natural
opt_tls_port :: Natural
  , Option -> [Char]
opt_tls_cert_file   :: FilePath
  , Option -> [Char]
opt_tls_chain_files :: FilePath
  , Option -> [Char]
opt_tls_key_file    :: FilePath
  , Option -> Natural
opt_quic_port :: Natural
  , Option -> [[Char]]
opt_quic_addr :: [String]
  , Option -> Maybe [Char]
opt_quic_debug_dir :: Maybe FilePath
  , Option -> Maybe [Char]
opt_quic_qlog_dir  :: Maybe FilePath
  , Option -> [Char]
opt_server_name :: String
  , Option -> Maybe [Char]
opt_routing_file :: Maybe String
#ifdef DHALL
} deriving (Eq, Show, Generic)
#else
} deriving (Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
/= :: Option -> Option -> Bool
Eq, Natural -> Option -> ShowS
[Option] -> ShowS
Option -> [Char]
(Natural -> Option -> ShowS)
-> (Option -> [Char]) -> ([Option] -> ShowS) -> Show Option
forall a.
(Natural -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Natural -> Option -> ShowS
showsPrec :: Natural -> Option -> ShowS
$cshow :: Option -> [Char]
show :: Option -> [Char]
$cshowList :: [Option] -> ShowS
showList :: [Option] -> ShowS
Show)
#endif

#ifdef DHALL
instance FromDhall Option
#endif

-- | Getting a default 'Option'.
defaultOption :: Option
defaultOption :: Option
defaultOption = Option {
    opt_port :: Natural
opt_port = Natural
8080
  , opt_host :: [Char]
opt_host = [Char]
"*"
  , opt_debug_mode :: Bool
opt_debug_mode = Bool
True
  , opt_user :: [Char]
opt_user  = [Char]
"root"
  , opt_group :: [Char]
opt_group = [Char]
"root"
  , opt_pid_file :: [Char]
opt_pid_file    = [Char]
"/var/run/mighty.pid"
  , opt_report_file :: [Char]
opt_report_file = [Char]
"/tmp/mighty_report"
  , opt_logging :: Bool
opt_logging = Bool
True
  , opt_log_file :: [Char]
opt_log_file = [Char]
"/var/log/mighty"
  , opt_log_file_size :: Natural
opt_log_file_size = Natural
16777216
  , opt_log_backup_number :: Natural
opt_log_backup_number = Natural
10
  , opt_index_file :: [Char]
opt_index_file = [Char]
"index.html"
  , opt_index_cgi :: [Char]
opt_index_cgi  = [Char]
"index.cgi"
  , opt_status_file_dir :: [Char]
opt_status_file_dir = [Char]
"/usr/local/share/mighty/status"
  , opt_connection_timeout :: Natural
opt_connection_timeout = Natural
30
  , opt_proxy_timeout :: Natural
opt_proxy_timeout      = Natural
0
  , opt_fd_cache_duration :: Natural
opt_fd_cache_duration  = Natural
10
  , opt_service :: Natural
opt_service = Natural
0
  , opt_tls_port :: Natural
opt_tls_port = Natural
443
  , opt_tls_cert_file :: [Char]
opt_tls_cert_file   = [Char]
"cert.pem"
  , opt_tls_chain_files :: [Char]
opt_tls_chain_files = [Char]
"chain.pem"
  , opt_tls_key_file :: [Char]
opt_tls_key_file    = [Char]
"privkey.pem"
  , opt_quic_port :: Natural
opt_quic_port = Natural
443
  , opt_quic_addr :: [[Char]]
opt_quic_addr = [[Char]
"127.0.0.1"]
  , opt_quic_debug_dir :: Maybe [Char]
opt_quic_debug_dir = Maybe [Char]
forall a. Maybe a
Nothing
  , opt_quic_qlog_dir :: Maybe [Char]
opt_quic_qlog_dir  = Maybe [Char]
forall a. Maybe a
Nothing
  , opt_server_name :: [Char]
opt_server_name = [Char]
"Dummy"
  , opt_routing_file :: Maybe [Char]
opt_routing_file = Maybe [Char]
forall a. Maybe a
Nothing
}

----------------------------------------------------------------
-- | Parsing a configuration file to get an 'Option'.
parseOption :: FilePath -> IO Option
parseOption :: [Char] -> IO Option
parseOption [Char]
file = Option -> [Conf] -> Option
makeOpt Option
defaultOption ([Conf] -> Option) -> IO [Conf] -> IO Option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Conf]
parseConfig [Char]
file

#ifdef DHALL
parseOptionDhall :: FilePath -> IO Option
parseOptionDhall = fmap optionFromDhall . input auto . fromString

optionFromDhall :: Do.Option -> Option
optionFromDhall o = Option
  { opt_port = Do.port o
  , opt_host = T.unpack $ Do.host o
  , opt_debug_mode = Do.debugMode o
  , opt_user  = T.unpack $ Do.user o
  , opt_group = T.unpack $ Do.group o
  , opt_pid_file    = T.unpack $ Do.pidFile o
  , opt_report_file = T.unpack $ Do.reportFile o
  , opt_logging = Do.logging o
  , opt_log_file = T.unpack $ Do.logFile o
  , opt_log_file_size = Do.logFileSize o
  , opt_log_backup_number = Do.logBackupNumber o
  , opt_index_file = T.unpack $ Do.indexFile o
  , opt_index_cgi  = T.unpack $ Do.indexCgi o
  , opt_status_file_dir = T.unpack $ Do.statusFileDir o
  , opt_connection_timeout = Do.connectionTimeout o
  , opt_proxy_timeout      = Do.proxyTimeout o
  , opt_fd_cache_duration  = Do.fdCacheDuration o
  , opt_service = Do.service o
  , opt_tls_port = Do.tlsPort o
  , opt_tls_cert_file   = T.unpack $ Do.tlsCertFile o
  , opt_tls_chain_files = T.unpack $ Do.tlsChainFiles o
  , opt_tls_key_file    = T.unpack $ Do.tlsKeyFile o
  , opt_quic_addr = T.unpack <$> Do.quicAddr o
  , opt_quic_port = Do.quicPort o
  , opt_quic_debug_dir = T.unpack <$> Do.quicDebugDir o
  , opt_quic_qlog_dir  = T.unpack <$> Do.quicQlogDir o
  , opt_server_name = "Dummy"
  , opt_routing_file = Nothing
}
#endif

----------------------------------------------------------------

makeOpt :: Option -> [Conf] -> Option
makeOpt :: Option -> [Conf] -> Option
makeOpt Option
def [Conf]
conf = Option {
    opt_port :: Natural
opt_port               = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Port" Option -> Natural
opt_port
  , opt_host :: [Char]
opt_host               = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Host" Option -> [Char]
opt_host
  , opt_debug_mode :: Bool
opt_debug_mode         = [Char] -> (Option -> Bool) -> Bool
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Debug_Mode" Option -> Bool
opt_debug_mode
  , opt_user :: [Char]
opt_user               = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"User" Option -> [Char]
opt_user
  , opt_group :: [Char]
opt_group              = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Group" Option -> [Char]
opt_group
  , opt_pid_file :: [Char]
opt_pid_file           = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Pid_File" Option -> [Char]
opt_pid_file
  , opt_report_file :: [Char]
opt_report_file        = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Report_File" Option -> [Char]
opt_report_file
  , opt_logging :: Bool
opt_logging            = [Char] -> (Option -> Bool) -> Bool
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Logging" Option -> Bool
opt_logging
  , opt_log_file :: [Char]
opt_log_file           = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Log_File" Option -> [Char]
opt_log_file
  , opt_log_file_size :: Natural
opt_log_file_size      = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Log_File_Size" Option -> Natural
opt_log_file_size
  , opt_log_backup_number :: Natural
opt_log_backup_number  = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Log_Backup_Number" Option -> Natural
opt_log_backup_number
  , opt_index_file :: [Char]
opt_index_file         = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Index_File" Option -> [Char]
opt_index_file
  , opt_index_cgi :: [Char]
opt_index_cgi          = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Index_Cgi" Option -> [Char]
opt_index_cgi
  , opt_status_file_dir :: [Char]
opt_status_file_dir    = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Status_File_Dir" Option -> [Char]
opt_status_file_dir
  , opt_connection_timeout :: Natural
opt_connection_timeout = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Connection_Timeout" Option -> Natural
opt_connection_timeout
  , opt_proxy_timeout :: Natural
opt_proxy_timeout      = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Proxy_Timeout" Option -> Natural
opt_proxy_timeout
  , opt_fd_cache_duration :: Natural
opt_fd_cache_duration  = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Fd_Cache_Duration" Option -> Natural
opt_fd_cache_duration
  , opt_service :: Natural
opt_service            = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Service" Option -> Natural
opt_service
  , opt_tls_port :: Natural
opt_tls_port           = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Tls_Port" Option -> Natural
opt_tls_port
  , opt_tls_cert_file :: [Char]
opt_tls_cert_file      = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Tls_Cert_File" Option -> [Char]
opt_tls_cert_file
  , opt_tls_chain_files :: [Char]
opt_tls_chain_files    = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Tls_Chain_Files" Option -> [Char]
opt_tls_chain_files
  , opt_tls_key_file :: [Char]
opt_tls_key_file       = [Char] -> (Option -> [Char]) -> [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Tls_Key_File" Option -> [Char]
opt_tls_key_file
  , opt_quic_addr :: [[Char]]
opt_quic_addr          = [Char] -> (Option -> [[Char]]) -> [[Char]]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Quic_Addr" Option -> [[Char]]
opt_quic_addr
  , opt_quic_port :: Natural
opt_quic_port          = [Char] -> (Option -> Natural) -> Natural
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Quic_Port" Option -> Natural
opt_quic_port
  , opt_quic_debug_dir :: Maybe [Char]
opt_quic_debug_dir     = [Char] -> (Option -> Maybe [Char]) -> Maybe [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Quic_Debug_Dir" Option -> Maybe [Char]
opt_quic_debug_dir
  , opt_quic_qlog_dir :: Maybe [Char]
opt_quic_qlog_dir      = [Char] -> (Option -> Maybe [Char]) -> Maybe [Char]
forall {b}. FromConf b => [Char] -> (Option -> b) -> b
get [Char]
"Quic_Qlog_Dir" Option -> Maybe [Char]
opt_quic_qlog_dir
  , opt_server_name :: [Char]
opt_server_name        = [Char]
"Dummy"
  , opt_routing_file :: Maybe [Char]
opt_routing_file       = Maybe [Char]
forall a. Maybe a
Nothing
  }
  where
    get :: [Char] -> (Option -> b) -> b
get [Char]
k Option -> b
func = b -> (ConfValue -> b) -> Maybe ConfValue -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Option -> b
func Option
def) ConfValue -> b
forall a. FromConf a => ConfValue -> a
fromConf (Maybe ConfValue -> b) -> Maybe ConfValue -> b
forall a b. (a -> b) -> a -> b
$ [Char] -> [Conf] -> Maybe ConfValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
k [Conf]
conf

----------------------------------------------------------------

type Conf = (String, ConfValue)

data ConfValue = CV_Natural Natural | CV_Bool Bool | CV_String String deriving (ConfValue -> ConfValue -> Bool
(ConfValue -> ConfValue -> Bool)
-> (ConfValue -> ConfValue -> Bool) -> Eq ConfValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfValue -> ConfValue -> Bool
== :: ConfValue -> ConfValue -> Bool
$c/= :: ConfValue -> ConfValue -> Bool
/= :: ConfValue -> ConfValue -> Bool
Eq,Natural -> ConfValue -> ShowS
[ConfValue] -> ShowS
ConfValue -> [Char]
(Natural -> ConfValue -> ShowS)
-> (ConfValue -> [Char])
-> ([ConfValue] -> ShowS)
-> Show ConfValue
forall a.
(Natural -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Natural -> ConfValue -> ShowS
showsPrec :: Natural -> ConfValue -> ShowS
$cshow :: ConfValue -> [Char]
show :: ConfValue -> [Char]
$cshowList :: [ConfValue] -> ShowS
showList :: [ConfValue] -> ShowS
Show)

class FromConf a where
    fromConf :: ConfValue -> a

instance FromConf Natural where
    fromConf :: ConfValue -> Natural
fromConf (CV_Natural Natural
n) = Natural
n
    fromConf ConfValue
_ = [Char] -> Natural
forall a. HasCallStack => [Char] -> a
error [Char]
"fromConf int"

instance FromConf Bool where
    fromConf :: ConfValue -> Bool
fromConf (CV_Bool Bool
b) = Bool
b
    fromConf ConfValue
_ = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"fromConf bool"

instance FromConf String where
    fromConf :: ConfValue -> [Char]
fromConf (CV_String [Char]
s) = [Char]
s
    fromConf ConfValue
_ = ShowS
forall a. HasCallStack => [Char] -> a
error [Char]
"fromConf string"

instance FromConf (Maybe String) where
    fromConf :: ConfValue -> Maybe [Char]
fromConf (CV_String [Char]
"") = Maybe [Char]
forall a. Maybe a
Nothing
    fromConf (CV_String [Char]
s)  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s
    fromConf ConfValue
_ = [Char] -> Maybe [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"fromConf string"

instance FromConf [String] where
    fromConf :: ConfValue -> [[Char]]
fromConf (CV_String [Char]
s)  = [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"," [Char]
s
    fromConf ConfValue
_ = [Char] -> [[Char]]
forall a. HasCallStack => [Char] -> a
error [Char]
"fromConf string"

----------------------------------------------------------------

parseConfig :: FilePath -> IO [Conf]
parseConfig :: [Char] -> IO [Conf]
parseConfig = Parser [Conf] -> [Char] -> IO [Conf]
forall a. Parser a -> [Char] -> IO a
parseFile Parser [Conf]
config

----------------------------------------------------------------

config :: Parser [Conf]
config :: Parser [Conf]
config = Parser ()
commentLines Parser () -> Parser [Conf] -> Parser [Conf]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity Conf -> Parser [Conf]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT ByteString () Identity Conf
cfield Parser [Conf] -> Parser () -> Parser [Conf]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  where
    cfield :: ParsecT ByteString () Identity Conf
cfield = ParsecT ByteString () Identity Conf
field ParsecT ByteString () Identity Conf
-> Parser () -> ParsecT ByteString () Identity Conf
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commentLines

field :: Parser Conf
field :: ParsecT ByteString () Identity Conf
field = (,) ([Char] -> ConfValue -> Conf)
-> ParsecT ByteString () Identity [Char]
-> ParsecT ByteString () Identity (ConfValue -> Conf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity [Char]
key ParsecT ByteString () Identity (ConfValue -> Conf)
-> ParsecT ByteString () Identity ConfValue
-> ParsecT ByteString () Identity Conf
forall a b.
ParsecT ByteString () Identity (a -> b)
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
sep Parser ()
-> ParsecT ByteString () Identity ConfValue
-> ParsecT ByteString () Identity ConfValue
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity ConfValue
value)

key :: Parser String
key :: ParsecT ByteString () Identity [Char]
key = ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Char] -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf ([Char] -> ParsecT ByteString () Identity Char)
-> [Char] -> ParsecT ByteString () Identity Char
forall a b. (a -> b) -> a -> b
$ [Char
'a'..Char
'z'] [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9'] [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_") ParsecT ByteString () Identity [Char]
-> Parser () -> ParsecT ByteString () Identity [Char]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spcs

sep :: Parser ()
sep :: Parser ()
sep = () () -> ParsecT ByteString () Identity Char -> Parser ()
forall a b.
a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' Parser () -> Parser () -> Parser ()
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
spcs

value :: Parser ConfValue
value :: ParsecT ByteString () Identity ConfValue
value = [ParsecT ByteString () Identity ConfValue]
-> ParsecT ByteString () Identity ConfValue
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT ByteString () Identity ConfValue
-> ParsecT ByteString () Identity ConfValue
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT ByteString () Identity ConfValue
cv_natural, ParsecT ByteString () Identity ConfValue
-> ParsecT ByteString () Identity ConfValue
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT ByteString () Identity ConfValue
cv_bool, ParsecT ByteString () Identity ConfValue
cv_string]

-- Trailing should be included in try to allow IP addresses.
cv_natural :: Parser ConfValue
cv_natural :: ParsecT ByteString () Identity ConfValue
cv_natural = Natural -> ConfValue
CV_Natural (Natural -> ConfValue)
-> ([Char] -> Natural) -> [Char] -> ConfValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Natural
forall a. Read a => [Char] -> a
read ([Char] -> ConfValue)
-> ParsecT ByteString () Identity [Char]
-> ParsecT ByteString () Identity ConfValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT ByteString () Identity ConfValue
-> Parser () -> ParsecT ByteString () Identity ConfValue
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
trailing

cv_bool :: Parser ConfValue
cv_bool :: ParsecT ByteString () Identity ConfValue
cv_bool = Bool -> ConfValue
CV_Bool Bool
True  ConfValue
-> ParsecT ByteString () Identity [Char]
-> ParsecT ByteString () Identity ConfValue
forall a b.
a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT ByteString () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"Yes" ParsecT ByteString () Identity ConfValue
-> Parser () -> ParsecT ByteString () Identity ConfValue
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
trailing ParsecT ByteString () Identity ConfValue
-> ParsecT ByteString () Identity ConfValue
-> ParsecT ByteString () Identity ConfValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          Bool -> ConfValue
CV_Bool Bool
False ConfValue
-> ParsecT ByteString () Identity [Char]
-> ParsecT ByteString () Identity ConfValue
forall a b.
a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT ByteString () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"No"  ParsecT ByteString () Identity ConfValue
-> Parser () -> ParsecT ByteString () Identity ConfValue
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
trailing

cv_string :: Parser ConfValue
cv_string :: ParsecT ByteString () Identity ConfValue
cv_string = [Char] -> ConfValue
CV_String ([Char] -> ConfValue)
-> ParsecT ByteString () Identity [Char]
-> ParsecT ByteString () Identity ConfValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
" \t\n") ParsecT ByteString () Identity ConfValue
-> Parser () -> ParsecT ByteString () Identity ConfValue
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
trailing