{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides functionality for parsing command-line arguments.
module Navi.Args
  ( Args (..),
    getArgs,
  )
where

import Control.Applicative qualified as A
import Data.Functor.Classes (Show1 (..))
import Data.Functor.Classes qualified as Functor
import Data.Functor.Identity (Identity (..))
import Data.List qualified as L
import Data.Version.Package qualified as PV
import Development.GitRev qualified as GitRev
import Effects.FileSystem.PathReader qualified as Dir
import Navi.Prelude
import Options.Applicative (Parser, ParserInfo (..))
import Options.Applicative qualified as OptApp
import Options.Applicative.Help.Chunk (Chunk (..))
import Options.Applicative.Types (ArgPolicy (..))

-- | Represents command-line arguments. We use the \"higher-kinded data\"
-- approach for:
--
-- 1. Parsing optional arguments (@'Args' 'Maybe'@).
-- 2. Filling missing arguments with defaults (@'Args' 'Identity'@).
newtype Args f = MkArgs
  { -- | Path to the configuration file.
    forall (f :: Type -> Type). Args f -> f String
configFile :: f Path
  }

makeFieldLabelsNoPrefix ''Args

instance (Show1 f) => Show (Args f) where
  show :: Args f -> String
show MkArgs {f String
configFile :: f String
$sel:configFile:MkArgs :: forall (f :: Type -> Type). Args f -> f String
configFile} =
    String
"MkArgs "
      forall a. Semigroup a => a -> a -> a
<> forall (f :: Type -> Type) a.
(Show1 f, Show a) =>
Int -> f a -> ShowS
Functor.showsPrec1 Int
9 f String
configFile String
" "
  {-# INLINEABLE show #-}

-- | Parses cli args and fills in defaults. These defaults are based on the
-- detected XDG Base Directory and default names.
getArgs :: MonadIO m => m (Args Identity)
getArgs :: forall (m :: Type -> Type). MonadIO m => m (Args Identity)
getArgs = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Args Maybe
args <- forall a. ParserInfo a -> IO a
OptApp.execParser ParserInfo (Args Maybe)
parserInfoArgs
  Args Maybe -> IO (Args Identity)
fillMissingDefaults Args Maybe
args
{-# INLINEABLE getArgs #-}

fillMissingDefaults :: Args Maybe -> IO (Args Identity)
fillMissingDefaults :: Args Maybe -> IO (Args Identity)
fillMissingDefaults Args Maybe
args = do
  String
configFile' <- case Maybe String
configFile of
    -- No custom paths provided, use default
    Maybe String
Nothing -> do
      String
xdgBase <- IO String
defaultXdg
      pure (String
xdgBase String -> ShowS
</> String
defConfigName)
    -- Custom config provided, override
    Just String
customFile -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure String
customFile
  pure $
    MkArgs
      { $sel:configFile:MkArgs :: Identity String
configFile = forall a. a -> Identity a
Identity String
configFile'
      }
  where
    configFile :: Maybe String
configFile = Args Maybe
args forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "configFile" a => a
#configFile
    defaultXdg :: IO String
defaultXdg = forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
String -> m String
Dir.getXdgConfig String
"navi/"
    defConfigName :: String
defConfigName = String
"config.toml"
{-# INLINEABLE fillMissingDefaults #-}

-- | 'ParserInfo' type for parsing 'Args'.
parserInfoArgs :: ParserInfo (Args Maybe)
parserInfoArgs :: ParserInfo (Args Maybe)
parserInfoArgs =
  ParserInfo
    { infoParser :: Parser (Args Maybe)
infoParser = Parser (Args Maybe)
argsParser,
      infoFullDesc :: Bool
infoFullDesc = Bool
True,
      infoProgDesc :: Chunk Doc
infoProgDesc = forall a. Maybe a -> Chunk a
Chunk Maybe Doc
desc,
      infoHeader :: Chunk Doc
infoHeader = forall a. Maybe a -> Chunk a
Chunk Maybe Doc
header,
      infoFooter :: Chunk Doc
infoFooter = forall a. Maybe a -> Chunk a
Chunk Maybe Doc
footer,
      infoFailureCode :: Int
infoFailureCode = Int
1,
      infoPolicy :: ArgPolicy
infoPolicy = ArgPolicy
Intersperse
    }
  where
    header :: Maybe Doc
header =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        Doc
"Navi: A program for monitoring system status via "
          forall a. Semigroup a => a -> a -> a
<> Doc
"desktop notifications."
    footer :: Maybe Doc
footer = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
versNum
    desc :: Maybe Doc
desc =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        Doc
"\nNavi allows one to easily define custom notification 'services'"
          forall a. Semigroup a => a -> a -> a
<> Doc
" that hook into a running notification server. For example, one"
          forall a. Semigroup a => a -> a -> a
<> Doc
" can provide a bash script that, say, queries the connection"
          forall a. Semigroup a => a -> a -> a
<> Doc
" status of a given network device. Navi will periodically run"
          forall a. Semigroup a => a -> a -> a
<> Doc
" this query and send a desktop notification if the status has"
          forall a. Semigroup a => a -> a -> a
<> Doc
" changed. See github.com/tbidne/navi#README for full"
          forall a. Semigroup a => a -> a -> a
<> Doc
" documentation."
{-# INLINEABLE parserInfoArgs #-}

argsParser :: Parser (Args Maybe)
argsParser :: Parser (Args Maybe)
argsParser =
  forall (f :: Type -> Type). f String -> Args f
MkArgs
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe String)
configFileParser
    forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
OptApp.helper
    forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
version
{-# INLINEABLE argsParser #-}

version :: Parser (a -> a)
version :: forall a. Parser (a -> a)
version = forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
OptApp.infoOption String
txt (forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OptApp.long String
"version" forall a. Semigroup a => a -> a -> a
<> forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OptApp.short Char
'v')
  where
    txt :: String
txt =
      forall a. [a] -> [[a]] -> [a]
L.intercalate
        String
"\n"
        [ String
"Navi",
          String
versNum,
          String
"Revision: " forall a. Semigroup a => a -> a -> a
<> $(GitRev.gitHash),
          String
"Date: " forall a. Semigroup a => a -> a -> a
<> $(GitRev.gitCommitDate)
        ]
{-# INLINEABLE version #-}

versNum :: [Char]
versNum :: String
versNum = String
"Version: " forall a. Semigroup a => a -> a -> a
<> $$(PV.packageVersionStringTH "navi.cabal")
{-# INLINEABLE versNum #-}

configFileParser :: Parser (Maybe String)
configFileParser :: Parser (Maybe String)
configFileParser =
  forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
A.optional
    ( forall s. IsString s => Mod OptionFields s -> Parser s
OptApp.strOption
        ( forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OptApp.long String
"config-file"
            forall a. Semigroup a => a -> a -> a
<> forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OptApp.short Char
'f'
            forall a. Semigroup a => a -> a -> a
<> forall (f :: Type -> Type) a. String -> Mod f a
OptApp.help String
helpTxt
            forall a. Semigroup a => a -> a -> a
<> forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OptApp.metavar String
"PATH"
        )
    )
  where
    helpTxt :: String
helpTxt =
      String
"Path to config file. Defaults to <xdgConfig>/navi/config.toml."
{-# INLINEABLE configFileParser #-}