{-# LANGUAGE FlexibleInstances #-}

-- | This module is responsible for handling CLI options
module Language.Fortran.Extras.RunOptions
  ( FortranSrcRunOptions(..)
  , getFortranSrcRunOptions
  , unwrapFortranSrcOptions
  , RunOptions(..)
  , getRunOptions
  )
where

import qualified Data.ByteString.Char8         as B
import           Language.Fortran.Version       ( FortranVersion(..)
                                                , selectFortranVersion
                                                )
import           Options.Applicative

import           Language.Fortran.Util.Files
                                                ( flexReadFile )

-- | Holds fortran-src specific CLI options.
-- This includes the version of the parser, included files and the path
-- of the source
data FortranSrcRunOptions = FortranSrcRunOptions
    { FortranSrcRunOptions -> FortranVersion
version  :: !FortranVersion
    , FortranSrcRunOptions -> Bool
verbose  :: Bool
    , FortranSrcRunOptions -> [String]
includes :: ![String]
    , FortranSrcRunOptions -> String
path     :: !String
    } deriving Int -> FortranSrcRunOptions -> ShowS
[FortranSrcRunOptions] -> ShowS
FortranSrcRunOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FortranSrcRunOptions] -> ShowS
$cshowList :: [FortranSrcRunOptions] -> ShowS
show :: FortranSrcRunOptions -> String
$cshow :: FortranSrcRunOptions -> String
showsPrec :: Int -> FortranSrcRunOptions -> ShowS
$cshowsPrec :: Int -> FortranSrcRunOptions -> ShowS
Show

-- | Provided version, includes and path strings, this functon maps them to
-- 'FortranSrcRunOptions'
--
-- Note that this will throw an exception on an unrecognized version string.
toFortranSrcOptions :: String -> Bool -> [String] -> String -> FortranSrcRunOptions
toFortranSrcOptions :: String -> Bool -> [String] -> String -> FortranSrcRunOptions
toFortranSrcOptions String
verStr Bool
verboseFlag =
    let (Just FortranVersion
ver) = String -> Maybe FortranVersion
selectFortranVersion String
verStr
     in FortranVersion
-> Bool -> [String] -> String -> FortranSrcRunOptions
FortranSrcRunOptions FortranVersion
ver Bool
verboseFlag

-- | Definition of parser for 'FortranSrcRunOptions'
fortranSrcRunOptionsParser :: Parser FortranSrcRunOptions
fortranSrcRunOptionsParser :: Parser FortranSrcRunOptions
fortranSrcRunOptionsParser =
  String -> Bool -> [String] -> String -> FortranSrcRunOptions
toFortranSrcOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          (  forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fortranVersion"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"VERSION"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help
               String
"Fortran version to use, format: Fortran[66/77/77l/77e/90/95/03/08]"
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> a -> Mod FlagFields a -> Parser a
flag
          Bool
False Bool
True (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'V' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbose" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Verbose mode for this tool"))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
          (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'I' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"include" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIRECTORY" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help
              String
"Directory to include files from"
            )
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall s. IsString s => ReadM s
str (forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATH")

-- | Given description and header, decorate fortran-src options parser with
-- info details
fortranSrcRunOptionsInfo :: String -> String -> ParserInfo FortranSrcRunOptions
fortranSrcRunOptionsInfo :: String -> String -> ParserInfo FortranSrcRunOptions
fortranSrcRunOptionsInfo String
programDescription String
headerDescription = forall a. Parser a -> InfoMod a -> ParserInfo a
info
  (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FortranSrcRunOptions
fortranSrcRunOptionsParser)
  (forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
programDescription forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
headerDescription)

-- | Given description and header, execute fortran-src options parser
-- and get the 'FortranSrcRunOptions'
getFortranSrcRunOptions :: String -> String -> IO FortranSrcRunOptions
getFortranSrcRunOptions :: String -> String -> IO FortranSrcRunOptions
getFortranSrcRunOptions String
programDescription String
headerDescription =
  forall a. ParserInfo a -> IO a
execParser forall a b. (a -> b) -> a -> b
$ String -> String -> ParserInfo FortranSrcRunOptions
fortranSrcRunOptionsInfo String
programDescription String
headerDescription

-- | Obtain path, contents, include dirs and 'FortranVersion'
-- from 'FortranSrcRunOptions'
unwrapFortranSrcOptions
  :: FortranSrcRunOptions -> IO (String, B.ByteString, [String], FortranVersion)
unwrapFortranSrcOptions :: FortranSrcRunOptions
-> IO (String, ByteString, [String], FortranVersion)
unwrapFortranSrcOptions FortranSrcRunOptions
options = do
  let p :: String
p = FortranSrcRunOptions -> String
path FortranSrcRunOptions
options
  ByteString
c <- String -> IO ByteString
flexReadFile String
p
  let i :: [String]
i = FortranSrcRunOptions -> [String]
includes FortranSrcRunOptions
options
      v :: FortranVersion
v = FortranSrcRunOptions -> FortranVersion
version FortranSrcRunOptions
options
  forall (m :: * -> *) a. Monad m => a -> m a
return (String
p, ByteString
c, [String]
i, FortranVersion
v)

-- | Holds 'FortranSrcRunOptions' and additional tool specific CLI options
data RunOptions a = RunOptions
    { forall a. RunOptions a -> FortranSrcRunOptions
fortranSrcOpts :: FortranSrcRunOptions
    , forall a. RunOptions a -> a
toolOpts :: a
    } deriving Int -> RunOptions a -> ShowS
forall a. Show a => Int -> RunOptions a -> ShowS
forall a. Show a => [RunOptions a] -> ShowS
forall a. Show a => RunOptions a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunOptions a] -> ShowS
$cshowList :: forall a. Show a => [RunOptions a] -> ShowS
show :: RunOptions a -> String
$cshow :: forall a. Show a => RunOptions a -> String
showsPrec :: Int -> RunOptions a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RunOptions a -> ShowS
Show

-- | Given decription, header and tool options parser, decorate options
-- with info details
runOptionsInfo :: String -> String -> Parser a -> ParserInfo (RunOptions a)
runOptionsInfo :: forall a. String -> String -> Parser a -> ParserInfo (RunOptions a)
runOptionsInfo String
programDescription String
headerDescription Parser a
toolOptsParser = forall a. Parser a -> InfoMod a -> ParserInfo a
info
  (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. FortranSrcRunOptions -> a -> RunOptions a
RunOptions Parser FortranSrcRunOptions
fortranSrcRunOptionsParser Parser a
toolOptsParser)
  (forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
programDescription forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
headerDescription)

-- | Given description, header and tool options parser, execute options parser
-- and get the 'RunOptions'
getRunOptions :: String -> String -> Parser a -> IO (RunOptions a)
getRunOptions :: forall a. String -> String -> Parser a -> IO (RunOptions a)
getRunOptions String
programDescription String
headerDescription Parser a
toolOptsParser =
  forall a. ParserInfo a -> IO a
execParser
    forall a b. (a -> b) -> a -> b
$ forall a. String -> String -> Parser a -> ParserInfo (RunOptions a)
runOptionsInfo String
programDescription String
headerDescription Parser a
toolOptsParser