{-# options_haddock prune #-}
module Helic.Cli where
import qualified Conc
import Options.Applicative (customExecParser, fullDesc, header, helper, info, prefs, showHelpOnEmpty, showHelpOnError)
import Polysemy.Log (Severity (Info, Trace))
import System.IO (hLookAhead, stdin)
import Time (MilliSeconds (MilliSeconds))
import Helic.App (listApp, listenApp, loadApp, yankApp)
import Helic.Cli.Options (Command (List, Listen, Load, Yank), Conf (Conf), parser)
import Helic.Config.File (findFileConfig)
import qualified Helic.Data.Config as Config
import Helic.Data.Config (Config)
import Helic.Data.YankConfig (YankConfig (YankConfig))
runCommand :: Config -> Command -> Sem AppStack ()
runCommand :: Config -> Command -> Sem AppStack ()
runCommand Config
config = \case
Command
Listen ->
Config -> Sem AppStack ()
listenApp Config
config
Yank YankConfig
yankConf ->
Config -> YankConfig -> Sem AppStack ()
yankApp Config
config YankConfig
yankConf
List ListConfig
showConf ->
Config -> ListConfig -> Sem AppStack ()
listApp Config
config ListConfig
showConf
Load LoadConfig
loadConf ->
Config -> LoadConfig -> Sem AppStack ()
loadApp Config
config LoadConfig
loadConf
defaultCommand :: Sem AppStack Command
defaultCommand :: Sem AppStack Command
defaultCommand = do
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
Sem r a -> u -> Sem r a -> Sem r a
Conc.timeout_ (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (Int64 -> MilliSeconds
MilliSeconds Int64
100) (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (Handle -> IO Char
hLookAhead Handle
stdin)) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Just (Right Char
_) -> YankConfig -> Command
Yank (Maybe Text -> Maybe Text -> YankConfig
YankConfig (forall a. a -> Maybe a
Just Text
"cli") forall a. Maybe a
Nothing)
Maybe (Either Text Char)
_ -> Command
Listen
withCliOptions :: Conf -> Maybe Command -> IO ()
withCliOptions :: Conf -> Maybe Command -> IO ()
withCliOptions (Conf Maybe Bool
cliVerbose Maybe (Path Abs File)
file) Maybe Command
cmd = do
Config
config <- forall {a}.
Maybe Bool
-> Sem
'[Time Time Date, Log, Interrupt, Critical, Error Text,
UninterruptibleMask, UninterruptibleMask, Gates, Race, Async,
Resource, Embed IO, Final IO]
a
-> IO a
runLevel Maybe Bool
cliVerbose (forall (r :: EffectRow).
Members '[Log, Error Text, Embed IO] r =>
Maybe (Path Abs File) -> Sem r Config
findFileConfig Maybe (Path Abs File)
file)
forall {a}.
Maybe Bool
-> Sem
'[Time Time Date, Log, Interrupt, Critical, Error Text,
UninterruptibleMask, UninterruptibleMask, Gates, Race, Async,
Resource, Embed IO, Final IO]
a
-> IO a
runLevel (Maybe Bool
cliVerbose forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config
config.verbose) do
Command
cmd' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sem AppStack Command
defaultCommand forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Command
cmd
Config -> Command -> Sem AppStack ()
runCommand Config
config Command
cmd'
where
runLevel :: Maybe Bool -> Sem AppStack a -> IO a
runLevel Maybe Bool
l = forall a. Severity -> Sem AppStack a -> IO a
runAppLevel (Maybe Bool -> Severity
level Maybe Bool
l)
level :: Maybe Bool -> Severity
level = \case
Just Bool
True -> Severity
Trace
Maybe Bool
_ -> Severity
Info
app :: IO ()
app :: IO ()
app = do
(Conf
conf, Maybe Command
cmd) <- forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
parserPrefs (forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Conf, Maybe Command)
parser forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper) forall {a}. InfoMod a
desc)
Conf -> Maybe Command -> IO ()
withCliOptions Conf
conf Maybe Command
cmd
where
parserPrefs :: ParserPrefs
parserPrefs =
PrefsMod -> ParserPrefs
prefs (PrefsMod
showHelpOnEmpty forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnError)
desc :: InfoMod a
desc =
forall {a}. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Helic is a clipboard synchronization tool."