{-# 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 (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
'e'
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"etags"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
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 (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
's'
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"stream"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help ( FilePath
"stream tags from the tags file when updating its contents"
           FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" with the tags found in the current module" )

filePathParser :: Parser FilePath
filePathParser :: Parser FilePath
filePathParser =
    Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
         FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"tags file: default tags or TAGS (when --etags is specified)"
      Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
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 (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
       FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"debug"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
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 interleaving the tags found in the
    -- current module to a new destination, which is then moved to the tags
    -- file destination.

  , 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 = Bool -> Bool -> Last FilePath -> Bool -> Options Last
forall (f :: * -> *).
Bool -> Bool -> f FilePath -> Bool -> Options f
Options
         (Bool -> Bool -> Last FilePath -> Bool -> Options Last)
-> Parser Bool
-> Parser (Bool -> Last FilePath -> Bool -> Options Last)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
etagsParser
         -- allow to pass the argument multiple times
         Parser (Bool -> Last FilePath -> Bool -> Options Last)
-> Parser Bool -> Parser (Last FilePath -> Bool -> Options Last)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
streamParser
         Parser (Last FilePath -> Bool -> Options Last)
-> Parser (Last FilePath) -> Parser (Bool -> Options Last)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((FilePath -> Last FilePath) -> [FilePath] -> Last FilePath
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe FilePath -> Last FilePath
forall a. Maybe a -> Last a
Last (Maybe FilePath -> Last FilePath)
-> (FilePath -> Maybe FilePath) -> FilePath -> Last FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just) ([FilePath] -> Last FilePath)
-> Parser [FilePath] -> Parser (Last FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FilePath
filePathParser)
         Parser (Bool -> Options Last)
-> Parser Bool -> Parser (Options Last)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 = Parser (Options Last)
-> InfoMod (Options Last) -> ParserInfo (Options Last)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Options Last)
parseOtions Parser (Options Last)
-> Parser (Options Last -> Options Last) -> Parser (Options Last)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Options Last -> Options Last)
forall a. Parser (a -> a)
helper) (InfoMod (Options Last) -> ParserInfo (Options Last))
-> InfoMod (Options Last) -> ParserInfo (Options Last)
forall a b. (a -> b) -> a -> b
$
       FilePath -> InfoMod (Options Last)
forall a. FilePath -> InfoMod a
progDesc FilePath
"write tags from ghc abstract syntax tree"
    InfoMod (Options Last)
-> InfoMod (Options Last) -> InfoMod (Options Last)
forall a. Semigroup a => a -> a -> a
<> InfoMod (Options Last)
forall a. InfoMod a
fullDesc


runOptionParser :: [String]
                -> ParserResult (Options Identity)
runOptionParser :: [FilePath] -> ParserResult (Options Identity)
runOptionParser = (Options Last -> Options Identity)
-> ParserResult (Options Last) -> ParserResult (Options Identity)
forall a b. (a -> b) -> ParserResult a -> ParserResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Options Last -> Options Identity
defaultOptions (ParserResult (Options Last) -> ParserResult (Options Identity))
-> ([FilePath] -> ParserResult (Options Last))
-> [FilePath]
-> ParserResult (Options Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs
-> ParserInfo (Options Last)
-> [FilePath]
-> ParserResult (Options Last)
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 :: forall (f :: * -> *). Options f -> Bool
etags :: Bool
etags, Bool
stream :: forall (f :: * -> *). Options f -> Bool
stream :: Bool
stream, Last FilePath
filePath :: forall (f :: * -> *). Options f -> f FilePath
filePath :: Last FilePath
filePath, Bool
debug :: forall (f :: * -> *). Options f -> Bool
debug :: Bool
debug } =
        Options {
            Bool
etags :: Bool
etags :: Bool
etags,
            Bool
stream :: Bool
stream :: Bool
stream,
            filePath :: Identity FilePath
filePath = FilePath -> Identity 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   -> FilePath -> FilePath -> Bool -> FilePath
forall a. a -> a -> Bool -> a
bool FilePath
"tags" FilePath
"TAGS" Bool
etags
            Last (Just FilePath
fp) -> FilePath
fp