{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StrictData #-}

module Hinit.Cli.Options where

import Control.Effect.Lift
import Data.String.Interpolate
import Data.Text (Text)
import Data.Version
import GHC.Generics
import Hinit.Types
import Options.Applicative
import Paths_hinit

data Op
  = Set Text Val
  deriving (Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
(Int -> Op -> ShowS)
-> (Op -> String) -> ([Op] -> ShowS) -> Show Op
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Op] -> ShowS
$cshowList :: [Op] -> ShowS
show :: Op -> String
$cshow :: Op -> String
showsPrec :: Int -> Op -> ShowS
$cshowsPrec :: Int -> Op -> ShowS
Show, Op -> Op -> Bool
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c== :: Op -> Op -> Bool
Eq, (forall x. Op -> Rep Op x)
-> (forall x. Rep Op x -> Op) -> Generic Op
forall x. Rep Op x -> Op
forall x. Op -> Rep Op x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Op x -> Op
$cfrom :: forall x. Op -> Rep Op x
Generic)

toPair :: Op -> (Text, Val)
toPair :: Op -> (Text, Val)
toPair (Set Text
t Val
v) = (Text
t, Val
v)

data Command
  = Init
      { Command -> Text
template :: Text,
        Command -> Text
project :: Text,
        Command -> [Op]
ops :: [Op],
        Command -> Bool
force :: Bool
      }
  | List
      { Command -> Bool
verbose :: Bool
      }
  deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, (forall x. Command -> Rep Command x)
-> (forall x. Rep Command x -> Command) -> Generic Command
forall x. Rep Command x -> Command
forall x. Command -> Rep Command x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Command x -> Command
$cfrom :: forall x. Command -> Rep Command x
Generic)

verString :: String
verString :: String
verString = [i|hi version #{showVersion version}|]

readBool :: ReadM Bool
readBool :: ReadM Bool
readBool = do
  String
s <- ReadM String
forall s. IsString s => ReadM s
str
  if
      | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"True" Bool -> Bool -> Bool
|| String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true" -> Bool -> ReadM Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True
      | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"False" Bool -> Bool -> Bool
|| String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"false" -> Bool -> ReadM Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False
      | Bool
otherwise -> String -> ReadM Bool
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
"the option " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a bool")

text :: Parser (Text, Val)
text :: Parser (Text, Val)
text = (,) (Text -> Val -> (Text, Val))
-> Parser Text -> Parser (Val -> (Text, Val))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
arg Parser (Val -> (Text, Val)) -> Parser Val -> Parser (Text, Val)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Parser Val
val
  where
    arg :: Parser Text
arg =
      Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        ( String -> Mod OptionFields Text
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
long String
"text"
            Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
short Char
't'
            Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
metavar String
"Key"
            Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: Type -> Type) a. String -> Mod f a
help String
"Set a key-value pair where the value is text"
        )
    val :: Parser Val
val = Text -> Val
Text (Text -> Val) -> Parser Text -> Parser Val
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
metavar String
"Value")

bool :: Parser (Text, Val)
bool :: Parser (Text, Val)
bool = (,) (Text -> Val -> (Text, Val))
-> Parser Text -> Parser (Val -> (Text, Val))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
arg Parser (Val -> (Text, Val)) -> Parser Val -> Parser (Text, Val)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Parser Val
val
  where
    arg :: Parser Text
arg =
      Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        ( String -> Mod OptionFields Text
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
long String
"bool"
            Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
short Char
'b'
            Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
metavar String
"Key"
            Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: Type -> Type) a. String -> Mod f a
help String
"Set a key-value pair where the value is boolean"
        )
    val :: Parser Val
val =
      Bool -> Val
Bool
        (Bool -> Val) -> Parser Bool -> Parser Val
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Bool -> Mod ArgumentFields Bool -> Parser Bool
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument
          ReadM Bool
readBool
          ( String -> Mod ArgumentFields Bool
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
metavar String
"Value"
              Mod ArgumentFields Bool
-> Mod ArgumentFields Bool -> Mod ArgumentFields Bool
forall a. Semigroup a => a -> a -> a
<> [String] -> Mod ArgumentFields Bool
forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a
completeWith [String
"True", String
"False"]
          )

operation :: Parser Op
operation :: Parser Op
operation = Parser Op
setT Parser Op -> Parser Op -> Parser Op
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Parser Op
setB
  where
    setT :: Parser Op
setT =
      (Text -> Val -> Op) -> (Text, Val) -> Op
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Val -> Op
Set ((Text, Val) -> Op) -> Parser (Text, Val) -> Parser Op
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, Val)
text
    setB :: Parser Op
setB =
      (Text -> Val -> Op) -> (Text, Val) -> Op
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Val -> Op
Set ((Text, Val) -> Op) -> Parser (Text, Val) -> Parser Op
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, Val)
bool

initOptions :: Parser Command
initOptions :: Parser Command
initOptions =
  Text -> Text -> [Op] -> Bool -> Command
Init
    (Text -> Text -> [Op] -> Bool -> Command)
-> Parser Text -> Parser (Text -> [Op] -> Bool -> Command)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
metavar String
"TEMPLATE")
    Parser (Text -> [Op] -> Bool -> Command)
-> Parser Text -> Parser ([Op] -> Bool -> Command)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
metavar String
"TARGET")
    Parser ([Op] -> Bool -> Command)
-> Parser [Op] -> Parser (Bool -> Command)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Parser Op -> Parser [Op]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many Parser Op
operation
    Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
long String
"force" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
short Char
'f')

listOptions :: Parser Command
listOptions :: Parser Command
listOptions =
  Bool -> Command
List
    (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
long String
"verbose" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
short Char
'v')

commandParser :: Parser Command
commandParser :: Parser Command
commandParser =
  Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
    ( ((String, Parser Command, String) -> Mod CommandFields Command)
-> [(String, Parser Command, String)] -> Mod CommandFields Command
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (\(String
cmd, Parser Command
parser, String
desc) -> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
cmd (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Command
parser Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
versionHelper) (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
desc)))
        [ (String
"init", Parser Command
initOptions, String
"Initialze a project"),
          (String
"list", Parser Command
listOptions, String
"List all available templates")
        ]
    )

versionHelper :: Parser (a -> a)
versionHelper :: Parser (a -> a)
versionHelper = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
verString (String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. String -> Mod f a
help String
"print program version")

cmds :: ParserInfo Command
cmds :: ParserInfo Command
cmds =
  Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser Command
commandParser Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
helper Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
versionHelper)
    ( InfoMod Command
forall a. InfoMod a
fullDesc
        InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Command
forall a. String -> InfoMod a
progDesc
          String
"hi is a generic project scaffolding tool that uses mustache for templating.\n\
          \For more documentation, see https://github.com/poscat0x04/hinit"
        InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Command
forall a. String -> InfoMod a
header String
"hi - Project scaffolding tool writting in Haskell"
    )

parseCliOptions :: Has (Lift IO) sig m => m Command
parseCliOptions :: m Command
parseCliOptions = IO Command -> m Command
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Command -> m Command) -> IO Command -> m Command
forall a b. (a -> b) -> a -> b
$ ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
execParser ParserInfo Command
cmds