{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE UndecidableInstances #-}

module Mensam.Client.Application.Options where

import Mensam.Client.Application.Options.Class

import Control.Monad.Trans
import Control.Monad.Trans.Compose
import Control.Monad.Trans.Control
import Control.Monad.Trans.Control.Identity
import Control.Monad.Trans.Reader
import Data.Foldable
import Data.Kind
import Options.Applicative
import Servant.Client

type OptionsT :: (Type -> Type) -> Type -> Type
newtype OptionsT m a = MkOptionsT {forall (m :: * -> *) a. OptionsT m a -> ReaderT Options m a
unOptionsT :: ReaderT Options m a}
  deriving newtype (Functor (OptionsT m)
Functor (OptionsT m) =>
(forall a. a -> OptionsT m a)
-> (forall a b.
    OptionsT m (a -> b) -> OptionsT m a -> OptionsT m b)
-> (forall a b c.
    (a -> b -> c) -> OptionsT m a -> OptionsT m b -> OptionsT m c)
-> (forall a b. OptionsT m a -> OptionsT m b -> OptionsT m b)
-> (forall a b. OptionsT m a -> OptionsT m b -> OptionsT m a)
-> Applicative (OptionsT m)
forall a. a -> OptionsT m a
forall a b. OptionsT m a -> OptionsT m b -> OptionsT m a
forall a b. OptionsT m a -> OptionsT m b -> OptionsT m b
forall a b. OptionsT m (a -> b) -> OptionsT m a -> OptionsT m b
forall a b c.
(a -> b -> c) -> OptionsT m a -> OptionsT m b -> OptionsT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (OptionsT m)
forall (m :: * -> *) a. Applicative m => a -> OptionsT m a
forall (m :: * -> *) a b.
Applicative m =>
OptionsT m a -> OptionsT m b -> OptionsT m a
forall (m :: * -> *) a b.
Applicative m =>
OptionsT m a -> OptionsT m b -> OptionsT m b
forall (m :: * -> *) a b.
Applicative m =>
OptionsT m (a -> b) -> OptionsT m a -> OptionsT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OptionsT m a -> OptionsT m b -> OptionsT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> OptionsT m a
pure :: forall a. a -> OptionsT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
OptionsT m (a -> b) -> OptionsT m a -> OptionsT m b
<*> :: forall a b. OptionsT m (a -> b) -> OptionsT m a -> OptionsT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OptionsT m a -> OptionsT m b -> OptionsT m c
liftA2 :: forall a b c.
(a -> b -> c) -> OptionsT m a -> OptionsT m b -> OptionsT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
OptionsT m a -> OptionsT m b -> OptionsT m b
*> :: forall a b. OptionsT m a -> OptionsT m b -> OptionsT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
OptionsT m a -> OptionsT m b -> OptionsT m a
<* :: forall a b. OptionsT m a -> OptionsT m b -> OptionsT m a
Applicative, (forall a b. (a -> b) -> OptionsT m a -> OptionsT m b)
-> (forall a b. a -> OptionsT m b -> OptionsT m a)
-> Functor (OptionsT m)
forall a b. a -> OptionsT m b -> OptionsT m a
forall a b. (a -> b) -> OptionsT m a -> OptionsT m b
forall (m :: * -> *) a b.
Functor m =>
a -> OptionsT m b -> OptionsT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OptionsT m a -> OptionsT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OptionsT m a -> OptionsT m b
fmap :: forall a b. (a -> b) -> OptionsT m a -> OptionsT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> OptionsT m b -> OptionsT m a
<$ :: forall a b. a -> OptionsT m b -> OptionsT m a
Functor, Applicative (OptionsT m)
Applicative (OptionsT m) =>
(forall a b. OptionsT m a -> (a -> OptionsT m b) -> OptionsT m b)
-> (forall a b. OptionsT m a -> OptionsT m b -> OptionsT m b)
-> (forall a. a -> OptionsT m a)
-> Monad (OptionsT m)
forall a. a -> OptionsT m a
forall a b. OptionsT m a -> OptionsT m b -> OptionsT m b
forall a b. OptionsT m a -> (a -> OptionsT m b) -> OptionsT m b
forall (m :: * -> *). Monad m => Applicative (OptionsT m)
forall (m :: * -> *) a. Monad m => a -> OptionsT m a
forall (m :: * -> *) a b.
Monad m =>
OptionsT m a -> OptionsT m b -> OptionsT m b
forall (m :: * -> *) a b.
Monad m =>
OptionsT m a -> (a -> OptionsT m b) -> OptionsT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
OptionsT m a -> (a -> OptionsT m b) -> OptionsT m b
>>= :: forall a b. OptionsT m a -> (a -> OptionsT m b) -> OptionsT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
OptionsT m a -> OptionsT m b -> OptionsT m b
>> :: forall a b. OptionsT m a -> OptionsT m b -> OptionsT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> OptionsT m a
return :: forall a. a -> OptionsT m a
Monad)
  deriving newtype ((forall (m :: * -> *). Monad m => Monad (OptionsT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> OptionsT m a)
-> MonadTrans OptionsT
forall (m :: * -> *). Monad m => Monad (OptionsT m)
forall (m :: * -> *) a. Monad m => m a -> OptionsT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> OptionsT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> OptionsT m a
MonadTrans, MonadTrans OptionsT
MonadTrans OptionsT =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run OptionsT -> m a) -> OptionsT m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT OptionsT a) -> OptionsT m a)
-> MonadTransControl OptionsT
forall (m :: * -> *) a.
Monad m =>
m (StT OptionsT a) -> OptionsT m a
forall (m :: * -> *) a.
Monad m =>
(Run OptionsT -> m a) -> OptionsT m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run OptionsT -> m a) -> OptionsT m a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run OptionsT -> m a) -> OptionsT m a
$crestoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT OptionsT a) -> OptionsT m a
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT OptionsT a) -> OptionsT m a
MonadTransControl, MonadTransControl OptionsT
MonadTransControl OptionsT =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. OptionsT m x -> m x) -> m a) -> OptionsT m a)
-> MonadTransControlIdentity OptionsT
forall (m :: * -> *) a.
Monad m =>
((forall x. OptionsT m x -> m x) -> m a) -> OptionsT m a
forall (t :: (* -> *) -> * -> *).
MonadTransControl t =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. t m x -> m x) -> m a) -> t m a)
-> MonadTransControlIdentity t
$cliftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. OptionsT m x -> m x) -> m a) -> OptionsT m a
liftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. OptionsT m x -> m x) -> m a) -> OptionsT m a
MonadTransControlIdentity)

instance Monad m => MonadOptions (OptionsT m) where
  options :: OptionsT m Options
options = ReaderT Options m Options -> OptionsT m Options
forall (m :: * -> *) a. ReaderT Options m a -> OptionsT m a
MkOptionsT ReaderT Options m Options
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

deriving via
  OptionsT ((t2 :: (Type -> Type) -> Type -> Type) m)
  instance
    Monad (t2 m) => MonadOptions (ComposeT OptionsT t2 m)

runOptionsT :: OptionsT m a -> Options -> m a
runOptionsT :: forall (m :: * -> *) a. OptionsT m a -> Options -> m a
runOptionsT = ReaderT Options m a -> Options -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT Options m a -> Options -> m a)
-> (OptionsT m a -> ReaderT Options m a)
-> OptionsT m a
-> Options
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionsT m a -> ReaderT Options m a
forall (m :: * -> *) a. OptionsT m a -> ReaderT Options m a
unOptionsT

runAppOptionsT ::
  MonadIO m =>
  OptionsT m a ->
  m a
runAppOptionsT :: forall (m :: * -> *) a. MonadIO m => OptionsT m a -> m a
runAppOptionsT OptionsT m a
tma = do
  Options
parsedOptions <- IO Options -> m Options
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Options -> m Options) -> IO Options -> m Options
forall a b. (a -> b) -> a -> b
$ ParserInfo Options -> IO Options
forall a. ParserInfo a -> IO a
execParser ParserInfo Options
parserInfoOptions
  OptionsT m a -> Options -> m a
forall (m :: * -> *) a. OptionsT m a -> Options -> m a
runOptionsT OptionsT m a
tma Options
parsedOptions

parserInfoOptions :: ParserInfo Options
parserInfoOptions :: ParserInfo Options
parserInfoOptions = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Options
parserOptions InfoMod Options
forall a. InfoMod a
fullDesc

parserOptions :: Parser Options
parserOptions :: Parser Options
parserOptions = do
  BaseUrl
optionBaseUrl <-
    ReadM BaseUrl -> Mod OptionFields BaseUrl -> Parser BaseUrl
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM BaseUrl
readBaseUrl (Mod OptionFields BaseUrl -> Parser BaseUrl)
-> Mod OptionFields BaseUrl -> Parser BaseUrl
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields BaseUrl] -> Mod OptionFields BaseUrl
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ [Char] -> Mod OptionFields BaseUrl
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"base-url"
        , [Char] -> Mod OptionFields BaseUrl
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Base URL to connect to a Mensam server instance"
        ]
  pure
    MkOptions
      { BaseUrl
optionBaseUrl :: BaseUrl
optionBaseUrl :: BaseUrl
optionBaseUrl
      }

readBaseUrl :: ReadM BaseUrl
readBaseUrl :: ReadM BaseUrl
readBaseUrl = ([Char] -> Either [Char] BaseUrl) -> ReadM BaseUrl
forall a. ([Char] -> Either [Char] a) -> ReadM a
eitherReader (([Char] -> Either [Char] BaseUrl) -> ReadM BaseUrl)
-> ([Char] -> Either [Char] BaseUrl) -> ReadM BaseUrl
forall a b. (a -> b) -> a -> b
$ \[Char]
string ->
  case [Char] -> Either SomeException BaseUrl
forall (m :: * -> *). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl [Char]
string of
    Left SomeException
err -> [Char] -> Either [Char] BaseUrl
forall a b. a -> Either a b
Left ([Char] -> Either [Char] BaseUrl)
-> [Char] -> Either [Char] BaseUrl
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to parse base URL: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
err
    Right BaseUrl
baseUrl -> BaseUrl -> Either [Char] BaseUrl
forall a b. b -> Either a b
Right BaseUrl
baseUrl