{-# 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