module Engine.Types.Options
  ( Options(..)
  , getOptions
  , optionsP
  ) where

import RIO

import Options.Applicative.Simple qualified as Opt

import Paths_keid_core qualified

-- | Command line arguments
data Options = Options
  { Options -> Bool
optionsVerbose      :: Bool
  , Options -> Bool
optionsFullscreen   :: Bool
  , Options -> Natural
optionsDisplay      :: Natural
  , Options -> Maybe Int
optionsRecyclerWait :: Maybe Int
  }
  deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

getOptions :: IO Options
getOptions :: IO Options
getOptions = do
  (Options
options, ()) <- String
-> String
-> String
-> Parser Options
-> ExceptT () (Writer (Mod CommandFields ())) ()
-> IO (Options, ())
forall a b.
String
-> String
-> String
-> Parser a
-> ExceptT b (Writer (Mod CommandFields b)) ()
-> IO (a, b)
Opt.simpleOptions
    $(Opt.simpleVersion Paths_keid_core.version)
    String
header
    String
description
    Parser Options
optionsP
    ExceptT () (Writer (Mod CommandFields ())) ()
forall (f :: * -> *) a. Alternative f => f a
Opt.empty
  Options -> IO Options
forall (f :: * -> *) a. Applicative f => a -> f a
pure Options
options
  where
    header :: String
header =
      String
"Another playground"

    description :: String
description =
      String
forall a. Monoid a => a
mempty

optionsP :: Opt.Parser Options
optionsP :: Parser Options
optionsP = do
  Bool
optionsVerbose <- Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"verbose"
    , Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'v'
    , String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Show more and more detailed messages"
    ]

  Bool
optionsFullscreen <- Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"fullscreen"
    , Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'f'
    , String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Run in fullscreen mode"
    ]

  Natural
optionsDisplay <- ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
    [ String -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"display"
    , String -> Mod OptionFields Natural
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Select display number"
    , Natural -> Mod OptionFields Natural
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Natural
0
    ]

  Maybe Int
optionsRecyclerWait <- Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Int -> Parser (Maybe Int))
-> (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto (Mod OptionFields Int -> Parser (Maybe Int))
-> Mod OptionFields Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
    [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"recycler-wait"
    , String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Inject a delay before waiting for a timeline semaphore."
    ]

  pure Options :: Bool -> Bool -> Natural -> Maybe Int -> Options
Options{Bool
Natural
Maybe Int
optionsRecyclerWait :: Maybe Int
optionsDisplay :: Natural
optionsFullscreen :: Bool
optionsVerbose :: Bool
$sel:optionsRecyclerWait:Options :: Maybe Int
$sel:optionsDisplay:Options :: Natural
$sel:optionsFullscreen:Options :: Bool
$sel:optionsVerbose:Options :: Bool
..}