{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.ScriptParser
  ( ScriptExecute (..)
  , ScriptOpts (..)
  , ShouldRun (..)
  , scriptOptsParser
  ) where

import           Options.Applicative
                   ( Parser, completer, eitherReader, flag', help, long
                   , metavar, option, strArgument, strOption
                   )
import           Options.Applicative.Builder.Extra ( fileExtCompleter )
import           Stack.Options.Completion ( ghcOptsCompleter )
import           Stack.Prelude

data ScriptOpts = ScriptOpts
  { ScriptOpts -> [String]
soPackages :: ![String]
  , ScriptOpts -> String
soFile :: !FilePath
  , ScriptOpts -> [String]
soArgs :: ![String]
  , ScriptOpts -> ScriptExecute
soCompile :: !ScriptExecute
  , ScriptOpts -> [String]
soGhcOptions :: ![String]
  , ScriptOpts -> [PackageIdentifierRevision]
soScriptExtraDeps :: ![PackageIdentifierRevision]
  , ScriptOpts -> ShouldRun
soShouldRun :: !ShouldRun
  }
  deriving Int -> ScriptOpts -> ShowS
[ScriptOpts] -> ShowS
ScriptOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptOpts] -> ShowS
$cshowList :: [ScriptOpts] -> ShowS
show :: ScriptOpts -> String
$cshow :: ScriptOpts -> String
showsPrec :: Int -> ScriptOpts -> ShowS
$cshowsPrec :: Int -> ScriptOpts -> ShowS
Show

data ScriptExecute
  = SEInterpret
  | SECompile
  | SEOptimize
  deriving Int -> ScriptExecute -> ShowS
[ScriptExecute] -> ShowS
ScriptExecute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptExecute] -> ShowS
$cshowList :: [ScriptExecute] -> ShowS
show :: ScriptExecute -> String
$cshow :: ScriptExecute -> String
showsPrec :: Int -> ScriptExecute -> ShowS
$cshowsPrec :: Int -> ScriptExecute -> ShowS
Show

data ShouldRun = YesRun | NoRun
  deriving Int -> ShouldRun -> ShowS
[ShouldRun] -> ShowS
ShouldRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShouldRun] -> ShowS
$cshowList :: [ShouldRun] -> ShowS
show :: ShouldRun -> String
$cshow :: ShouldRun -> String
showsPrec :: Int -> ShouldRun -> ShowS
$cshowsPrec :: Int -> ShouldRun -> ShowS
Show

scriptOptsParser :: Parser ScriptOpts
scriptOptsParser :: Parser ScriptOpts
scriptOptsParser = [String]
-> String
-> [String]
-> ScriptExecute
-> [String]
-> [PackageIdentifierRevision]
-> ShouldRun
-> ScriptOpts
ScriptOpts
  forall (f :: * -> *) a b. Functor 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 => String -> Mod f a
long String
"package"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PACKAGE"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Add a package (can be specified multiple times)"
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
        (  forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([String] -> Completer
fileExtCompleter [String
".hs", String
".lhs"])
        )
  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 ArgumentFields s -> Parser s
strArgument
        (  forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"-- ARGUMENT(S) (e.g. stack script X.hs -- argument(s) to \
                   \program)"
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (   forall a. a -> Mod FlagFields a -> Parser a
flag' ScriptExecute
SECompile
            (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"compile"
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Compile the script without optimization and run the executable"
            )
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' ScriptExecute
SEOptimize
            (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"optimize"
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Compile the script with optimization and run the executable"
            )
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptExecute
SEInterpret
      )
  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 => String -> Mod f a
long String
"ghc-options"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"OPTIONS"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
ghcOptsCompleter
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Additional options passed to GHC"
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM PackageIdentifierRevision
extraDepRead
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra-dep"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PACKAGE-VERSION"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Extra dependencies to be added to the snapshot"
        ))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (   forall a. a -> Mod FlagFields a -> Parser a
flag' ShouldRun
NoRun
            (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-run"
            forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Don't run, just compile."
            )
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ShouldRun
YesRun
      )
 where
  extraDepRead :: ReadM PackageIdentifierRevision
extraDepRead = forall a. (String -> Either String a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$
                   forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString