{-# options_haddock prune #-}

-- |CLI, Internal
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."