{-# LANGUAGE OverloadedStrings #-} module Crux.Config.Doc (configDocs) where import Config.Schema (sectionsSpec,generateDocs) import Data.Function ( on ) import qualified Data.List as L import Data.Text ( Text ) import qualified Data.Text as T import Prettyprinter import Prettyprinter.Util ( reflow ) import SimpleGetOpt ( OptSpec(..) ) import Crux.Config import Crux.Config.Load (commandLineOptions) configDocs :: Text -> Config opts -> Doc ann configDocs :: forall opts ann. Text -> Config opts -> Doc ann configDocs Text nm Config opts cfg = [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vcat [ String -> Doc ann forall ann. String -> Doc ann heading String "Command line flags:" , Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann indent Int 2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann forall a b. (a -> b) -> a -> b $ OptSpec (EarlyConfig opts) -> Doc ann forall a ann. OptSpec a -> Doc ann cmdLineDocs (OptSpec (EarlyConfig opts) -> Doc ann) -> OptSpec (EarlyConfig opts) -> Doc ann forall a b. (a -> b) -> a -> b $ Config opts -> OptSpec (EarlyConfig opts) forall opts. Config opts -> OptSpec (EarlyConfig opts) commandLineOptions Config opts cfg , Config opts -> Doc ann forall a ann. Config a -> Doc ann envVarDocs Config opts cfg , String -> Doc ann forall ann. String -> Doc ann heading String "Configuration file format:" , Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann nest Int 2 (Doc -> Doc ann forall a ann. Show a => a -> Doc ann viaShow (Doc -> Doc ann) -> Doc -> Doc ann forall a b. (a -> b) -> a -> b $ ValueSpec opts -> Doc forall a. ValueSpec a -> Doc generateDocs (Text -> SectionsSpec opts -> ValueSpec opts forall a. Text -> SectionsSpec a -> ValueSpec a sectionsSpec Text nm (Config opts -> SectionsSpec opts forall opts. Config opts -> SectionsSpec opts cfgFile Config opts cfg))) ] cmdLineDocs :: OptSpec a -> Doc ann cmdLineDocs :: forall a ann. OptSpec a -> Doc ann cmdLineDocs OptSpec a opts = [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vcat [ Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann nest Int 2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann forall a b. (a -> b) -> a -> b $ [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall a b. (a -> b) -> a -> b $ Doc ann "Parameters:" Doc ann -> [Doc ann] -> [Doc ann] forall a. a -> [a] -> [a] : [Doc ann] forall {ann}. [Doc ann] ppParams , Doc ann forall a. Monoid a => a mempty , Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann nest Int 2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann forall a b. (a -> b) -> a -> b $ [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall a b. (a -> b) -> a -> b $ Doc ann "Flags:" Doc ann -> [Doc ann] -> [Doc ann] forall a. a -> [a] -> [a] : [Doc ann] forall {ann}. [Doc ann] ppFlags ] where ppParams :: [Doc ann] ppParams = let maxLen :: Int maxLen = [Int] -> Int forall a. Ord a => [a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Int] -> Int) -> [Int] -> Int forall a b. (a -> b) -> a -> b $ (String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length (String -> Int) -> ((String, String) -> String) -> (String, String) -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . (String, String) -> String forall a b. (a, b) -> a fst) ((String, String) -> Int) -> [(String, String)] -> [Int] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> OptSpec a -> [(String, String)] forall a. OptSpec a -> [(String, String)] progParamDocs OptSpec a opts in ((String, String) -> Doc ann) -> [(String, String)] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map (Int -> (String, String) -> Doc ann forall {a} {ann}. Pretty a => Int -> (a, String) -> Doc ann ppParam Int maxLen) ([(String, String)] -> [Doc ann]) -> [(String, String)] -> [Doc ann] forall a b. (a -> b) -> a -> b $ OptSpec a -> [(String, String)] forall a. OptSpec a -> [(String, String)] progParamDocs OptSpec a opts ppParam :: Int -> (a, String) -> Doc ann ppParam Int l (a n,String d) = let pad :: Int pad = Int -> Int -> Int forall a. Ord a => a -> a -> a max Int 0 (Int -> Int) -> Int -> Int forall a b. (a -> b) -> a -> b $ Int l Int -> Int -> Int forall a. Num a => a -> a -> a - String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String d in [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann hcat [ a -> Doc ann forall ann. a -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty a n , Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (Text -> Doc ann) -> Text -> Doc ann forall a b. (a -> b) -> a -> b $ Int -> Text -> Text T.replicate (Int pad Int -> Int -> Int forall a. Num a => a -> a -> a + Int 4) Text " " , Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann nest Int 2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann forall a b. (a -> b) -> a -> b $ Text -> Doc ann forall ann. Text -> Doc ann reflow (Text -> Doc ann) -> Text -> Doc ann forall a b. (a -> b) -> a -> b $ String -> Text T.pack String d ] ppFlags :: [Doc ann] ppFlags = let flagset :: [[Text]] flagset = (OptDescr a -> [Text]) -> [OptDescr a] -> [[Text]] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap OptDescr a -> [Text] forall a. OptDescr a -> [Text] ppFlag ([OptDescr a] -> [[Text]]) -> [OptDescr a] -> [[Text]] forall a b. (a -> b) -> a -> b $ (OptDescr a -> OptDescr a -> Ordering) -> [OptDescr a] -> [OptDescr a] forall a. (a -> a -> Ordering) -> [a] -> [a] L.sortBy ((String, [String]) -> (String, [String]) -> Ordering forall a. Ord a => a -> a -> Ordering compare ((String, [String]) -> (String, [String]) -> Ordering) -> (OptDescr a -> (String, [String])) -> OptDescr a -> OptDescr a -> Ordering forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` OptDescr a -> (String, [String]) forall {a}. OptDescr a -> (String, [String]) optSort) ([OptDescr a] -> [OptDescr a]) -> [OptDescr a] -> [OptDescr a] forall a b. (a -> b) -> a -> b $ OptSpec a -> [OptDescr a] forall a. OptSpec a -> [OptDescr a] progOptions OptSpec a opts optSort :: OptDescr a -> (String, [String]) optSort OptDescr a o = (String -> String forall a. Ord a => [a] -> [a] L.sort (String -> String) -> String -> String forall a b. (a -> b) -> a -> b $ OptDescr a -> String forall a. OptDescr a -> String optShortFlags OptDescr a o String -> String -> String forall a. Semigroup a => a -> a -> a <> String "zzzzz", [String] -> [String] forall a. Ord a => [a] -> [a] L.sort ([String] -> [String]) -> [String] -> [String] forall a b. (a -> b) -> a -> b $ OptDescr a -> [String] forall a. OptDescr a -> [String] optLongFlags OptDescr a o) lengths :: [Int] lengths = ([Text] -> Int) -> [[Text]] -> [Int] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ([Int] -> Int forall a. Ord a => [a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Int] -> Int) -> ([Text] -> [Int]) -> [Text] -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . (Text -> Int) -> [Text] -> [Int] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Int T.length) ([[Text]] -> [Int]) -> [[Text]] -> [Int] forall a b. (a -> b) -> a -> b $ [[Text]] -> [[Text]] forall a. [[a]] -> [[a]] L.transpose [[Text]] flagset textLen :: (Int, Text) -> Text textLen (Int l,Text t) = let f :: Text f = Int -> Text -> Text T.replicate (Int -> Int -> Int forall a. Ord a => a -> a -> a max Int 0 (Int -> Int) -> Int -> Int forall a b. (a -> b) -> a -> b $ Int l Int -> Int -> Int forall a. Num a => a -> a -> a - Text -> Int T.length Text t) Text " " in Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text f sizedCols :: [[Text]] sizedCols = ([Text] -> [Text]) -> [[Text]] -> [[Text]] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (((Int, Text) -> Text) -> [(Int, Text)] -> [Text] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Int, Text) -> Text textLen ([(Int, Text)] -> [Text]) -> ([Text] -> [(Int, Text)]) -> [Text] -> [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int] -> [Text] -> [(Int, Text)] forall a b. [a] -> [b] -> [(a, b)] zip [Int] lengths) ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]] forall a b. (a -> b) -> a -> b $ [[Text]] flagset padLast :: Text -> Doc ann padLast = Doc ann -> Doc ann forall ann. Doc ann -> Doc ann align (Doc ann -> Doc ann) -> (Text -> Doc ann) -> Text -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Doc ann forall ann. Text -> Doc ann reflow prettyLine :: [Text] -> Doc ann prettyLine = [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann hcat ([Doc ann] -> Doc ann) -> ([Text] -> [Doc ann]) -> [Text] -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . ([Doc ann], Text -> Doc ann) -> [Doc ann] forall a b. (a, b) -> a fst (([Doc ann], Text -> Doc ann) -> [Doc ann]) -> ([Text] -> ([Doc ann], Text -> Doc ann)) -> [Text] -> [Doc ann] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Text -> ([Doc ann], Text -> Doc ann) -> ([Doc ann], Text -> Doc ann)) -> ([Doc ann], Text -> Doc ann) -> [Text] -> ([Doc ann], Text -> Doc ann) forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (\Text c ([Doc ann] p,Text -> Doc ann g) -> (Text -> Doc ann g Text c Doc ann -> [Doc ann] -> [Doc ann] forall a. a -> [a] -> [a] : Doc ann forall ann. Doc ann space Doc ann -> [Doc ann] -> [Doc ann] forall a. a -> [a] -> [a] : [Doc ann] p, Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty)) ([], Text -> Doc ann forall ann. Text -> Doc ann padLast) in ([Text] -> Doc ann) -> [[Text]] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [Text] -> Doc ann forall {ann}. [Text] -> Doc ann prettyLine [[Text]] sizedCols ppFlag :: OptDescr a -> [Text] ppFlag :: forall a. OptDescr a -> [Text] ppFlag OptDescr a od = let sfs :: Text sfs = if String -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null (OptDescr a -> String forall a. OptDescr a -> String optShortFlags OptDescr a od) then Text "" else let each :: [Text] each = let f :: Char -> Text f = case OptDescr a -> ArgDescr a forall a. OptDescr a -> ArgDescr a optArgument OptDescr a od of NoArg OptSetter a _ -> Char -> Text T.singleton ReqArg String a String -> OptSetter a _ -> (\Char c -> Char -> Text T.singleton Char c Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> String -> Text T.pack String a) OptArg String a Maybe String -> OptSetter a _ -> (\Char c -> Char -> Text T.singleton Char c Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " [" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> String -> Text T.pack String a Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "]") in Char -> Text f (Char -> Text) -> String -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> OptDescr a -> String forall a. OptDescr a -> String optShortFlags OptDescr a od in Text "-" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -> [Text] -> Text T.intercalate Text ",-" [Text] each lfs :: Text lfs = if [String] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null (OptDescr a -> [String] forall a. OptDescr a -> [String] optLongFlags OptDescr a od) then Text "" else let each :: [Text] each = let f :: String -> Text f = case OptDescr a -> ArgDescr a forall a. OptDescr a -> ArgDescr a optArgument OptDescr a od of NoArg OptSetter a _ -> String -> Text T.pack ReqArg String a String -> OptSetter a _ -> (\String s -> String -> Text T.pack String s Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "=" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> String -> Text T.pack String a) OptArg String a Maybe String -> OptSetter a _ -> (\String s -> String -> Text T.pack String s Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "=[" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> String -> Text T.pack String a Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "]") in String -> Text f (String -> Text) -> [String] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> OptDescr a -> [String] forall a. OptDescr a -> [String] optLongFlags OptDescr a od in Text "--" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -> [Text] -> Text T.intercalate Text ",--" [Text] each in [ Text sfs, Text lfs, String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ OptDescr a -> String forall a. OptDescr a -> String optDescription OptDescr a od ] envVarDocs :: Config a -> Doc ann envVarDocs :: forall a ann. Config a -> Doc ann envVarDocs Config a cfg | [EnvDescr a] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [EnvDescr a] vs = Doc ann forall a. Monoid a => a mempty | Bool otherwise = [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vcat [ String -> Doc ann forall ann. String -> Doc ann heading String "Environment variables:" , Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann indent Int 2 ([Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vcat ((EnvDescr a -> Doc ann) -> [EnvDescr a] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map EnvDescr a -> Doc ann forall {opts} {ann}. EnvDescr opts -> Doc ann pp [EnvDescr a] vs)) ] where vs :: [EnvDescr a] vs = Config a -> [EnvDescr a] forall opts. Config opts -> [EnvDescr opts] cfgEnv Config a cfg m :: Int m = [Int] -> Int forall a. Ord a => [a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ((EnvDescr a -> Int) -> [EnvDescr a] -> [Int] forall a b. (a -> b) -> [a] -> [b] map (String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length (String -> Int) -> (EnvDescr a -> String) -> EnvDescr a -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . EnvDescr a -> String forall opts. EnvDescr opts -> String evName) [EnvDescr a] vs) pp :: EnvDescr opts -> Doc ann pp EnvDescr opts v = String -> Doc ann forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (String n String -> String -> String forall a. [a] -> [a] -> [a] ++ Int -> Char -> String forall a. Int -> a -> [a] replicate (Int 1 Int -> Int -> Int forall a. Num a => a -> a -> a + Int m Int -> Int -> Int forall a. Num a => a -> a -> a - String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String n) Char ' ') Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> (String -> Doc ann forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (String -> Doc ann) -> String -> Doc ann forall a b. (a -> b) -> a -> b $ EnvDescr opts -> String forall opts. EnvDescr opts -> String evDoc EnvDescr opts v) where n :: String n = EnvDescr opts -> String forall opts. EnvDescr opts -> String evName EnvDescr opts v heading :: String -> Doc ann heading :: forall ann. String -> Doc ann heading String x = [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vcat [ Doc ann forall a. Monoid a => a mempty , String -> Doc ann forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty String x , String -> Doc ann forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (Int -> Char -> String forall a. Int -> a -> [a] replicate (String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String x) Char '=') , Doc ann forall a. Monoid a => a mempty ]