{-# 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 (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 <$ :: forall a b. a -> Flag b -> Flag a $c<$ :: forall a b. a -> Flag b -> Flag a fmap :: forall a b. (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 :: forall a. Monoid a => [Flag a] -> Flag a flagConcat = forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' forall a. Monoid a => Flag a -> Flag a -> Flag a flagAppend (forall a. a -> Flag a NoHelp forall a. Monoid a => a mempty) where flagAppend :: Monoid a => Flag a -> Flag a -> Flag a flagAppend :: forall a. Monoid a => Flag a -> Flag a -> Flag a flagAppend Flag a a Flag a b = case (Flag a a, Flag a b) of (Flag a Help, Flag a _) -> forall a. Flag a Help (Flag a _, Flag a Help) -> forall a. Flag a Help (Version String s, Flag a _) -> forall a. String -> Flag a Version String s (Flag a _, Version String s) -> forall a. String -> Flag a Version String s (NoHelp a a, NoHelp a b) -> forall a. a -> Flag a NoHelp (forall a. Monoid a => a -> a -> a mappend a a a b) foldFlags :: [Flag a] -> Flag [a] foldFlags :: forall a. [Flag a] -> Flag [a] foldFlags [Flag a] flags = forall a. Monoid a => [Flag a] -> Flag a flagConcat forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall (f :: * -> *) a. Applicative f => a -> f a pure) [Flag a] flags helpOption :: OptDescr (Flag a) helpOption :: forall a. OptDescr (Flag a) helpOption = forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a Option [Char 'h'] [String "help"] (forall a. a -> ArgDescr a NoArg forall a. Flag a Help) String "show help and exit" versionOption :: String -> OptDescr (Flag a) versionOption :: forall a. String -> OptDescr (Flag a) versionOption String version = forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a Option [Char 'v'] [String "version"] (forall a. a -> ArgDescr a NoArg (forall a. String -> Flag a Version String version)) String "show version and exit" usage :: String -> [(Bool, String)] -> [OptDescr ()] -> String usage :: String -> [(Bool, String)] -> [OptDescr ()] -> String usage String progName [(Bool, String)] fields [OptDescr ()] options = forall a. String -> [OptDescr a] -> String usageInfo String header [OptDescr ()] options where header :: String header :: String header = [String] -> String unwords forall a b. (a -> b) -> a -> b $ String progName forall a. a -> [a] -> [a] : String "[OPTIONS]" forall a. a -> [a] -> [a] : forall a. a -> Maybe a -> a fromMaybe [] ([(Bool, String)] -> Maybe [String] formatFields [(Bool, String)] fields) forall a. [a] -> [a] -> [a] ++ [] formatFields :: [(Bool, String)] -> Maybe [String] formatFields :: [(Bool, String)] -> Maybe [String] formatFields [] = forall a. Maybe a Nothing formatFields [(Bool, String)] fields = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ let (forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> b snd -> [String] nonOptional, forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> b snd -> [String] optional) = forall a. (a -> Bool) -> [a] -> ([a], [a]) span (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a, b) -> a fst) [(Bool, String)] fields in [String] nonOptional forall a. [a] -> [a] -> [a] ++ [[String] -> String formatOptional [String] optional] formatOptional :: [String] -> String formatOptional :: [String] -> String formatOptional [] = String "" formatOptional [String a] = String "[" forall a. [a] -> [a] -> [a] ++ String a forall a. [a] -> [a] -> [a] ++ String "]" formatOptional (String a : [String] r) = String "[" forall a. [a] -> [a] -> [a] ++ String a forall a. [a] -> [a] -> [a] ++ String " " forall a. [a] -> [a] -> [a] ++ [String] -> String formatOptional [String] r forall a. [a] -> [a] -> [a] ++ String "]"