{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ViewPatterns #-} module WithCli.Flag where import Prelude () import Prelude.Compat import Data.List import Data.Maybe import System.Console.GetOpt data Flag a = Help | Version String | NoHelp a deriving (a -> Flag b -> Flag a (a -> b) -> Flag a -> Flag b (forall a b. (a -> b) -> Flag a -> Flag b) -> (forall a b. a -> Flag b -> Flag a) -> Functor Flag forall a b. a -> Flag b -> Flag a forall a b. (a -> b) -> Flag a -> Flag b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> Flag b -> Flag a $c<$ :: forall a b. a -> Flag b -> Flag a fmap :: (a -> b) -> Flag a -> Flag b $cfmap :: forall a b. (a -> b) -> Flag a -> Flag b Functor) flagConcat :: Monoid a => [Flag a] -> Flag a flagConcat :: [Flag a] -> Flag a flagConcat = (Flag a -> Flag a -> Flag a) -> Flag a -> [Flag a] -> Flag a forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' Flag a -> Flag a -> Flag a forall a. Monoid a => Flag a -> Flag a -> Flag a flagAppend (a -> Flag a forall a. a -> Flag a NoHelp a forall a. Monoid a => a mempty) where flagAppend :: Monoid a => Flag a -> Flag a -> Flag a flagAppend :: Flag a -> Flag a -> Flag a flagAppend a :: Flag a a b :: Flag a b = case (Flag a a, Flag a b) of (Help, _) -> Flag a forall a. Flag a Help (_, Help) -> Flag a forall a. Flag a Help (Version s :: String s, _) -> String -> Flag a forall a. String -> Flag a Version String s (_, Version s :: String s) -> String -> Flag a forall a. String -> Flag a Version String s (NoHelp a :: a a, NoHelp b :: a b) -> a -> Flag a forall a. a -> Flag a NoHelp (a -> a -> a forall a. Monoid a => a -> a -> a mappend a a a b) foldFlags :: [Flag a] -> Flag [a] foldFlags :: [Flag a] -> Flag [a] foldFlags flags :: [Flag a] flags = [Flag [a]] -> Flag [a] forall a. Monoid a => [Flag a] -> Flag a flagConcat ([Flag [a]] -> Flag [a]) -> [Flag [a]] -> Flag [a] forall a b. (a -> b) -> a -> b $ (Flag a -> Flag [a]) -> [Flag a] -> [Flag [a]] forall a b. (a -> b) -> [a] -> [b] map ((a -> [a]) -> Flag a -> Flag [a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> [a] forall (f :: * -> *) a. Applicative f => a -> f a pure) [Flag a] flags helpOption :: OptDescr (Flag a) helpOption :: OptDescr (Flag a) helpOption = String -> [String] -> ArgDescr (Flag a) -> String -> OptDescr (Flag a) forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a Option ['h'] ["help"] (Flag a -> ArgDescr (Flag a) forall a. a -> ArgDescr a NoArg Flag a forall a. Flag a Help) "show help and exit" versionOption :: String -> OptDescr (Flag a) versionOption :: String -> OptDescr (Flag a) versionOption version :: String version = String -> [String] -> ArgDescr (Flag a) -> String -> OptDescr (Flag a) forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a Option ['v'] ["version"] (Flag a -> ArgDescr (Flag a) forall a. a -> ArgDescr a NoArg (String -> Flag a forall a. String -> Flag a Version String version)) "show version and exit" usage :: String -> [(Bool, String)] -> [OptDescr ()] -> String usage :: String -> [(Bool, String)] -> [OptDescr ()] -> String usage progName :: String progName fields :: [(Bool, String)] fields options :: [OptDescr ()] options = String -> [OptDescr ()] -> String forall a. String -> [OptDescr a] -> String usageInfo String header [OptDescr ()] options where header :: String header :: String header = [String] -> String unwords ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ String progName String -> [String] -> [String] forall a. a -> [a] -> [a] : "[OPTIONS]" String -> [String] -> [String] forall a. a -> [a] -> [a] : [String] -> Maybe [String] -> [String] forall a. a -> Maybe a -> a fromMaybe [] ([(Bool, String)] -> Maybe [String] formatFields [(Bool, String)] fields) [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [] formatFields :: [(Bool, String)] -> Maybe [String] formatFields :: [(Bool, String)] -> Maybe [String] formatFields [] = Maybe [String] forall a. Maybe a Nothing formatFields fields :: [(Bool, String)] fields = [String] -> Maybe [String] forall a. a -> Maybe a Just ([String] -> Maybe [String]) -> [String] -> Maybe [String] forall a b. (a -> b) -> a -> b $ let (((Bool, String) -> String) -> [(Bool, String)] -> [String] forall a b. (a -> b) -> [a] -> [b] map (Bool, String) -> String forall a b. (a, b) -> b snd -> [String] nonOptional, ((Bool, String) -> String) -> [(Bool, String)] -> [String] forall a b. (a -> b) -> [a] -> [b] map (Bool, String) -> String forall a b. (a, b) -> b snd -> [String] optional) = ((Bool, String) -> Bool) -> [(Bool, String)] -> ([(Bool, String)], [(Bool, String)]) forall a. (a -> Bool) -> [a] -> ([a], [a]) span (Bool -> Bool not (Bool -> Bool) -> ((Bool, String) -> Bool) -> (Bool, String) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (Bool, String) -> Bool forall a b. (a, b) -> a fst) [(Bool, String)] fields in [String] nonOptional [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [[String] -> String formatOptional [String] optional] formatOptional :: [String] -> String formatOptional :: [String] -> String formatOptional [] = "" formatOptional [a :: String a] = "[" String -> String -> String forall a. [a] -> [a] -> [a] ++ String a String -> String -> String forall a. [a] -> [a] -> [a] ++ "]" formatOptional (a :: String a : r :: [String] r) = "[" String -> String -> String forall a. [a] -> [a] -> [a] ++ String a String -> String -> String forall a. [a] -> [a] -> [a] ++ " " String -> String -> String forall a. [a] -> [a] -> [a] ++ [String] -> String formatOptional [String] r String -> String -> String forall a. [a] -> [a] -> [a] ++ "]"