{-# 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
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"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
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"produce emacs etags file"


filePathParser :: Parser (FilePath)
filePathParser :: Parser String
filePathParser =
    Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (Mod ArgumentFields String -> Parser String)
-> Mod ArgumentFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
         String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"tags file: default tags or TAGS (when --etags is specified)"
      Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"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
$
       String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"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
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"debug"

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

  , Options f -> f String
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.
  , Options f -> Bool
debug :: Bool
  }

deriving instance Show (Options Identity)


parseOtions :: Parser (Options Last)
parseOtions :: Parser (Options Last)
parseOtions = Bool -> Last String -> Bool -> Options Last
forall (f :: * -> *). Bool -> f String -> Bool -> Options f
Options
         (Bool -> Last String -> Bool -> Options Last)
-> Parser Bool -> Parser (Last String -> 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 (Last String -> Bool -> Options Last)
-> Parser (Last String) -> Parser (Bool -> Options Last)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((String -> Last String) -> [String] -> Last String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe String -> Last String
forall a. Maybe a -> Last a
Last (Maybe String -> Last String)
-> (String -> Maybe String) -> String -> Last String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just) ([String] -> Last String)
-> Parser [String] -> Parser (Last String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser String
filePathParser)
         Parser (Bool -> Options Last)
-> Parser Bool -> Parser (Options Last)
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
$
       String -> InfoMod (Options Last)
forall a. String -> InfoMod a
progDesc String
"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 :: [String] -> ParserResult (Options Identity)
runOptionParser = (Options Last -> Options Identity)
-> ParserResult (Options Last) -> ParserResult (Options Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Options Last -> Options Identity
defaultOptions (ParserResult (Options Last) -> ParserResult (Options Identity))
-> ([String] -> ParserResult (Options Last))
-> [String]
-> ParserResult (Options Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs
-> ParserInfo (Options Last)
-> [String]
-> ParserResult (Options Last)
forall a. ParserPrefs -> ParserInfo a -> [String] -> 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, Last String
filePath :: Last String
filePath :: forall (f :: * -> *). Options f -> f String
filePath, Bool
debug :: Bool
debug :: forall (f :: * -> *). Options f -> Bool
debug } =
        Options :: forall (f :: * -> *). Bool -> f String -> Bool -> Options f
Options {
            Bool
etags :: Bool
etags :: Bool
etags,
            filePath :: Identity String
filePath = String -> Identity String
forall a. a -> Identity a
Identity String
filePath',
            Bool
debug :: Bool
debug :: Bool
debug
          }
      where
        filePath' :: String
filePath' =
          case Last String
filePath of
            Last Maybe String
Nothing   -> String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"tags" String
"TAGS" Bool
etags
            Last (Just String
fp) -> String
fp