{-# LANGUAGE QuasiQuotes #-}
{-# 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 (Identity))
import Data.List qualified as L
import Data.Version (showVersion)
import Effects.FileSystem.PathReader qualified as Dir
import Effects.Optparse (execParser, osPath)
import FileSystem.OsString (OsString)
import FileSystem.OsString qualified as OsString
import Navi.Args.TH qualified as TH
import Navi.Prelude
import Options.Applicative (Parser, ParserInfo (ParserInfo))
import Options.Applicative qualified as OptApp
import Options.Applicative.Help.Chunk (Chunk (Chunk))
import Options.Applicative.Help.Chunk qualified as Chunk
import Options.Applicative.Help.Pretty qualified as Pretty
import Options.Applicative.Types (ArgPolicy (Intersperse))
import Paths_navi qualified as Paths
import System.Info qualified as Info

data VersionInfo = MkVersionInfo
  { VersionInfo -> OsPath
gitCommitDate :: OsString,
    VersionInfo -> String
ghc :: String,
    VersionInfo -> OsPath
gitHash :: OsString,
    VersionInfo -> OsPath
gitShortHash :: OsString
  }

makeFieldLabelsNoPrefix ''VersionInfo

-- | 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 OsPath
configFile :: f OsPath
  }

makeFieldLabelsNoPrefix ''Args

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

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

fillMissingDefaults ::
  ( HasCallStack,
    MonadPathReader m
  ) =>
  Args Maybe -> m (Args Identity)
fillMissingDefaults :: forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
Args Maybe -> m (Args Identity)
fillMissingDefaults Args Maybe
args = do
  OsPath
configFile' <- case Maybe OsPath
configFile of
    -- No custom paths provided, use default
    Maybe OsPath
Nothing -> do
      OsPath
xdgBase <- OsPath -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
Dir.getXdgConfig [osp|navi|]
      let defConfigName :: OsPath
defConfigName = [osp|config.toml|]
      pure (OsPath
xdgBase OsPath -> OsPath -> OsPath
</> OsPath
defConfigName)
    -- Custom config provided, override
    Just OsPath
customFile -> OsPath -> m OsPath
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OsPath
customFile
  pure
    $ MkArgs
      { configFile :: Identity OsPath
configFile = OsPath -> Identity OsPath
forall a. a -> Identity a
Identity OsPath
configFile'
      }
  where
    configFile :: Maybe OsPath
configFile = Args Maybe
args Args Maybe
-> Optic' An_Iso NoIx (Args Maybe) (Maybe OsPath) -> Maybe OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx (Args Maybe) (Maybe OsPath)
#configFile

-- | '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 = Chunk Doc
desc,
      infoHeader :: Chunk Doc
infoHeader = Maybe Doc -> Chunk Doc
forall a. Maybe a -> Chunk a
Chunk Maybe Doc
header,
      infoFooter :: Chunk Doc
infoFooter = Maybe Doc -> Chunk Doc
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 =
      Doc -> Maybe Doc
forall a. a -> Maybe a
Just
        (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Navi: A program for monitoring system status via "
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"desktop notifications."
    footer :: Maybe Doc
footer = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
forall a. IsString a => String -> a
fromString String
versShort
    desc :: Chunk Doc
desc =
      String -> Chunk Doc
Chunk.paragraph
        (String -> Chunk Doc) -> String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ String
"Navi allows one to easily define custom notification 'services'"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" that hook into a running notification server. For example, one"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" can provide a bash script that, say, queries the connection"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" status of a given network device. Navi will periodically run"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" this query and send a desktop notification if the status has"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" changed. See github.com/tbidne/navi#README for full"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" documentation."

argsParser :: Parser (Args Maybe)
argsParser :: Parser (Args Maybe)
argsParser =
  Maybe OsPath -> Args Maybe
forall (f :: Type -> Type). f OsPath -> Args f
MkArgs
    (Maybe OsPath -> Args Maybe)
-> Parser (Maybe OsPath) -> Parser (Args Maybe)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe OsPath)
configFileParser
    Parser (Args Maybe)
-> Parser (Args Maybe -> Args Maybe) -> Parser (Args Maybe)
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser (Args Maybe -> Args Maybe)
forall a. Parser (a -> a)
defaultConfig
    Parser (Args Maybe)
-> Parser (Args Maybe -> Args Maybe) -> Parser (Args Maybe)
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser (Args Maybe -> Args Maybe)
forall a. Parser (a -> a)
OptApp.helper
    Parser (Args Maybe)
-> Parser (Args Maybe -> Args Maybe) -> Parser (Args Maybe)
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser (Args Maybe -> Args Maybe)
forall a. Parser (a -> a)
version

defaultConfig :: Parser (a -> a)
defaultConfig :: forall a. Parser (a -> a)
defaultConfig =
  String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
OptApp.infoOption
    (Text -> String
unpackText $$Addr#
Int#
Addr# -> Int -> Text
Int# -> Int
TH.defaultToml)
    (String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OptApp.long String
"default-config" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. String -> Mod f a
mkHelp String
help)
  where
    help :: String
help = String
"Writes a default config.toml file to stdout."

version :: Parser (a -> a)
version :: forall a. Parser (a -> a)
version = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
OptApp.infoOption String
versLong (String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OptApp.long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OptApp.short Char
'v')

versShort :: String
versShort :: String
versShort =
  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
"Version: ",
      Version -> String
showVersion Version
Paths.version,
      String
" (",
      OsPath -> String
OsString.decodeLenient (OsPath -> String) -> OsPath -> String
forall a b. (a -> b) -> a -> b
$ VersionInfo
versionInfo VersionInfo -> Optic' A_Lens NoIx VersionInfo OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx VersionInfo OsPath
#gitShortHash,
      String
")"
    ]

versLong :: String
versLong :: String
versLong =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate
    String
"\n"
    [ String
"Navi: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
Paths.version,
      String
" - Git revision: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> OsPath -> String
OsString.decodeLenient (VersionInfo
versionInfo VersionInfo -> Optic' A_Lens NoIx VersionInfo OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx VersionInfo OsPath
#gitHash),
      String
" - Commit date:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> OsPath -> String
OsString.decodeLenient (VersionInfo
versionInfo VersionInfo -> Optic' A_Lens NoIx VersionInfo OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx VersionInfo OsPath
#gitCommitDate),
      String
" - GHC version:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> VersionInfo
versionInfo VersionInfo -> Optic' A_Lens NoIx VersionInfo String -> String
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx VersionInfo String
#ghc
    ]

versionInfo :: VersionInfo
versionInfo :: VersionInfo
versionInfo =
  MkVersionInfo
    { gitCommitDate :: OsPath
gitCommitDate = OsPath
d,
      ghc :: String
ghc = Version -> String
showVersion Version
Info.compilerVersion,
      gitHash :: OsPath
gitHash = OsPath
h,
      gitShortHash :: OsPath
gitShortHash = OsPath
sh
    }
  where
    (OsPath
d, OsPath
h, OsPath
sh) = $$Addr#
Int
Int -> Addr# -> ByteArray
ByteArray -> ShortByteString
ShortByteString -> PosixString
PosixString -> OsPath
TH.gitData

configFileParser :: Parser (Maybe OsPath)
configFileParser :: Parser (Maybe OsPath)
configFileParser =
  Parser OsPath -> Parser (Maybe OsPath)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
A.optional
    ( ReadM OsPath -> Mod OptionFields OsPath -> Parser OsPath
forall a. ReadM a -> Mod OptionFields a -> Parser a
OptApp.option
        ReadM OsPath
osPath
        ( String -> Mod OptionFields OsPath
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OptApp.long String
"config-file"
            Mod OptionFields OsPath
-> Mod OptionFields OsPath -> Mod OptionFields OsPath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields OsPath
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OptApp.short Char
'c'
            Mod OptionFields OsPath
-> Mod OptionFields OsPath -> Mod OptionFields OsPath
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OsPath
forall (f :: Type -> Type) a. String -> Mod f a
mkHelp String
helpTxt
            Mod OptionFields OsPath
-> Mod OptionFields OsPath -> Mod OptionFields OsPath
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OsPath
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 <xdg-config>/navi/config.toml."

mkHelp :: String -> OptApp.Mod f a
mkHelp :: forall (f :: Type -> Type) a. String -> Mod f a
mkHelp =
  Maybe Doc -> Mod f a
forall (f :: Type -> Type) a. Maybe Doc -> Mod f a
OptApp.helpDoc
    (Maybe Doc -> Mod f a)
-> (String -> Maybe Doc) -> String -> Mod f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Doc -> Doc) -> Maybe Doc -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
Pretty.hardline)
    (Maybe Doc -> Maybe Doc)
-> (String -> Maybe Doc) -> String -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chunk Doc -> Maybe Doc
forall a. Chunk a -> Maybe a
Chunk.unChunk
    (Chunk Doc -> Maybe Doc)
-> (String -> Chunk Doc) -> String -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Chunk Doc
Chunk.paragraph