{-# LANGUAGE OverloadedStrings #-}

module Network.ZRE.Options (
    parseOptions
  ) where

import Options.Applicative
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B

import Network.ZRE.Types
import System.ZMQ4.Endpoint

parseOptions :: Parser ZRECfg
parseOptions :: Parser ZRECfg
parseOptions = ByteString
-> Float
-> Float
-> Float
-> Float
-> [ByteString]
-> Endpoint
-> Maybe Endpoint
-> Bool
-> ZRECfg
ZRECfg
  (ByteString
 -> Float
 -> Float
 -> Float
 -> Float
 -> [ByteString]
 -> Endpoint
 -> Maybe Endpoint
 -> Bool
 -> ZRECfg)
-> Parser ByteString
-> Parser
     (Float
      -> Float
      -> Float
      -> Float
      -> [ByteString]
      -> Endpoint
      -> Maybe Endpoint
      -> Bool
      -> ZRECfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ByteString
B.pack (String -> ByteString) -> Parser String -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"name"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n'
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
""
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Node name"))
  Parser
  (Float
   -> Float
   -> Float
   -> Float
   -> [ByteString]
   -> Endpoint
   -> Maybe Endpoint
   -> Bool
   -> ZRECfg)
-> Parser Float
-> Parser
     (Float
      -> Float
      -> Float
      -> [ByteString]
      -> Endpoint
      -> Maybe Endpoint
      -> Bool
      -> ZRECfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadM Float -> Mod OptionFields Float -> Parser Float
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Float
forall a. Read a => ReadM a
auto
        (String -> Mod OptionFields Float
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"quiet-period"
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Float
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'q'
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Float
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"N"
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> Float -> Mod OptionFields Float
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Float
1.0
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Float
forall (f :: * -> *) a. String -> Mod f a
help String
"Ping peer after N seconds"))
  Parser
  (Float
   -> Float
   -> Float
   -> [ByteString]
   -> Endpoint
   -> Maybe Endpoint
   -> Bool
   -> ZRECfg)
-> Parser Float
-> Parser
     (Float
      -> Float
      -> [ByteString]
      -> Endpoint
      -> Maybe Endpoint
      -> Bool
      -> ZRECfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadM Float -> Mod OptionFields Float -> Parser Float
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Float
forall a. Read a => ReadM a
auto
        (String -> Mod OptionFields Float
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"quiet-ping-rate"
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Float
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Float
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"N"
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> Float -> Mod OptionFields Float
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Float
1.0
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Float
forall (f :: * -> *) a. String -> Mod f a
help String
"Peer ping rate after quiet period passed"))
  Parser
  (Float
   -> Float
   -> [ByteString]
   -> Endpoint
   -> Maybe Endpoint
   -> Bool
   -> ZRECfg)
-> Parser Float
-> Parser
     (Float
      -> [ByteString] -> Endpoint -> Maybe Endpoint -> Bool -> ZRECfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadM Float -> Mod OptionFields Float -> Parser Float
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Float
forall a. Read a => ReadM a
auto
        (String -> Mod OptionFields Float
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dead-period"
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Float
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Float
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"N"
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> Float -> Mod OptionFields Float
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Float
5.0
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Float
forall (f :: * -> *) a. String -> Mod f a
help String
"Mark peer dead after N seconds"))
  Parser
  (Float
   -> [ByteString] -> Endpoint -> Maybe Endpoint -> Bool -> ZRECfg)
-> Parser Float
-> Parser
     ([ByteString] -> Endpoint -> Maybe Endpoint -> Bool -> ZRECfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadM Float -> Mod OptionFields Float -> Parser Float
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Float
forall a. Read a => ReadM a
auto
         (String -> Mod OptionFields Float
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"beacon-period"
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Float
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b'
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Float
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"N"
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> Float -> Mod OptionFields Float
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Float
0.9
      Mod OptionFields Float
-> Mod OptionFields Float -> Mod OptionFields Float
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Float
forall (f :: * -> *) a. String -> Mod f a
help String
"Send beacon every N seconds"))
  Parser
  ([ByteString] -> Endpoint -> Maybe Endpoint -> Bool -> ZRECfg)
-> Parser [ByteString]
-> Parser (Endpoint -> Maybe Endpoint -> Bool -> ZRECfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
B.pack) ([String] -> [ByteString])
-> Parser [String] -> Parser [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"interface"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i'
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"IFACE"
      Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Interfaces")))
  Parser (Endpoint -> Maybe Endpoint -> Bool -> ZRECfg)
-> Parser Endpoint -> Parser (Maybe Endpoint -> Bool -> ZRECfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Endpoint -> Mod OptionFields Endpoint -> Parser Endpoint
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((ByteString -> Either String Endpoint) -> ReadM Endpoint
forall a. (ByteString -> Either String a) -> ReadM a
attoReadM ByteString -> Either String Endpoint
parseAttoUDPEndpoint)
        (String -> Mod OptionFields Endpoint
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"multicast-group"
      Mod OptionFields Endpoint
-> Mod OptionFields Endpoint -> Mod OptionFields Endpoint
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Endpoint
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm'
      Mod OptionFields Endpoint
-> Mod OptionFields Endpoint -> Mod OptionFields Endpoint
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Endpoint
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"IP:PORT"
      Mod OptionFields Endpoint
-> Mod OptionFields Endpoint -> Mod OptionFields Endpoint
forall a. Semigroup a => a -> a -> a
<> Endpoint -> Mod OptionFields Endpoint
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Endpoint
defMCastEndpoint
      Mod OptionFields Endpoint
-> Mod OptionFields Endpoint -> Mod OptionFields Endpoint
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Endpoint
forall (f :: * -> *) a. String -> Mod f a
help String
"IP:PORT of the multicast group")
  Parser (Maybe Endpoint -> Bool -> ZRECfg)
-> Parser (Maybe Endpoint) -> Parser (Bool -> ZRECfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Endpoint -> Parser (Maybe Endpoint)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Endpoint -> Mod OptionFields Endpoint -> Parser Endpoint
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((ByteString -> Either String Endpoint) -> ReadM Endpoint
forall a. (ByteString -> Either String a) -> ReadM a
attoReadM ByteString -> Either String Endpoint
parseAttoTCPEndpoint)
        (String -> Mod OptionFields Endpoint
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"gossip"
      Mod OptionFields Endpoint
-> Mod OptionFields Endpoint -> Mod OptionFields Endpoint
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Endpoint
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'g'
      Mod OptionFields Endpoint
-> Mod OptionFields Endpoint -> Mod OptionFields Endpoint
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Endpoint
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"IP:PORT"
      Mod OptionFields Endpoint
-> Mod OptionFields Endpoint -> Mod OptionFields Endpoint
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Endpoint
forall (f :: * -> *) a. String -> Mod f a
help String
"IP:PORT of the gossip server"))
  Parser (Bool -> ZRECfg) -> Parser Bool -> Parser ZRECfg
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"debug" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd')

attoReadM :: (ByteString -> Either String a) -> ReadM a
attoReadM :: (ByteString -> Either String a) -> ReadM a
attoReadM ByteString -> Either String a
p = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader (ByteString -> Either String a
p (ByteString -> Either String a)
-> (String -> ByteString) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack)