{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE StandaloneDeriving #-}

module Plugin.GhcTags.Options
  ( Options (..)
  , ParserResult (..)
  , runOptionParser
  ) where

import           Data.Bool (bool)
import           Data.Monoid (Last (..))
import           Data.Functor.Identity (Identity (..))
import           Options.Applicative


etagsParser :: Parser Bool
etagsParser :: Parser Bool
etagsParser = Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
       forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e'
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"etags"
    forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"produce emacs etags file"

streamParser :: Parser Bool
streamParser :: Parser Bool
streamParser = Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
       forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"stream"
    forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help ( FilePath
"stream tags from the tags file when updating its contents"
           forall a. [a] -> [a] -> [a]
++ FilePath
" with the tags found in the current module" )

filePathParser :: Parser (FilePath)
filePathParser :: Parser FilePath
filePathParser =
    forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument forall a b. (a -> b) -> a -> b
$
         forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"tags file: default tags or TAGS (when --etags is specified)"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"file_path"

debugParser :: Parser Bool
debugParser :: Parser Bool
debugParser = Mod FlagFields Bool -> Parser Bool
switch forall a b. (a -> b) -> a -> b
$
       forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"debug"
    forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
    forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"debug"

-- | /ghc-tags-plugin/ options
--
data Options f = Options
  { forall (f :: * -> *). Options f -> Bool
etags    :: Bool
    -- ^ if 'True' use emacs tags file format, the default is 'False'.

  , forall (f :: * -> *). Options f -> Bool
stream   ::   Bool
    -- ^ be default we read the tags file and overwrite it.  When this option
    -- is on, we stream tags from it while interliving the tags found in the
    -- current module to a new destination, which is then moved to the tags
    -- file desintation.

  , forall (f :: * -> *). Options f -> f FilePath
filePath :: f FilePath
    -- ^ file path to the tags file (relative to the @*.cabal@ file).  The
    -- default is either 'tags' (if 'etags' if 'False') or 'TAGS' otherwise.

  , forall (f :: * -> *). Options f -> Bool
debug :: Bool
  }

deriving instance Show (Options Identity)


parseOtions :: Parser (Options Last)
parseOtions :: Parser (Options Last)
parseOtions = forall (f :: * -> *).
Bool -> Bool -> f FilePath -> Bool -> Options f
Options
         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
etagsParser
         -- allow to pass the argument multiple times
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
streamParser
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Maybe a -> Last a
Last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FilePath
filePathParser)
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
debugParser


parserInfo :: ParserInfo (Options Last)
parserInfo :: ParserInfo (Options Last)
parserInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Options Last)
parseOtions forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper) forall a b. (a -> b) -> a -> b
$
       forall a. FilePath -> InfoMod a
progDesc FilePath
"write tags from ghc abstract syntax tree"
    forall a. Semigroup a => a -> a -> a
<> forall a. InfoMod a
fullDesc


runOptionParser :: [String]
                -> ParserResult (Options Identity)
runOptionParser :: [FilePath] -> ParserResult (Options Identity)
runOptionParser = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Options Last -> Options Identity
defaultOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ParserPrefs -> ParserInfo a -> [FilePath] -> ParserResult a
execParserPure ParserPrefs
defaultPrefs ParserInfo (Options Last)
parserInfo
  where
    defaultOptions :: Options Last -> Options Identity
    defaultOptions :: Options Last -> Options Identity
defaultOptions Options { Bool
etags :: Bool
etags :: forall (f :: * -> *). Options f -> Bool
etags, Bool
stream :: Bool
stream :: forall (f :: * -> *). Options f -> Bool
stream, Last FilePath
filePath :: Last FilePath
filePath :: forall (f :: * -> *). Options f -> f FilePath
filePath, Bool
debug :: Bool
debug :: forall (f :: * -> *). Options f -> Bool
debug } =
        Options {
            Bool
etags :: Bool
etags :: Bool
etags,
            Bool
stream :: Bool
stream :: Bool
stream,
            filePath :: Identity FilePath
filePath = forall a. a -> Identity a
Identity FilePath
filePath',
            Bool
debug :: Bool
debug :: Bool
debug
          }
      where
        filePath' :: FilePath
filePath' =
          case Last FilePath
filePath of
            Last Maybe FilePath
Nothing   -> forall a. a -> a -> Bool -> a
bool FilePath
"tags" FilePath
"TAGS" Bool
etags
            Last (Just FilePath
fp) -> FilePath
fp