{- |
Module:      PFile.CLI.List
Copyright:   (c) 2024 Illia Shkroba
License:     BSD3
Maintainer:  Illia Shkroba <is@pjwstk.edu.pl>
Stability:   unstable
Portability: non-portable (Non-Unix systems are not supported)

Options for `pfile ls`.
-}

{-# LANGUAGE ApplicativeDo   #-}
{-# LANGUAGE RecordWildCards #-}

module PFile.CLI.List
  ( parserInfo
  , parser
  , Options (..)
  ) where

import           Options.Applicative
  ( Parser
  , ParserInfo
  , fullDesc
  , header
  , help
  , helper
  , info
  , long
  , progDesc
  , short
  , switch
  )
import           Protolude

parserInfo :: ParserInfo Options
parserInfo :: ParserInfo Options
parserInfo = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Options
parser Parser Options -> Parser (Options -> Options) -> Parser Options
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Options -> Options)
forall a. Parser (a -> a)
helper)
  (InfoMod Options -> ParserInfo Options)
-> InfoMod Options -> ParserInfo Options
forall a b. (a -> b) -> a -> b
$  InfoMod Options
forall a. InfoMod a
fullDesc
  InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Options
forall a. String -> InfoMod a
header String
"pfile ls - list available profiles"
  InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Options
forall a. String -> InfoMod a
progDesc String
description
  where
    description :: String
description
      =  String
"List available profiles. Use `--all` option to list dangling profiles"
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -- profiles that were \"partially\" initialized (an error was"
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" encountered during `pfile new` which couldn't be rollbacked)."

parser :: Parser Options
parser :: Parser Options
parser = do
  Bool
shouldFilterDangling <- (Bool -> Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Parser Bool -> Parser Bool)
-> (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool
-> Parser Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod FlagFields Bool -> Parser Bool
switch
    (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$  Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a'
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"all"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Include dangling profiles"
  pure Options {Bool
shouldFilterDangling :: Bool
shouldFilterDangling :: Bool
..}

newtype Options
  = Options { Options -> Bool
shouldFilterDangling :: Bool }