{- |
Module      : Test.Tasty.WebDriver.Config
Description : Helpers for parsing config files.
Copyright   : 2018, Automattic, Inc.
License     : GPL-3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX
-}

{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Test.Tasty.WebDriver.Config (
    DriverName(..)
  , RemoteEndPool(..)
  , addRemoteEndForDriver
  , getRemoteEndForDriver
  , RemoteEnd(..)

  -- * Parsing
  , parseRemoteEnd
  , parseRemoteEndConfig
  , parseRemoteEndOption

  , parseOptionWithArgument
  ) where

import Data.List
  ( isPrefixOf, nub )
import qualified Data.Map.Strict as MS
  ( fromListWith, insert, lookup, adjust, fromList, unionWith, Map )
import Data.Typeable
  ( Typeable )
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Network.URI
  ( URI(..), URIAuth(..), parseURI )
import Text.Read
  ( readMaybe )



-- | Remote end name.
data DriverName
  = Geckodriver
  | Chromedriver
  deriving (DriverName -> DriverName -> Bool
(DriverName -> DriverName -> Bool)
-> (DriverName -> DriverName -> Bool) -> Eq DriverName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DriverName -> DriverName -> Bool
$c/= :: DriverName -> DriverName -> Bool
== :: DriverName -> DriverName -> Bool
$c== :: DriverName -> DriverName -> Bool
Eq, Eq DriverName
Eq DriverName
-> (DriverName -> DriverName -> Ordering)
-> (DriverName -> DriverName -> Bool)
-> (DriverName -> DriverName -> Bool)
-> (DriverName -> DriverName -> Bool)
-> (DriverName -> DriverName -> Bool)
-> (DriverName -> DriverName -> DriverName)
-> (DriverName -> DriverName -> DriverName)
-> Ord DriverName
DriverName -> DriverName -> Bool
DriverName -> DriverName -> Ordering
DriverName -> DriverName -> DriverName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DriverName -> DriverName -> DriverName
$cmin :: DriverName -> DriverName -> DriverName
max :: DriverName -> DriverName -> DriverName
$cmax :: DriverName -> DriverName -> DriverName
>= :: DriverName -> DriverName -> Bool
$c>= :: DriverName -> DriverName -> Bool
> :: DriverName -> DriverName -> Bool
$c> :: DriverName -> DriverName -> Bool
<= :: DriverName -> DriverName -> Bool
$c<= :: DriverName -> DriverName -> Bool
< :: DriverName -> DriverName -> Bool
$c< :: DriverName -> DriverName -> Bool
compare :: DriverName -> DriverName -> Ordering
$ccompare :: DriverName -> DriverName -> Ordering
$cp1Ord :: Eq DriverName
Ord, Typeable)

instance Show DriverName where
  show :: DriverName -> String
show DriverName
Geckodriver = String
"geckodriver"
  show DriverName
Chromedriver = String
"chromedriver"

-- | Pool of remote end connections per driver.
newtype RemoteEndPool = RemoteEndPool
  { RemoteEndPool -> Map DriverName [RemoteEnd]
freeRemoteEnds :: MS.Map DriverName [RemoteEnd]
  } deriving (RemoteEndPool -> RemoteEndPool -> Bool
(RemoteEndPool -> RemoteEndPool -> Bool)
-> (RemoteEndPool -> RemoteEndPool -> Bool) -> Eq RemoteEndPool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteEndPool -> RemoteEndPool -> Bool
$c/= :: RemoteEndPool -> RemoteEndPool -> Bool
== :: RemoteEndPool -> RemoteEndPool -> Bool
$c== :: RemoteEndPool -> RemoteEndPool -> Bool
Eq, Int -> RemoteEndPool -> ShowS
[RemoteEndPool] -> ShowS
RemoteEndPool -> String
(Int -> RemoteEndPool -> ShowS)
-> (RemoteEndPool -> String)
-> ([RemoteEndPool] -> ShowS)
-> Show RemoteEndPool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteEndPool] -> ShowS
$cshowList :: [RemoteEndPool] -> ShowS
show :: RemoteEndPool -> String
$cshow :: RemoteEndPool -> String
showsPrec :: Int -> RemoteEndPool -> ShowS
$cshowsPrec :: Int -> RemoteEndPool -> ShowS
Show)

instance Semigroup RemoteEndPool where
  RemoteEndPool
x <> :: RemoteEndPool -> RemoteEndPool -> RemoteEndPool
<> RemoteEndPool
y = RemoteEndPool :: Map DriverName [RemoteEnd] -> RemoteEndPool
RemoteEndPool
    { freeRemoteEnds :: Map DriverName [RemoteEnd]
freeRemoteEnds = ([RemoteEnd] -> [RemoteEnd] -> [RemoteEnd])
-> Map DriverName [RemoteEnd]
-> Map DriverName [RemoteEnd]
-> Map DriverName [RemoteEnd]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
MS.unionWith [RemoteEnd] -> [RemoteEnd] -> [RemoteEnd]
forall a. [a] -> [a] -> [a]
(++) (RemoteEndPool -> Map DriverName [RemoteEnd]
freeRemoteEnds RemoteEndPool
x) (RemoteEndPool -> Map DriverName [RemoteEnd]
freeRemoteEnds RemoteEndPool
y)
    }

instance Monoid RemoteEndPool where
  mempty :: RemoteEndPool
mempty = RemoteEndPool :: Map DriverName [RemoteEnd] -> RemoteEndPool
RemoteEndPool
    { freeRemoteEnds :: Map DriverName [RemoteEnd]
freeRemoteEnds = [(DriverName, [RemoteEnd])] -> Map DriverName [RemoteEnd]
forall k a. Ord k => [(k, a)] -> Map k a
MS.fromList []
    }

  mappend :: RemoteEndPool -> RemoteEndPool -> RemoteEndPool
mappend = RemoteEndPool -> RemoteEndPool -> RemoteEndPool
forall a. Semigroup a => a -> a -> a
(<>)

-- | Push a remote end to the pool stack for a given driver.
addRemoteEndForDriver :: DriverName -> RemoteEnd -> RemoteEndPool -> RemoteEndPool
addRemoteEndForDriver :: DriverName -> RemoteEnd -> RemoteEndPool -> RemoteEndPool
addRemoteEndForDriver DriverName
driver RemoteEnd
remote RemoteEndPool
pool = RemoteEndPool :: Map DriverName [RemoteEnd] -> RemoteEndPool
RemoteEndPool
  { freeRemoteEnds :: Map DriverName [RemoteEnd]
freeRemoteEnds = ([RemoteEnd] -> [RemoteEnd])
-> DriverName
-> Map DriverName [RemoteEnd]
-> Map DriverName [RemoteEnd]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
MS.adjust (RemoteEnd
remoteRemoteEnd -> [RemoteEnd] -> [RemoteEnd]
forall a. a -> [a] -> [a]
:) DriverName
driver (Map DriverName [RemoteEnd] -> Map DriverName [RemoteEnd])
-> Map DriverName [RemoteEnd] -> Map DriverName [RemoteEnd]
forall a b. (a -> b) -> a -> b
$ RemoteEndPool -> Map DriverName [RemoteEnd]
freeRemoteEnds RemoteEndPool
pool
  }

-- | Attempt to pop a remote end from the pool stack for a given driver. Returns the new pool, whether or not a remote end was popped. Returns a `Just Just` if a remote end was found, a `Just Nothing` if the driver has an empty stack of remotes, and `Nothing` if the pool is undefined for the driver.
getRemoteEndForDriver :: DriverName -> RemoteEndPool -> (RemoteEndPool, Maybe (Maybe RemoteEnd))
getRemoteEndForDriver :: DriverName
-> RemoteEndPool -> (RemoteEndPool, Maybe (Maybe RemoteEnd))
getRemoteEndForDriver DriverName
driver RemoteEndPool
pool =
  case DriverName -> Map DriverName [RemoteEnd] -> Maybe [RemoteEnd]
forall k a. Ord k => k -> Map k a -> Maybe a
MS.lookup DriverName
driver (RemoteEndPool -> Map DriverName [RemoteEnd]
freeRemoteEnds RemoteEndPool
pool) of
    Maybe [RemoteEnd]
Nothing -> (RemoteEndPool
pool, Maybe (Maybe RemoteEnd)
forall a. Maybe a
Nothing)
    Just [RemoteEnd]
z -> case [RemoteEnd]
z of
      [] -> (RemoteEndPool
pool, Maybe RemoteEnd -> Maybe (Maybe RemoteEnd)
forall a. a -> Maybe a
Just Maybe RemoteEnd
forall a. Maybe a
Nothing)
      (RemoteEnd
r:[RemoteEnd]
rs) -> (RemoteEndPool
pool { freeRemoteEnds :: Map DriverName [RemoteEnd]
freeRemoteEnds = DriverName
-> [RemoteEnd]
-> Map DriverName [RemoteEnd]
-> Map DriverName [RemoteEnd]
forall k a. Ord k => k -> a -> Map k a -> Map k a
MS.insert DriverName
driver [RemoteEnd]
rs (Map DriverName [RemoteEnd] -> Map DriverName [RemoteEnd])
-> Map DriverName [RemoteEnd] -> Map DriverName [RemoteEnd]
forall a b. (a -> b) -> a -> b
$ RemoteEndPool -> Map DriverName [RemoteEnd]
freeRemoteEnds RemoteEndPool
pool }, Maybe RemoteEnd -> Maybe (Maybe RemoteEnd)
forall a. a -> Maybe a
Just (Maybe RemoteEnd -> Maybe (Maybe RemoteEnd))
-> Maybe RemoteEnd -> Maybe (Maybe RemoteEnd)
forall a b. (a -> b) -> a -> b
$ RemoteEnd -> Maybe RemoteEnd
forall a. a -> Maybe a
Just RemoteEnd
r)

-- | Representation of a remote end connection.
data RemoteEnd = RemoteEnd
  { RemoteEnd -> Text
remoteEndHost :: Text -- ^ Scheme, auth, and hostname
  , RemoteEnd -> Int
remoteEndPort :: Int
  , RemoteEnd -> Text
remoteEndPath :: Text -- ^ Additional path component
  } deriving RemoteEnd -> RemoteEnd -> Bool
(RemoteEnd -> RemoteEnd -> Bool)
-> (RemoteEnd -> RemoteEnd -> Bool) -> Eq RemoteEnd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteEnd -> RemoteEnd -> Bool
$c/= :: RemoteEnd -> RemoteEnd -> Bool
== :: RemoteEnd -> RemoteEnd -> Bool
$c== :: RemoteEnd -> RemoteEnd -> Bool
Eq

instance Show RemoteEnd where
  show :: RemoteEnd -> String
show RemoteEnd
remote = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
    [ RemoteEnd -> Text
remoteEndHost RemoteEnd
remote
    , Text
":"
    , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ RemoteEnd -> Int
remoteEndPort RemoteEnd
remote
    , RemoteEnd -> Text
remoteEndPath RemoteEnd
remote
    ]

-- | Parse a remote end config file. This file consists of 0 or more blocks of the form
--
-- > DRIVER_NAME
-- > - REMOTE_END_URI
-- > - REMOTE_END_URI
--
-- where `DRIVER_NAME` is either `geckodriver` or `chromedriver` and each `REMOTE_END_URI` is the uri of a WebDriver remote end, including scheme. Blank lines are ignored.
parseRemoteEndConfig :: Text -> Either Text RemoteEndPool
parseRemoteEndConfig :: Text -> Either Text RemoteEndPool
parseRemoteEndConfig Text
str = do
  Map DriverName [RemoteEnd]
freeEnds <- ([(DriverName, [RemoteEnd])] -> Map DriverName [RemoteEnd])
-> Either Text [(DriverName, [RemoteEnd])]
-> Either Text (Map DriverName [RemoteEnd])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([RemoteEnd] -> [RemoteEnd] -> [RemoteEnd])
-> [(DriverName, [RemoteEnd])] -> Map DriverName [RemoteEnd]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
MS.fromListWith [RemoteEnd] -> [RemoteEnd] -> [RemoteEnd]
forall a. Semigroup a => a -> a -> a
(<>)) (Either Text [(DriverName, [RemoteEnd])]
 -> Either Text (Map DriverName [RemoteEnd]))
-> Either Text [(DriverName, [RemoteEnd])]
-> Either Text (Map DriverName [RemoteEnd])
forall a b. (a -> b) -> a -> b
$ [Text] -> Either Text [(DriverName, [RemoteEnd])]
tokenizeRemoteEndConfig ([Text] -> Either Text [(DriverName, [RemoteEnd])])
-> [Text] -> Either Text [(DriverName, [RemoteEnd])]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
str
  RemoteEndPool -> Either Text RemoteEndPool
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteEndPool :: Map DriverName [RemoteEnd] -> RemoteEndPool
RemoteEndPool
    { freeRemoteEnds :: Map DriverName [RemoteEnd]
freeRemoteEnds = Map DriverName [RemoteEnd]
freeEnds
    }

tokenizeRemoteEndConfig :: [Text] -> Either Text [(DriverName, [RemoteEnd])]
tokenizeRemoteEndConfig :: [Text] -> Either Text [(DriverName, [RemoteEnd])]
tokenizeRemoteEndConfig [Text]
ls = case [Text]
ls of
  [] -> [(DriverName, [RemoteEnd])]
-> Either Text [(DriverName, [RemoteEnd])]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  (Text
first:[Text]
rest) -> do
    DriverName
driver <- case Text
first of
      Text
"geckodriver" -> DriverName -> Either Text DriverName
forall (m :: * -> *) a. Monad m => a -> m a
return DriverName
Geckodriver
      Text
"chromedriver" -> DriverName -> Either Text DriverName
forall (m :: * -> *) a. Monad m => a -> m a
return DriverName
Chromedriver
      Text
_ -> Text -> Either Text DriverName
forall a b. a -> Either a b
Left (Text -> Either Text DriverName) -> Text -> Either Text DriverName
forall a b. (a -> b) -> a -> b
$ Text
"Unrecognized driver name '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
first Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."
    let ([Text]
remotes, [Text]
remainder) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Text
"- " Text -> Text -> Bool
`T.isPrefixOf`) [Text]
rest
    [RemoteEnd]
ends <- (Text -> Either Text RemoteEnd)
-> [Text] -> Either Text [RemoteEnd]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Either Text RemoteEnd
parseRemoteEnd (Text -> Either Text RemoteEnd)
-> (Text -> Text) -> Text -> Either Text RemoteEnd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
2) [Text]
remotes
    [(DriverName, [RemoteEnd])]
config <- [Text] -> Either Text [(DriverName, [RemoteEnd])]
tokenizeRemoteEndConfig [Text]
remainder
    [(DriverName, [RemoteEnd])]
-> Either Text [(DriverName, [RemoteEnd])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(DriverName, [RemoteEnd])]
 -> Either Text [(DriverName, [RemoteEnd])])
-> [(DriverName, [RemoteEnd])]
-> Either Text [(DriverName, [RemoteEnd])]
forall a b. (a -> b) -> a -> b
$ (DriverName
driver, [RemoteEnd] -> [RemoteEnd]
forall a. Eq a => [a] -> [a]
nub [RemoteEnd]
ends) (DriverName, [RemoteEnd])
-> [(DriverName, [RemoteEnd])] -> [(DriverName, [RemoteEnd])]
forall a. a -> [a] -> [a]
: [(DriverName, [RemoteEnd])]
config

-- | Parse a remote end command line option. This option consists of 0 or more substrings of the form
--
-- > DRIVER_NAME: REMOTE_END_URI REMOTE_END_URI ...
--
-- where `DRIVER_NAME` is either `geckodriver` or `chromedriver` and each `REMOTE_END_URI` is the uri of a WebDriver remote end, including scheme.
parseRemoteEndOption :: Text -> Either Text RemoteEndPool
parseRemoteEndOption :: Text -> Either Text RemoteEndPool
parseRemoteEndOption Text
str = do
  Map DriverName [RemoteEnd]
freeEnds <- ([(DriverName, [RemoteEnd])] -> Map DriverName [RemoteEnd])
-> Either Text [(DriverName, [RemoteEnd])]
-> Either Text (Map DriverName [RemoteEnd])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([RemoteEnd] -> [RemoteEnd] -> [RemoteEnd])
-> [(DriverName, [RemoteEnd])] -> Map DriverName [RemoteEnd]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
MS.fromListWith [RemoteEnd] -> [RemoteEnd] -> [RemoteEnd]
forall a. Semigroup a => a -> a -> a
(<>)) (Either Text [(DriverName, [RemoteEnd])]
 -> Either Text (Map DriverName [RemoteEnd]))
-> Either Text [(DriverName, [RemoteEnd])]
-> Either Text (Map DriverName [RemoteEnd])
forall a b. (a -> b) -> a -> b
$ [Text] -> Either Text [(DriverName, [RemoteEnd])]
tokenizeRemoteEndOption ([Text] -> Either Text [(DriverName, [RemoteEnd])])
-> [Text] -> Either Text [(DriverName, [RemoteEnd])]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
str
  RemoteEndPool -> Either Text RemoteEndPool
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteEndPool :: Map DriverName [RemoteEnd] -> RemoteEndPool
RemoteEndPool
    { freeRemoteEnds :: Map DriverName [RemoteEnd]
freeRemoteEnds = Map DriverName [RemoteEnd]
freeEnds
    }

tokenizeRemoteEndOption :: [Text] -> Either Text [(DriverName, [RemoteEnd])]
tokenizeRemoteEndOption :: [Text] -> Either Text [(DriverName, [RemoteEnd])]
tokenizeRemoteEndOption [Text]
ws = case [Text]
ws of
  [] -> [(DriverName, [RemoteEnd])]
-> Either Text [(DriverName, [RemoteEnd])]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  (Text
first:[Text]
rest) -> do
    DriverName
driver <- case Text
first of
      Text
"geckodriver" -> DriverName -> Either Text DriverName
forall (m :: * -> *) a. Monad m => a -> m a
return DriverName
Geckodriver
      Text
"chromedriver" -> DriverName -> Either Text DriverName
forall (m :: * -> *) a. Monad m => a -> m a
return DriverName
Chromedriver
      Text
_ -> Text -> Either Text DriverName
forall a b. a -> Either a b
Left (Text -> Either Text DriverName) -> Text -> Either Text DriverName
forall a b. (a -> b) -> a -> b
$ Text
"Unrecognized driver name '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
first Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."
    let ([Text]
remotes, [Text]
remainder) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"geckodriver",Text
"chromedriver"]) [Text]
rest
    [RemoteEnd]
ends <- (Text -> Either Text RemoteEnd)
-> [Text] -> Either Text [RemoteEnd]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either Text RemoteEnd
parseRemoteEnd [Text]
remotes
    [(DriverName, [RemoteEnd])]
option <- [Text] -> Either Text [(DriverName, [RemoteEnd])]
tokenizeRemoteEndOption [Text]
remainder
    [(DriverName, [RemoteEnd])]
-> Either Text [(DriverName, [RemoteEnd])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(DriverName, [RemoteEnd])]
 -> Either Text [(DriverName, [RemoteEnd])])
-> [(DriverName, [RemoteEnd])]
-> Either Text [(DriverName, [RemoteEnd])]
forall a b. (a -> b) -> a -> b
$ (DriverName
driver, [RemoteEnd] -> [RemoteEnd]
forall a. Eq a => [a] -> [a]
nub [RemoteEnd]
ends) (DriverName, [RemoteEnd])
-> [(DriverName, [RemoteEnd])] -> [(DriverName, [RemoteEnd])]
forall a. a -> [a] -> [a]
: [(DriverName, [RemoteEnd])]
option

-- | Parse a single remote end URI. Must include the scheme (http:// or https://) even though this is redundant.
parseRemoteEnd :: Text -> Either Text RemoteEnd
parseRemoteEnd :: Text -> Either Text RemoteEnd
parseRemoteEnd Text
str = case String -> Maybe URI
parseURI (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str of
  Maybe URI
Nothing -> Text -> Either Text RemoteEnd
forall a b. a -> Either a b
Left (Text -> Either Text RemoteEnd) -> Text -> Either Text RemoteEnd
forall a b. (a -> b) -> a -> b
$ Text
"Could not parse remote end URI '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."
  Just URI{String
Maybe URIAuth
uriScheme :: URI -> String
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> String
uriQuery :: URI -> String
uriFragment :: URI -> String
uriFragment :: String
uriQuery :: String
uriPath :: String
uriAuthority :: Maybe URIAuth
uriScheme :: String
..} -> case Maybe URIAuth
uriAuthority of
    Maybe URIAuth
Nothing -> Text -> Either Text RemoteEnd
forall a b. a -> Either a b
Left (Text -> Either Text RemoteEnd) -> Text -> Either Text RemoteEnd
forall a b. (a -> b) -> a -> b
$ Text
"Error parsing authority for URI '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."
    Just URIAuth{String
uriUserInfo :: URIAuth -> String
uriRegName :: URIAuth -> String
uriPort :: URIAuth -> String
uriPort :: String
uriRegName :: String
uriUserInfo :: String
..} -> case String
uriPort of
      String
"" -> RemoteEnd -> Either Text RemoteEnd
forall a b. b -> Either a b
Right RemoteEnd :: Text -> Int -> Text -> RemoteEnd
RemoteEnd
        { remoteEndHost :: Text
remoteEndHost = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
uriUserInfo String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
uriRegName
        , remoteEndPort :: Int
remoteEndPort = Int
4444
        , remoteEndPath :: Text
remoteEndPath = String -> Text
T.pack String
uriPath
        }
      Char
':' : String
ds -> case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ds of
        Maybe Int
Nothing -> Text -> Either Text RemoteEnd
forall a b. a -> Either a b
Left (Text -> Either Text RemoteEnd) -> Text -> Either Text RemoteEnd
forall a b. (a -> b) -> a -> b
$ Text
"Error parsing port for URI '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."
        Just Int
k -> RemoteEnd -> Either Text RemoteEnd
forall a b. b -> Either a b
Right RemoteEnd :: Text -> Int -> Text -> RemoteEnd
RemoteEnd
          { remoteEndHost :: Text
remoteEndHost = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
uriUserInfo String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
uriRegName
          , remoteEndPort :: Int
remoteEndPort = Int
k
          , remoteEndPath :: Text
remoteEndPath = String -> Text
T.pack String
uriPath
          }
      String
_ -> Text -> Either Text RemoteEnd
forall a b. a -> Either a b
Left (Text -> Either Text RemoteEnd) -> Text -> Either Text RemoteEnd
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected port '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
uriPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' in URI '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."


-- | Helper function for parsing command line options with a required argument. Assumes long-form option names starting with a hyphen. Note the return type; @Just Nothing@ indicates that the option was not present, while @Nothing@ indicates that the option was present but its required argument was not.
parseOptionWithArgument
  :: Text -- ^ Option to parse for, including hyphen(s).
  -> [Text] -- ^ List of command line arguments.
  -> Maybe (Maybe Text)
parseOptionWithArgument :: Text -> [Text] -> Maybe (Maybe Text)
parseOptionWithArgument Text
option [Text]
args = case [Text]
args of
  (Text
opt:Text
arg:[Text]
rest) -> if Text
opt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
option
    then case Text -> Maybe (Char, Text)
T.uncons Text
arg of
      Just (Char
c,Text
cs) -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then Maybe (Maybe Text)
forall a. Maybe a
Nothing else Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
arg)
      Maybe (Char, Text)
Nothing -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
arg)
    else Text -> [Text] -> Maybe (Maybe Text)
parseOptionWithArgument Text
option (Text
argText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
rest)
  [Text]
_ -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing